[elpa] 83/119: supports web sockets

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit d6a27ca7f4c668a6525d95f484c3a21c1b87b8f2
Author: Eric Schulte <address@hidden>
Date:   Tue Jan 7 19:06:00 2014 -0700

    supports web sockets
---
 .gitignore               |    1 +
 README                   |   25 ++++---
 doc/benchmark.org        |  192 ----------------------------------------------
 doc/web-server.texi      |   50 +++++++++++-
 examples/9-web-socket.el |    8 +--
 web-server.el            |   55 +++++++-------
 6 files changed, 92 insertions(+), 239 deletions(-)

diff --git a/.gitignore b/.gitignore
index 65b8fcb..43a58dd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
 *.elc
 stuff
+benchmark
diff --git a/README b/README
index 0e6cdca..573a70e 100644
--- a/README
+++ b/README
@@ -7,23 +7,26 @@ REQUIREMENTS
     Emacs 24.3 or later.
 
 STATUS
-    Full support for HTTP GET and POST requests including URL-encoded
-    parameters, multipart/form data and file uploads.  This is a new
-    project without much extended use so there are likely bugs and
-    potentially security issues.  That said it consists of little more
-    than HTTP header parsing logic perched atop Emacs' existing
+    Supports HTTP GET and POST requests including URL-encoded
+    parameters, multipart/form data and file uploads.  Supports web
+    sockets.  Reasonably performant, faster than Elnode [1].  This is
+    a new project without much extended use so there are likely bugs
+    and potentially security issues.  That said it consists of little
+    more than HTTP header parsing logic perched atop Emacs' existing
     network process primitives, so it should be fairly robust.
 
+    [1]  http://eschulte.github.io/emacs-web-server/benchmark/
+
 EXAMPLES
     See the examples/ directory in this repository.  The Emacs Web
-    Server is also used to run a paste server [1] and serve editable
-    Org-mode pages [2].
+    Server is also used to run a paste server [2] and serve editable
+    Org-mode pages [3].
 
