[elpa] 77/119: handle chunked receipt of web-socket messages

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit 2f71a3ceec9e518ace3e9858ec1ee54633515277
Author: Eric Schulte <address@hidden>
Date:   Tue Jan 7 01:20:09 2014 -0700

    handle chunked receipt of web-socket messages
---
 examples/9-web-socket.el |    2 +-
 web-server.el            |  101 ++++++++++++++++++++++++++++-----------------
 2 files changed, 64 insertions(+), 39 deletions(-)

diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
index 62e6d33..25408d6 100644
--- a/examples/9-web-socket.el
+++ b/examples/9-web-socket.el
@@ -35,7 +35,7 @@ function close(){ ws.close(); };
         (cons "Sec-WebSocket-Accept"
               (ws-web-socket-handshake
                (cdr (assoc :SEC-WEBSOCKET-KEY headers)))))
-      (set-process-plist process (list :pending ""))
+      (set-process-plist process (list :parsed "" :pending nil :active nil))
       (set-process-coding-system process 'binary)
       (set-process-filter process 'ws-web-socket-filter)
       :keep-alive)
diff --git a/web-server.el b/web-server.el
index fad4c83..f4729e1 100644
--- a/web-server.el
+++ b/web-server.el
@@ -352,44 +352,69 @@ Return non-nil only when parsing is complete."
 (defun ws-web-socket-filter (proc string)
   "Web socket filter to pass whole frames to the client.
 See RFC6455."
-  (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) :pending))
-            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)
-                           (t (ws-error proc "Web Socket Fail: bad opcode %d"
-                                        it))))))
-        (unless (cl-every #'null rsvs)
-          (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)
-          (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)))))
-        (if fin
-            (message "received message %S" data)
-          (set-process-plist proc (list :data data)))))))
+  (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
+              ;; call the web-socket handler
+              (message "received message %S" data)
+            ;; 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))))
+            ;; possibly parse pending input
+            (when (plist-get (process-plist proc) :pending)
+              (ws-web-socket-filter
+               proc (plist-get (process-plist proc) :pending)))))))))
 
 
 ;;; Convenience functions to write responses