eschulte pushed a commit to branch master
in repository elpa.
commit 6e9f8168f25660609385b6436fa7de84f2bb032b
Author: Eric Schulte <schulte.e...@gmail.com>
Date: Tue Jan 7 09:26:42 2014 -0700
helpers for handling web socket connections
---
.gitignore | 1 +
examples/9-web-socket.el | 15 ++--
web-server.el | 198 ++++++++++++++++++++++++----------------------
3 files changed, 113 insertions(+), 101 deletions(-)
diff --git a/.gitignore b/.gitignore
index c531d98..65b8fcb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,2 @@
*.elc
+stuff
diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
index 3b39568..1ad9276 100644
--- a/examples/9-web-socket.el
+++ b/examples/9-web-socket.el
@@ -1,11 +1,14 @@
;;; web-sockets.el --- communicate via web-sockets
-(defvar web-socket-page "<html>
+(defvar web-socket-port 8888)
+
+(defvar web-socket-page
+ (format "<html>
<head>
<script type=\"text/javascript\">
var ws;
function connect(){
- ws = new WebSocket(\"ws://localhost:9999/\");
+ ws = new WebSocket(\"ws://localhost:%d/\");
ws.onopen = function() { alert(\"connected\"); };
ws.onmessage = function(msg) { alert(\"Server: \" + msg.data); };
@@ -22,14 +25,12 @@ function close(){ ws.close(); };
<a href=\"javascript:message()\">message</a>
<a href=\"javascript:close()\">close</a>
</body>
-</html>")
+</html>" web-socket-port))
(defun web-socket-server (request)
(with-slots (process headers) request
- (ws/web-socket-messages-do headers message
- ;; (ws/web-socket-send message)
- (message "GOT:%S" message))
+ (ws-web-socket-connect request 'ws-web-socket-send)
(ws-response-header process 200 '("Content-type" . "text/html"))
(process-send-string process web-socket-page)))
-(ws-start '(((:GET . ".*") . web-socket-server)) 9999)
+(ws-start '(((:GET . ".*") . web-socket-server)) web-socket-port)
diff --git a/web-server.el b/web-server.el
index cbb68fc..b0cbfa6 100644
--- a/web-server.el
+++ b/web-server.el
@@ -305,8 +305,51 @@ Return non-nil only when parsing is complete."
;;; Web Socket
-(defvar ws/web-socket-handler nil
- "Function to handle web-socket messages, should take a single argument.")
+(defclass ws-message () ; web socket message object
+ ((process :initarg :process :accessor process :initform "")
+ (pending :initarg :pending :accessor pending :initform "")
+ (active :initarg :active :accessor active :initform nil)
+ (new :initarg :new :accessor new :initform nil)
+ (data :initarg :data :accessor data :initform "")
+ (handler :initarg :handler :accessor handler :initform "")))
+
+(defun ws-web-socket-connect (request handler)
+ "Establish a web socket connection with request.
+If the connection is successful this function will throw
+`:keep-alive' to `close-connection' skipping any remaining code
+in the request handler. If no web-socket connection is
+established (e.g., because REQUEST is not attempting to establish
+a connection) then no actions are taken and nil is returned.
+
+Second argument HANDLER should be a function of one argument
+which will be called on all complete messages as they are
+received and parsed from the network."
+ (with-slots (process headers) request
+ (when (assoc :SEC-WEBSOCKET-KEY headers)
+ ;; Accept the connection
+ (ws-response-header process 101
+ (cons "Upgrade" "websocket")
+ (cons "Connection" "upgrade")
+ (cons "Sec-WebSocket-Accept"
+ (ws-web-socket-handshake
+ (cdr (assoc :SEC-WEBSOCKET-KEY headers)))))
+ ;; Setup the process filter
+ (set-process-coding-system process 'binary)
+ (set-process-plist
+ process (list :message (make-instance 'ws-message
+ :handler handler :process process)))
+ (set-process-filter process 'ws-web-socket-filter)
+ (throw 'close-connection :keep-alive))))
+
+(defun ws-web-socket-filter (process string)
+ (let ((message (plist-get (process-plist process) :message)))
+ ;; don't re-start if message is being parsed
+ (if (active message)
+ (setf (new message) string)
+ (setf (pending message) (concat (pending message) string))
+ (setf (active message) t)
+ (ws-web-socket-parse-messages message))
+ (setf (active message) nil)))
(defun int-to-bits (int size)
(let ((result (make-bool-vector size nil)))
@@ -324,7 +367,7 @@ Return non-nil only when parsing is complete."
(prog1 (if bit (expt 2 place) 0) (incf place)))
(reverse bits)))))
-(defun ws/web-socket-mask (masking-key data)
+(defun ws-web-socket-mask (masking-key data)
(let ((masking-data (apply #'concat (make-list (+ 1 (/ (length data) 4))
masking-key))))
(apply #'string (cl-mapcar #'logxor masking-data data))))
@@ -351,99 +394,66 @@ Return non-nil only when parsing is complete."
;; | Payload Data continued ... |
;; +---------------------------------------------------------------+
;;
-(defun ws-make-web-socket-filter (handler)
+(defun ws-web-socket-parse-messages (message)
"Web socket filter to pass whole frames to the client.
See RFC6455."
- (lexical-let ((my-handler handler))
- (lambda proc string
- (catch 'wait ; TODO: this needs more complete partial input handling
- (when (plist-get (process-plist proc) :active)
- (let ((pending (plist-get (process-plist proc) :pending)))
- (set-process-plist proc
- (plist-put (process-plist proc)
- :pending (concat pending string))))
- (throw 'wait nil))
- ;; set to active
- (set-process-plist proc (plist-put (process-plist proc) :active t))
- (let ((index 0))
- (cl-flet ((bits (length)
- (apply #'append
- (mapcar (lambda (int) (int-to-bits int 8))
- (subseq string index (incf index
length))))))
- (let ((data (plist-get (process-plist proc) :parsed))
- fin rsvs opcode mask pl mask-key)
- (let ((byte (bits 1)))
- (setq fin (car byte)
- rsvs (subseq byte 1 4)
- opcode
- (let ((it (bits-to-int (subseq byte 4))))
- (case it
- (0 :CONTINUATION)
- (1 :TEXT)
- (2 :BINARY)
- ((3 4 5 6 7) :NON-CONTROL)
- (9 :PING)
- (10 :PONG)
- ((11 12 13 14 15) :CONTROL)
- ;; If an unknown opcode is received, the receiving
- ;; endpoint MUST _Fail the WebSocket Connection_.
- (t (ws-error proc "Web Socket Fail: bad opcode %d"
it))))))
- (unless (cl-every #'null rsvs)
- ;; MUST be 0 unless an extension is negotiated that defines
- ;; meanings for non-zero values.
- (ws-error proc "Web Socket Fail: non-zero RSV 1 2 or 3"))
- (let ((byte (bits 1)))
- (setq mask (car byte)
- pl (bits-to-int (subseq byte 1))))
- (unless (eq mask t)
- ;; All frames sent from client to server have this bit set to
1.
- (ws-error proc "Web Socket Fail: client must mask data"))
- (cond
- ((= pl 126) (setq pl (bits-to-int (bits 2))))
- ((= pl 127) (setq pl (bits-to-int (bits 8)))))
- (when mask (setq mask-key (subseq string index (incf index 4))))
- (setq data (concat data
- (ws/web-socket-mask
- mask-key (subseq string index (+ index
pl)))))
- ;; set to inactive
- (set-process-plist proc (plist-put (process-plist proc) :active
nil))
- (if fin
- (funcall my-handler data) ; call the web-socket handler
- ;; add parsed data to the process plist
- (let ((plist (process-plist proc)))
- (set-process-plist
- (plist-put plist :parsed (concat (plist-get plist :parsed)
- data))))
- ;; add any remaining un-parsed network data to pending
- (when (< (+ index pl) (length string))
- (let ((plist (process-plist proc)))
- (set-process-plist
- (plist-put plist :pending
- (concat (substring string (+ index pl))
- (or (plist-get plist :pending) ""))))))
- ;; possibly re-parse any pending input
- (when (plist-get (process-plist proc) :pending)
- (set-process-plist (plist-put (process-plist proc) :pending
nil))
- (ws-web-socket-filter
- proc (plist-get (process-plist proc) :pending)))))))))))
-
-(defmacro ws/web-socket-messages-do (headers variable body)
- "Helper macro to set the `ws-web-socket-filter' appropriately."
- `(when (assoc :SEC-WEBSOCKET-KEY ,(identity headers))
- (ws-response-header process 101
- (cons "Upgrade" "websocket")
- (cons "Connection" "upgrade")
- (cons "Sec-WebSocket-Accept"
- (ws-web-socket-handshake
- (cdr (assoc :SEC-WEBSOCKET-KEY headers)))))
- (set-process-plist process (list :parsed "" :pending nil :active nil))
- (set-process-coding-system process 'binary)
- (set-process-filter process (ws-make-web-socket-filter
- (lambda ,(list variable) ,@body)))
- (throw 'close-connection :keep-alive)))
-
-(defun ws/web-socket-send (string)
- )
+ (let ((index 0))
+ (cl-flet ((bits (length)
+ (apply #'append
+ (mapcar (lambda (int) (int-to-bits int 8))
+ (subseq string index (incf index
length))))))
+ (with-slots (process pending data handler new) message
+ (let (fin rsvs opcode mask pl mask-key)
+ ;; Parse fin bit, rsvs bits and opcode
+ (let ((byte (bits 1)))
+ (setq fin (car byte)
+ rsvs (subseq byte 1 4)
+ opcode
+ (let ((it (bits-to-int (subseq byte 4))))
+ (case it
+ (0 :CONTINUATION)
+ (1 :TEXT)
+ (2 :BINARY)
+ ((3 4 5 6 7) :NON-CONTROL)
+ (9 :PING)
+ (10 :PONG)
+ ((11 12 13 14 15) :CONTROL)
+ ;; If an unknown opcode is received, the receiving
+ ;; endpoint MUST _Fail the WebSocket Connection_.
+ (t (ws-error process
+ "Web Socket Fail: bad opcode %d" it))))))
+ (unless (cl-every #'null rsvs)
+ ;; MUST be 0 unless an extension is negotiated that defines
+ ;; meanings for non-zero values.
+ (ws-error process "Web Socket Fail: non-zero RSV 1 2 or 3"))
+ ;; Parse mask and payload length
+ (let ((byte (bits 1)))
+ (setq mask (car byte)
+ pl (bits-to-int (subseq byte 1))))
+ (unless (eq mask t)
+ ;; All frames sent from client to server have this bit set to 1.
+ (ws-error process "Web Socket Fail: client must mask data"))
+ (cond
+ ((= pl 126) (setq pl (bits-to-int (bits 2))))
+ ((= pl 127) (setq pl (bits-to-int (bits 8)))))
+ ;; unmask data
+ (when mask (setq mask-key (subseq string index (incf index 4))))
+ (setq data (concat data
+ (ws-web-socket-mask
+ mask-key (subseq string index (+ index pl)))))
+ (if fin
+ ;; wipe the message state and call the handler
+ (let ((it data))
+ (setq data "" active nil pending "" new nil)
+ (funcall handler it))
+ ;; add any remaining un-parsed network data to pending
+ (when (< (+ index pl) (length pending))
+ (setq pending (substring pending (+ index pl)))))))
+ ;; possibly re-parse any pending input
+ (when (new message) (ws-web-socket-parse-messages message)))))
+
+(defun ws-web-socket-send (string)
+ (message "TODO: send %S" string))
;;; Convenience functions to write responses