-    [1]  https://github.com/eschulte/el-sprunge
-    [2]  https://github.com/eschulte/org-ehtml
+    [2]  https://github.com/eschulte/el-sprunge
+    [3]  https://github.com/eschulte/org-ehtml
 
 DOCUMENTATION
     Run `make doc' to build the texinfo documentation, also available
-    online [3].
+    online [4].
 
-    [3]  http://eschulte.github.io/emacs-web-server
+    [4]  http://eschulte.github.io/emacs-web-server
diff --git a/doc/benchmark.org b/doc/benchmark.org
deleted file mode 100644
index 04ab43c..0000000
--- a/doc/benchmark.org
+++ /dev/null
@@ -1,192 +0,0 @@
-#+Title: Benchmark
-#+HTML_HEAD: <style>pre{background:#232323; color:#E6E1DC;} table{margin:auto} 
@media(min-width:800px){div#content{max-width:800px; padding:2em; 
margin:auto;}}</style>
-#+Options: ^:{} toc:nil num:nil
-
-A quick and dirty comparison of 
[[https://github.com/eschulte/emacs-web-server][web-server]] and 
[[https://github.com/nicferrier/elnode][elnode]] runtime across
-three levels of concurrency.  A simple GET request with a url-encoded
-parameter is used for evaluation.  We send 5000 requests to each
-webserver in parallel batches of varying size to each webserver and
-time how long it takes for all responses to be answered.  Run on my
-x220 laptop with two dual-core Intel i7 CPUs, using 
[[http://www.gnu.org/software/parallel/][GNU parallel]] we
-see the following results.
-
-#+Caption: Runtime in seconds to serve 5,000 requests.
-#+name: comparison
-| concurrency | web-server |    elnode |
-|-------------+------------+-----------|
-|           1 |     40.513 |  46.88325 |
-|          10 |    24.5505 | 32.250625 |
-|         500 |   33.52825 | 63.894625 |
-
-Web-server is faster than Elnode at all levels (although I suppose
-neither is particularly impressive), and the performance gain seems to
-improve as concurrency increases.  The limit of 500 concurrent
-requests is due to limits of the "parallel" utility on my laptop.
-
-#+begin_src gnuplot :var data=comparison :file runtime-comparison.svg
-  set title 'Percent Runtime Reduction of web-server Compared to elnode'
-  set logscale x
-  set xrange [0.5:]
-  set ylabel 'Runtime Reduction'
-  set format y "%g%%"
-  set xlabel 'Number of Concurrent Requests'
-  plot data using 1:(($3-$2)/$3)*100 lw 4 notitle
-#+end_src
-
-#+RESULTS:
-[[file:runtime-comparison.svg]]
-
-Specifics on the [[#get-request][GET Request]] and [[#evaluation][Evaluation]] 
are given below.
-
-* GET Request
-   :PROPERTIES:
-   :CUSTOM_ID: get-request
-   :END:
-The server reads an integer from the GET parameter n, adds 1 to the
-value of "n" and responds with the value of n+1.
-
-- Web Server
-  #+begin_src emacs-lisp
-    (ws-start
-     '(((:GET . "*") .
-        (lambda (request)
-          (with-slots (process headers) request
-            (ws-response-header process 200 '("Content-type" . "text/plain"))
-            (process-send-string process
-              (int-to-string (+ 1 (string-to-int (cdr (assoc "n" 
headers))))))))))
-     9004)
-  #+end_src
-
-- Elnode
-  #+begin_src emacs-lisp
-    (elnode-start
-     (lambda (httpcon)
-       (elnode-http-start httpcon 200 '("Content-Type" . "text/plain"))
-       (elnode-http-return httpcon
-         (int-to-string (+ 1 (string-to-int
-                              (cdr (assoc "n" (elnode-http-params 
httpcon))))))))
-     :port 9005 :host "localhost")
-  #+end_src
-
-* Evaluation
-  :PROPERTIES:
-  :CUSTOM_ID: evaluation
-  :END:
-** The most parallelism
-#+begin_src sh :var port=9004
-  submit(){
-      local port=$1;
-      for i in {0..5000};do
-          echo "curl -s -G -d \"n=$i\" http://localhost:$port";
-      done|parallel -j 500|sha1sum; }
-  
-  for j in {0..8};do
-      echo web server
-      time submit 9004
-      echo elnode
-      time submit 9005
-  done2>&1|tee /tmp/output
-#+end_src
-
-A little munging of the output from =/tmp/output=,
-
-#+begin_src sh
-  cat /tmp/output \
-      |grep -e "real\|web server\|elnode" \
-      |tr '\n' ' ' \
-      |sed 's/web server/\nws/g;s/elnode/\nen/g;s/real//g'
-#+end_src
-
-yields the following.
-
-|  run |             web-server |                  elnode |
-|------+------------------------+-------------------------|
-|    1 |                 26.459 |                  43.484 |
-|    2 |                 34.289 |                  78.984 |
-|    3 |                 29.860 |                  38.646 |
-|    4 |                 34.454 |                  40.742 |
-|    5 |                 35.710 |                  42.884 |
-|    6 |                 36.962 |                  89.897 |
-|    7 |                 39.397 |                 129.905 |
-|    8 |                 31.095 |                  46.615 |
-|------+------------------------+-------------------------|
-| mean | 33.52825 +/- 1.4746653 | 63.894625 +/- 11.643012 |
-#+TBLFM: @10$2=vmeane(@address@hidden)::@10$3=vmeane(@address@hidden)
-
-My guess is that the added overhead for the elnode runs is due to the
-increased logging and the overhead of the callback model of execution.
-
-Twice the following [[#undo-warning]] was thrown during elnode service.
-
-** Run again with much less parallelism
-With =parallel -j 10= instead of =parallel -j 500=.
-
-The [[#undo-warning]] was thrown 3 times by elnode in this run.
-
-|  run |            web-server |                  elnode |
-|------+-----------------------+-------------------------|
-|    1 |                18.366 |                  24.034 |
-|    2 |                21.807 |                  30.930 |
-|    3 |                23.589 |                  35.878 |
-|    4 |                25.562 |                  33.244 |
-|    5 |                25.882 |                  32.824 |
-|    6 |                25.584 |                  33.210 |
-|    7 |                28.852 |                  33.532 |
-|    8 |                26.762 |                  34.353 |
-|------+-----------------------+-------------------------|
-| mean | 24.5505 +/- 1.1492008 | 32.250625 +/- 1.2727409 |
-#+TBLFM: @10$2=vmeane(@address@hidden)::@10$3=vmeane(@address@hidden)
-
-** Finally with no parallelism
-#+begin_src sh
-  submit(){
-      local port=$1;
-      for i in {0..5000};do
-          curl -s -G -d "n=$i" http://localhost:$port
-      done|sha1sum; }
-  
-  for j in {0..7};do
-      echo web server
-      time submit 9004
-      echo elnode
-      time submit 9005
-  done
-#+end_src
-
-|  run |             web-server |                  elnode |
-|------+------------------------+-------------------------|
-|    1 |                 39.896 |                  49.528 |
-|    2 |                 40.573 |                  46.410 |
-|    3 |                 40.460 |                  46.669 |
-|    4 |                 40.695 |                  46.226 |
-|    5 |                 40.587 |                  46.995 |
-|    6 |                 40.644 |                  46.506 |
-|    7 |                 40.807 |                  46.648 |
-|    8 |                 40.442 |                  46.084 |
-|------+------------------------+-------------------------|
-| mean | 40.513 +/- 0.097681699 | 46.88325 +/- 0.39063816 |
-#+TBLFM: @10$2=vmeane(@address@hidden)::@10$3=vmeane(@address@hidden)
-
-** Undo warning thrown by elnode
-     :PROPERTIES:
-     :CUSTOM_ID: undo-warning
-     :END:
-: Warning (undo): Buffer `*elnode-server-error*' undo info was 30181148 bytes 
long.
-: The undo info was discarded because it exceeded `undo-outer-limit'.
-: 
-: This is normal if you executed a command that made a huge change
-: to the buffer.  In that case, to prevent similar problems in the
-: future, set `undo-outer-limit' to a value that is large enough to
-: cover the maximum size of normal changes you expect a single
-: command to make, but not so large that it might exceed the
-: maximum memory allotted to Emacs.
-: 
-: If you did not execute any such command, the situation is
-: probably due to a bug and you should report it.
-: 
-: You can disable the popping up of this buffer by adding the entry
-: (undo discard-info) to the user option `warning-suppress-types',
-: which is defined in the `warnings' library.
-
-This should be fairly easy to fix.
-
diff --git a/doc/web-server.texi b/doc/web-server.texi
index dcd2d90..02b758f 100644
--- a/doc/web-server.texi
+++ b/doc/web-server.texi
@@ -181,11 +181,12 @@ These examples demonstrate usage.
 * Hello World UTF8::            Serve ``Hello World'' w/UTF8 encoding
 * Hello World HTML::            Serve ``Hello World'' in HTML
 * File Server::                 Serve files from a document root
