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

[elpa] 74/119: beginning to implement web-socket support

From: Eric Schulte
Subject: [elpa] 74/119: beginning to implement web-socket support
Date: Mon, 10 Mar 2014 16:57:41 +0000 
eschulte pushed a commit to branch master
in repository elpa.

commit c679ba9eb908d047df71383775eec916f32bae5f
Author: Eric Schulte <address@hidden>
Date:   Mon Jan 6 22:14:41 2014 -0700

    beginning to implement web-socket support
---
 NOTES                    |    8 ++++++--
 examples/9-web-socket.el |   41 +++++++++++++++++++++++++++++++++++++++++
 web-server-test.el       |    5 +++++
 web-server.el            |   23 ++++++++++++++++++-----
 4 files changed, 70 insertions(+), 7 deletions(-)

diff --git a/NOTES b/NOTES
index 09c7aa6..9c6e3a2 100644
--- a/NOTES
+++ b/NOTES
@@ -1,7 +1,11 @@
                                                            -*- org -*-
 
 * Notes
-* Tasks [10/24]
+* Tasks [10/25]
+** TODO web sockets
+- http://en.wikipedia.org/wiki/WebSocket
+- http://tools.ietf.org/html/rfc6455
+
 ** more examples [0/4]
 *** TODO Org-mode agenda
 Already exists as part of org-ehtml.
@@ -134,7 +138,7 @@ e.g., parameter strings
 - [X] parse urlencoded post data
 - [X] think about defaulting to (name . content) for form elements
 - [X] maybe don't require a non-nil return to cancel the connection,
-      instead only keep open if :keep-open is returned
+      instead only keep open if =:keep-alive= is returned
 - [X] function to send a file (with mime handling)
 - [X] send a 404 with some default text
 
diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
new file mode 100644
index 0000000..1b19b6c
--- /dev/null
+++ b/examples/9-web-socket.el
@@ -0,0 +1,41 @@
+;;; web-sockets.el --- communicate via web-sockets
+
+(defvar web-socket-page "<html>
+<head>
+<script type=\"text/javascript\">
+var ws;
+function connect(){
+  ws = new WebSocket(\"ws://localhost:9999/\");
+
+  ws.onopen    = function()    { alert(\"connected\"); ws.send(\"heyo\"); };
+  ws.onmessage = function(msg) { alert(msg.data); };
+  ws.onclose   = function()    { alert(\"connection closed\"); };
+}
+
+function message(){ ws.send(\"message\"); }
+</script>
+</head>
+<body>
+<a href=\"javascript:connect()\">connect</a>
+<a href=\"javascript:message()\">message</a>
+</body>
+</html>")
+
+(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-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-start '(((:GET . ".*") . web-socket-server)) 9999)
diff --git a/web-server-test.el b/web-server-test.el
index 8f6f01c..5c03720 100644
--- a/web-server-test.el
+++ b/web-server-test.el
@@ -243,4 +243,9 @@ Content-Type: application/octet-stream
                                 (cdr (assoc "file" (headers request))))))))
       (ws-stop server))))
 
+(ert-deftest ws/web-socket-handshake-rfc-example ()
+  "Ensure that `ws-web-socket-handshake' conforms to the example in RFC6455."
+  (should (string= (ws-web-socket-handshake "dGhlIHNhbXBsZSBub25jZQ==")
+                   "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")))
+
 (provide 'web-server-test)
diff --git a/web-server.el b/web-server.el
index 5d01501..080023a 100644
--- a/web-server.el
+++ b/web-server.el
@@ -55,6 +55,9 @@
 (defvar ws-log-time-format "%Y.%m.%d.%H.%M.%S.%N"
   "Logging time format passed to `format-time-string'.")
 
+(defvar ws-guid "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
+  "This GUID is defined in RFC6455.")
+
 ;;;###autoload
 (defun ws-start (handlers port &optional log-buffer &rest network-args)
   "Start a server using HANDLERS and return the server object.
@@ -208,8 +211,8 @@ function.
         (when (not (eq (catch 'close-connection
                          (if (ws-parse-request request)
                              (ws-call-handler request handlers)
-                           :keep-open))
-                       :keep-open))
+                           :keep-alive))
+                       :keep-alive))
           (setq requests (cl-remove-if (lambda (r) (eql proc (process r))) 
requests))
           (delete-process proc))))))
 
@@ -245,7 +248,7 @@ Return non-nil only when parsing is complete."
                   (progn
                     (setcdr (last headers)
                             (list (ws-parse-multipart/form process
-                                                           (substring pending 
index next-index))))
+                                    (substring pending index next-index))))
                     ;; Boundary suffixed by "--" indicates end of the headers.
                     (when (and (> (length pending) (+ tmp 2))
                                (string= (substring pending tmp (+ tmp 2)) 
"--"))
@@ -300,16 +303,22 @@ 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
+(defun ws-web-socket-filter (proc string)
+  "Web socket filter to pass whole frames to the client.
+See RFC6455."
+  (message "ws:%S" string))
+
 
 ;;; Convenience functions to write responses
-(defun ws-response-header (proc code &rest header)
+(defun ws-response-header (proc code &rest headers)
   "Send the headers for an HTTP response to PROC.
 Currently CODE should be an HTTP status code, see
 `ws-status-codes' for a list of known codes."
   (let ((headers
          (cons
           (format "HTTP/1.1 %d %s" code (cdr (assoc code ws-status-codes)))
-          (mapcar (lambda (h) (format "%s: %s" (car h) (cdr h))) header))))
+          (mapcar (lambda (h) (format "%s: %s" (car h) (cdr h))) headers))))
     (setcdr (last headers) (list "" ""))
     (process-send-string proc (mapconcat #'identity headers "\r\n"))))
 
@@ -352,5 +361,9 @@ If so return PATH, if not return nil."
          (string= parent (substring expanded 0 (length parent)))
          expanded)))
 
+(defun ws-web-socket-handshake (key)
+  "Perform the handshake defined in RFC6455."
+  (base64-encode-string (sha1 (concat (ws-trim key) ws-guid) nil nil 'binary)))
+
 (provide 'web-server)
 ;;; web-server.el ends here
reply via email to
[Prev in Thread] Current Thread [Next in Thread]