[elpa] 78/119: hold

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit 7690987038d0f5640df8d704dfb66eff10a2fc33
Author: Eric Schulte <address@hidden>
Date:   Tue Jan 7 01:36:44 2014 -0700

    hold
---
 examples/9-web-socket.el |   23 +++----------
 web-server.el            |   78 +++++++++++++++++++++++++++++++---------------
 2 files changed, 59 insertions(+), 42 deletions(-)

diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
index 25408d6..3b39568 100644
--- a/examples/9-web-socket.el
+++ b/examples/9-web-socket.el
@@ -8,7 +8,7 @@ function connect(){
   ws = new WebSocket(\"ws://localhost:9999/\");
 
   ws.onopen    = function()    { alert(\"connected\"); };
-  ws.onmessage = function(msg) { alert(msg.data); };
+  ws.onmessage = function(msg) { alert(\"Server: \" + msg.data); };
   ws.onclose   = function()    { alert(\"connection closed\"); };
 }
 
@@ -26,21 +26,10 @@ function close(){ ws.close(); };
 
 (defun web-socket-server (request)
   (with-slots (process headers) request
-    (message "hd:%S" headers)
-    (cond
-     ((assoc :SEC-WEBSOCKET-KEY 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-web-socket-filter)
-      :keep-alive)
-     (t
-      (ws-response-header process 200 '("Content-type" . "text/html"))
-      (process-send-string process web-socket-page)))))
+    (ws/web-socket-messages-do headers message
+      ;; (ws/web-socket-send message)
+      (message "GOT:%S" message))
+    (ws-response-header process 200 '("Content-type" . "text/html"))
+    (process-send-string process web-socket-page)))
 
 (ws-start '(((:GET . ".*") . web-socket-server)) 9999)
diff --git a/web-server.el b/web-server.el
index f4729e1..e765be9 100644
--- a/web-server.el
+++ b/web-server.el
@@ -305,6 +305,29 @@ 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.")
+
+(defun int-to-bits (int size)
+  (let ((result (make-bool-vector size nil)))
+    (mapc (lambda (place)
+            (let ((val (expt 2 place)))
+              (when (>= int val)
+                (setq int (- int val))
+                (aset result place t))))
+          (reverse (number-sequence 0 (- size 1))))
+    (reverse (coerce result 'list))))
+
+(defun bits-to-int (bits)
+  (let ((place 0))
+    (reduce #'+ (mapcar (lambda (bit)
+                          (prog1 (if bit (expt 2 place) 0) (incf place)))
+                        (reverse bits)))))
+
+(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))))
 
 ;; Binary framing protocol
 ;; from http://tools.ietf.org/html/rfc6455#section-5.2
@@ -328,27 +351,6 @@ Return non-nil only when parsing is complete."
 ;; |                     Payload Data continued ...                |
 ;; +---------------------------------------------------------------+
 ;;
-(defun int-to-bits (int size)
-  (let ((result (make-bool-vector size nil)))
-    (mapc (lambda (place)
-            (let ((val (expt 2 place)))
-              (when (>= int val)
-                (setq int (- int val))
-                (aset result place t))))
-          (reverse (number-sequence 0 (- size 1))))
-    (reverse (coerce result 'list))))
-
-(defun bits-to-int (bits)
-  (let ((place 0))
-    (reduce #'+ (mapcar (lambda (bit)
-                          (prog1 (if bit (expt 2 place) 0) (incf place)))
-                        (reverse bits)))))
-
-(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))))
-
 (defun ws-web-socket-filter (proc string)
   "Web socket filter to pass whole frames to the client.
 See RFC6455."
@@ -404,17 +406,43 @@ See RFC6455."
           ;; 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)
+              (funcall ws/web-socket-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))))
-            ;; possibly parse pending input
+            ;; 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)))))))))
+               proc (plist-get (process-plist proc) :pending)))
+            nil))))))
+
+(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)
+     (lexical-let ((ws/web-socket-handler (lambda ,(list variable) ,@body)))
+       (set-process-filter process 'ws-web-socket-filter))
+     (throw 'close-connection :keep-alive)))
+
+(defun ws/web-socket-send (string)
+  )
 
 
 ;;; Convenience functions to write responses