Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
64 lines (51 sloc) 1.84 KB
;;; shampoo-networking.el --- Shampoo network layer
;;
;; Copyright (C) 2010 - 2012 Dmitry Matveev <me@dmitrymatveev.co.uk>
;;
;; This software is released under terms of the MIT license,
;; please refer to the LICENSE file for details.
(eval-when-compile (require 'cl))
(require 'shampoo-auth)
(defstruct shampoo-connection
process)
(defun shampoo-net-sentinel (connection user-down-fcn)
(lexical-let ((c connection)
(f user-down-fcn))
(lambda (process event)
(when (not (shampoo-net-is-alive c))
(funcall f)))))
(defun shampoo-net-receiver (connection user-recv-fcn)
(lexical-let ((f user-recv-fcn))
(lambda (process str)
(funcall f str))))
(defun* shampoo-connection-setup
(connection &key on-receive on-shutdown)
(let ((p (shampoo-connection-process connection)))
(when on-receive
(set-process-filter
p
(shampoo-net-receiver connection on-receive)))
(when on-shutdown
(set-process-sentinel
p
(shampoo-net-sentinel connection on-shutdown)))))
(defun shampoo-net-connect (connect-info)
(make-shampoo-connection
:process (open-network-stream "shampoo" nil
(shampoo-connect-info-host connect-info)
(shampoo-connect-info-port connect-info))))
(defun shampoo-net-is-alive (connection)
(let ((proc (shampoo-connection-process connection)))
(not (eq 'closed (process-status proc)))))
(defun shampoo-net-mkmsg (str)
(format "Content-Length: %d\r\n\r\n%s" (length str) str))
(defun shampoo-net-send (connection msg)
; (message "Sending: %s" msg)
(process-send-string
(shampoo-connection-process connection)
(shampoo-net-mkmsg msg)))
(defun shampoo-net-disconnect (connection)
(when connection
(delete-process (shampoo-connection-process connection))))
(provide 'shampoo-networking)
;;; shampoo-networking.el ends here.