eschulte pushed a commit to branch master
in repository elpa.
commit 159f947730aec78bef2f05a202d89ca4bd24846f
Author: Eric Schulte <schulte.e...@gmail.com>
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