-* URL Parameter Echo::          Echo Parameters from a URL query string
+* URL Parameter Echo::          Echo parameters from a URL query string
 * POST Echo::                   Echo POST parameters back
-* Basic Authentication::        BASIC HTTP Authentication
+* Basic Authentication::        BASIC HTTP authentication
 * Org-mode Export::             Export files to HTML and Tex
 * File Upload::                 Upload files and return their sha1sum
+* Web Socket::                  Web socket echo server
 @end menu
 
 @node Hello World, Hello World UTF8, Usage Examples, Usage Examples
@@ -289,7 +290,7 @@ files on-demand as they are requested.
 
 @verbatiminclude ../examples/7-org-mode-file-server.el
 
address@hidden File Upload, Function Index, Org-mode Export, Usage Examples
address@hidden File Upload, Web Socket, Org-mode Export, Usage Examples
 @section File Upload
 
 The following example demonstrates accessing an uploaded file.  This
@@ -308,6 +309,33 @@ $ sha1sum /usr/share/emacs/24.3/etc/COPYING
 8624bcdae55baeef00cd11d5dfcfa60f68710a02  /usr/share/emacs/24.3/etc/COPYING
 @end example
 
address@hidden Web Socket, Function Index, File Upload, Usage Examples
address@hidden Web Socket
+
+Example demonstrating the use of web sockets for full duplex
+communication between clients and the server.  Handlers may use the
address@hidden function (@pxref{ws-web-socket-connect})
+to check for and respond to a web socket upgrade request sent by the
+client (as demonstrated with the @code{new WebSocket} JavaScript code
+in the example).  Upon successfully initializing a web socket
+connection the call to @code{ws-web-socket-connect} will return the
+web socket network process.  This process may then be used by the
+server to communicate with the client over the web socket using the
address@hidden and @code{ws-web-socket-frame} functions.
+All web socket communication must be wrapped in frames using the
address@hidden function.
+
+The handler must pass a function as the second argument to
address@hidden  This function will be called on every
+web socket message received from the client.
+
address@hidden
+Note: in order to keep the web socket connection alive the request
+handler from which @code{ws-web-socket-connect} is called must return
+the @code{:keep-alive} keyword, as demonstrated in the example.
+
address@hidden ../examples/9-web-socket.el
+
 @node Function Index, Copying, Usage Examples, Top
 @chapter Function Index
 @cindex function index
@@ -426,6 +454,22 @@ Check if @code{path} is under the @code{parent} directory.
 @end example
 @end defun
 
address@hidden
address@hidden ws-web-socket-connect request handler
+If @code{request} is a web socket upgrade request (indicated by the
+presence of the @code{:SEC-WEBSOCKET-KEY} header argument) establish a
+web socket connection to the client.  Call @code{handler} on web
+socket messages received from the client.
+
address@hidden
+(ws-web-socket-connect request
+  (lambda (proc string)
+    (process-send-string proc
+      (ws-web-socket-frame (concat "you said: " string)))))
+    @result{} #<process ws-server <127.0.0.1:34921>>
address@hidden example
address@hidden defun
+
 @node Copying, GNU Free Documentation License, Function Index, Top
 @appendix GNU GENERAL PUBLIC LICENSE
 @include gpl.texi
