emacs-elpa-diffs
[Top][All Lists]
Advanced
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 75/119: more web-socket implementation

From: Eric Schulte
Subject: [elpa] 75/119: more web-socket implementation
Date: Mon, 10 Mar 2014 16:57:42 +0000 
eschulte pushed a commit to branch master
in repository elpa.

commit 159f947730aec78bef2f05a202d89ca4bd24846f
Author: Eric Schulte <address@hidden>
Date:   Tue Jan 7 00:54:35 2014 -0700

    more web-socket implementation
---
 examples/9-web-socket.el |    6 +++-
 web-server.el            |   78 ++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 81 insertions(+), 3 deletions(-)

diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
index 1b19b6c..3406596 100644
--- a/examples/9-web-socket.el
+++ b/examples/9-web-socket.el
@@ -7,17 +7,20 @@ var ws;
 function connect(){
   ws = new WebSocket(\"ws://localhost:9999/\");
 
-  ws.onopen    = function()    { alert(\"connected\"); ws.send(\"heyo\"); };
+  ws.onopen    = function()    { alert(\"connected\"); };
   ws.onmessage = function(msg) { alert(msg.data); };
   ws.onclose   = function()    { alert(\"connection closed\"); };
 }
 
 function message(){ ws.send(\"message\"); }
+
+function close(){ ws.close(); };
 </script>
 </head>
 <body>
 <a href=\"javascript:connect()\">connect</a>
 <a href=\"javascript:message()\">message</a>
+<a href=\"javascript:close()\">close</a>
 </body>
 </html>")
 
@@ -32,6 +35,7 @@ function message(){ ws.send(\"message\"); }
         (cons "Sec-WebSocket-Accept"
               (ws-web-socket-handshake
                (cdr (assoc :SEC-WEBSOCKET-KEY headers)))))
+      (set-process-coding-system process 'binary)
       (set-process-filter process 'ws-web-socket-filter)
       :keep-alive)
      (t
diff --git a/web-server.el b/web-server.el
index 080023a..69b0e01 100644
--- a/web-server.el
+++ b/web-server.el
@@ -303,11 +303,85 @@ Return non-nil only when parsing is complete."
                         (apply #'format msg args)))))
     (apply #'ws-send-500 proc msg args)))
 
-;; TODO: http://tools.ietf.org/html/rfc6455#section-5.2
+
+;;; Web Socket
+
+;; Binary framing protocol
+;; from http://tools.ietf.org/html/rfc6455#section-5.2
+;;
+;;  0                   1                   2                   3
+;;  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+;; +-+-+-+-+-------+-+-------------+-------------------------------+
+;; |F|R|R|R| opcode|M| Payload len |    Extended payload length    |
+;; |I|S|S|S|  (4)  |A|     (7)     |             (16/64)           |
+;; |N|V|V|V|       |S|             |   (if payload len==126/127)   |
+;; | |1|2|3|       |K|             |                               |
+;; +-+-+-+-+-------+-+-------------+ - - - - - - - - - - - - - - - +
+;; |     Extended payload length continued, if payload len == 127  |
+;; + - - - - - - - - - - - - - - - +-------------------------------+
+;; |                               |Masking-key, if MASK set to 1  |
+;; +-------------------------------+-------------------------------+
+;; | Masking-key (continued)       |          Payload Data         |
+;; +-------------------------------- - - - - - - - - - - - - - - - +
+;; :                     Payload Data continued ...                :
+;; + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +
+;; |                     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."
-  (message "ws:%S" string))
+  (let ((index 0))
+    (cl-flet ((bits (length)
+                    (apply #'append
+                           (mapcar (lambda (int) (int-to-bits int 8))
+                                   (subseq string index (incf index 
length))))))
+      (let (fin rsvs opcode mask pl mask-key data)
+        (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 "Bad opcode %d" ))))))
+        (let ((byte (bits 1)))
+          (setq mask (car byte)
+                pl (bits-to-int (subseq byte 1))))
+        (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 (subseq string index (+ index pl)))
+        (message "fin:%s rsvs:%s opcode:%s mask-key:%s mask:%s pl:%s data:%S"
+                 fin rsvs opcode mask mask-key pl
+                 (ws/web-socket-mask mask-key data))))))
 
 
 ;;; Convenience functions to write responses
reply via email to
[Prev in Thread] Current Thread [Next in Thread]