diff --git a/examples/9-web-socket.el b/examples/9-web-socket.el
index 44b1e0f..11cb09f 100644
--- a/examples/9-web-socket.el
+++ b/examples/9-web-socket.el
@@ -50,12 +50,8 @@ function close(){ ws.close(); };
          ;; if a web-socket request, then connect and keep open
          (if (ws-web-socket-connect request
                (lambda (proc string)
-                 (message "received:%S" string)
-                 (let ((reply ))
-                   (process-send-string proc
-                     (ws-web-socket-frame (concat "you said: " string)))
-                   (sit-for 5))
-                 :keep-alive))
+                 (process-send-string proc
+                   (ws-web-socket-frame (concat "you said: " string)))))
              (prog1 :keep-alive (setq my-connection process))
            ;; otherwise send the index page
            (ws-response-header process 200 '("Content-type" . "text/html"))
diff --git a/web-server.el b/web-server.el
index e227b13..dfa924e 100644
--- a/web-server.el
+++ b/web-server.el
@@ -11,7 +11,7 @@
 ;; A web server in Emacs running handlers written in Emacs Lisp.
 ;;
 ;; Full support for GET and POST requests including URL-encoded
-;; parameters and multipart/form data.
+;; parameters and multipart/form data.  Supports web sockets.
 ;;
 ;; See the examples/ directory for examples demonstrating the usage of
 ;; the Emacs Web Server.  The following launches a simple "hello
@@ -397,34 +397,35 @@ received and parsed from the network."
 (defun ws-web-socket-parse-messages (message)
   "Web socket filter to pass whole frames to the client.
 See RFC6455."
-  (let ((index 0))
-    (cl-labels ((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))))
-                (bits-to-int (bits)
-                  (let ((place 0))
-                    (reduce #'+
-                      (mapcar (lambda (bit)
-                                (prog1 (if bit (expt 2 place) 0) (incf place)))
-                              (reverse bits)))))
-                (bits (length)
-                  (apply #'append
-                         (mapcar (lambda (int) (int-to-bits int 8))
-                                 (subseq string index (incf index length))))))
-      (with-slots (process pending data handler new) message
+  (with-slots (process active pending data handler new) message
+    (let ((index 0))
+      (cl-labels ((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 (append result nil))))
+                  (bits-to-int (bits)
+                    (let ((place 0))
+                      (apply #'+
+                       (mapcar (lambda (bit)
+                                 (prog1 (if bit (expt 2 place) 0) (incf 
place)))
+                               (reverse bits)))))
+                  (bits (length)
+                    (apply #'append
+                           (mapcar (lambda (int) (int-to-bits int 8))
+                                   (cl-subseq
+                                    pending index (incf index length))))))
         (let (fin rsvs opcode mask pl mask-key)
           ;; Parse fin bit, rsvs bits and opcode
           (let ((byte (bits 1)))
             (setq fin (car byte)
-                  rsvs (subseq byte 1 4)
+                  rsvs (cl-subseq byte 1 4)
                   opcode
-                  (let ((it (bits-to-int (subseq byte 4))))
+                  (let ((it (bits-to-int (cl-subseq byte 4))))
                     (case it
                       (0 :CONTINUATION)
                       (1 :TEXT)
@@ -445,7 +446,7 @@ See RFC6455."
           ;; Parse mask and payload length
           (let ((byte (bits 1)))
             (setq mask (car byte)
-                  pl (bits-to-int (subseq byte 1))))
+                  pl (bits-to-int (cl-subseq byte 1))))
           (unless (eq mask t)
             ;; All frames sent from client to server have this bit set to 1.
             (ws-error process "Web Socket Fail: client must mask data"))
@@ -453,10 +454,10 @@ See RFC6455."
            ((= pl 126) (setq pl (bits-to-int (bits 2))))
            ((= pl 127) (setq pl (bits-to-int (bits 8)))))
           ;; unmask data
-          (when mask (setq mask-key (subseq string index (incf index 4))))
+          (when mask (setq mask-key (cl-subseq pending index (incf index 4))))
           (setq data (concat data
                              (ws-web-socket-mask
-                              mask-key (subseq string index (+ index pl)))))
+                              mask-key (cl-subseq pending index (+ index 
pl)))))
           (if fin
               ;; wipe the message state and call the handler
               (let ((it data))