[elpa] 107/119: support for content and transfer encodings

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit 6da00e75ca00ea92705e1fb7c9393e74365d9369
Author: Eric Schulte <address@hidden>
Date:   Wed Feb 12 15:36:34 2014 -0700

    support for content and transfer encodings
---
 examples/016-content-encoding-gzip.el     |   18 +++-----
 examples/017-transfer-encoding-chunked.el |   19 ++++-----
 web-server.el                             |   64 ++++++++++++++++++++++++++++-
 3 files changed, 77 insertions(+), 24 deletions(-)

diff --git a/examples/016-content-encoding-gzip.el 
b/examples/016-content-encoding-gzip.el
index 2d0d21e..7a56eb1 100644
--- a/examples/016-content-encoding-gzip.el
+++ b/examples/016-content-encoding-gzip.el
@@ -1,17 +1,11 @@
 ;;; content-encoding-gzip.el -- manual application of gzip content encoding
 (ws-start
  (lambda (request)
-   (cl-flet ((gzip (s)
-               (with-temp-buffer
-                 (insert s)
-                 (shell-command-on-region
-                  (point-min) (point-max) "gzip" nil 'replace)
-                 (buffer-string))))
-     (with-slots (process headers) request
-       (ws-response-header process 200
-         '("Content-type" . "text/plain; charset=utf-8")
-         '("Content-Encoding" . "x-gzip"))
-       (let ((s "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. 
Donec
+   (with-slots (process headers) request
+     (ws-response-header process 200
+       '("Content-type" . "text/plain; charset=utf-8")
+       '("Content-Encoding" . "x-gzip"))
+     (let ((s "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Donec
 hendrerit tempor tellus. Donec pretium posuere tellus. Proin quam
 nisl, tincidunt et, mattis eget, convallis nec, purus. Cum sociis
 natoque penatibus et magnis dis parturient montes, nascetur
@@ -26,5 +20,5 @@ natoque penatibus et magnis dis parturient montes, nascetur
 ridiculus mus. Nulla posuere. Donec vitae dolor. Nullam tristique
 diam non turpis. Cras placerat accumsan nulla. Nullam rutrum. Nam
 vestibulum accumsan nisl."))
-         (process-send-string process (gzip s))))))
+       (ws-send process s))))
  9016)
diff --git a/examples/017-transfer-encoding-chunked.el 
b/examples/017-transfer-encoding-chunked.el
index 6289e37..1ec92ed 100644
--- a/examples/017-transfer-encoding-chunked.el
+++ b/examples/017-transfer-encoding-chunked.el
@@ -1,12 +1,7 @@
 ;;; transfer-encoding-chunked.el -- manual chunked transfer encoding
 (ws-start
  (lambda (request)
-   (cl-flet ((chunk (s) (format "%x\r\n%s\r\n" (string-bytes s) s)))
-     (with-slots (process headers) request
-       (ws-response-header process 200
-         '("Content-type" . "text/plain; charset=utf-8")
-         '("Transfer-Encoding" . "chunked"))
-       (let ((s "
+   (let ((s "
 Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Donec
 hendrerit tempor tellus. Donec pretium posuere tellus. Proin quam
 nisl, tincidunt et, mattis eget, convallis nec, purus. Cum sociis
@@ -23,8 +18,12 @@ ridiculus mus. Nulla posuere. Donec vitae dolor. Nullam 
tristique
 diam non turpis. Cras placerat accumsan nulla. Nullam rutrum. Nam
 vestibulum accumsan nisl.
 "))
-         (process-send-string process (chunk s)) (sit-for 0.5)
-         (process-send-string process (chunk s)) (sit-for 0.5)
-         (process-send-string process (chunk s)) (sit-for 0.5)
-         (process-send-string process "0\r\n\r\n")))))
+     (with-slots (process headers) request
+       (ws-response-header process 200
+         '("Content-type" . "text/plain; charset=utf-8")
+         '("Transfer-Encoding" . "chunked"))
+       (ws-send process s) (sit-for 0.5)
+       (ws-send process s) (sit-for 0.5)
+       (ws-send process s) (sit-for 0.5)
+       (ws-send process s))))
  9017)
diff --git a/web-server.el b/web-server.el
index 5c6e758..4e885f0 100644
--- a/web-server.el
+++ b/web-server.el
@@ -220,6 +220,9 @@ function.
                              (ws-call-handler request handlers)
                            :keep-alive))
                        :keep-alive))
+          ;; Properly shut down processes requiring an ending (e.g., chunked)
+          (let ((ender (plist-get (process-plist proc) :ender)))
+            (when ender (process-send-string proc ender)))
           (setq requests (cl-remove-if (lambda (r) (eql proc (process r))) 
requests))
           (delete-process proc))))))
 
@@ -376,8 +379,6 @@ received and parsed from the network."
       (ws-web-socket-parse-messages message))
     (setf (active message) nil)))
 
-
-
 (defun ws-web-socket-mask (masking-key data)
   (let ((masking-data (apply #'concat (make-list (+ 1 (/ (length data) 4))
                                                  masking-key))))
@@ -510,11 +511,61 @@ See RFC6455."
      string)))
 
 
+;;; Content and Transfer encoding support
+(defvar ws-compress-cmd "compress"
+  "Command used for the \"compress\" Content or Transfer coding.")
+
+(defvar ws-deflate-cmd "zlib-flate -compress"
+  "Command used for the \"deflate\" Content or Transfer coding.")
+
+(defvar ws-gzip-cmd "gzip"
+  "Command used for the \"gzip\" Content or Transfer coding.")
+
+(defmacro ws-encoding-cmd-to-fn (cmd)
+  "Return a function which applies CMD to strings."
+  `(lambda (s)
+     (with-temp-buffer
+       (insert s)
+       (shell-command-on-region (point-min) (point-max) ,cmd nil 'replace)
+       (buffer-string))))
+
+(defun ws-chunk (string)
+  "Convert STRING to a valid chunk for HTTP chunked Transfer-encoding."
+  (format "%x\r\n%s\r\n" (string-bytes string) string))
+
+
 ;;; Convenience functions to write responses
 (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."
+  ;; update process to reflect any Content or Transfer encodings
+  (let ((content  (cdr (assoc "Content-Encoding" headers)))
+        (transfer (cdr (assoc "Transfer-Encoding" headers))))
+    (when content
+      (set-process-plist proc
+        (append
+         (list :content-encoding
+               (ecase (intern content)
+                 ((compress x-compress) (ws-encoding-cmd-to-fn 
ws-compress-cmd))
+                 ((deflate x-deflate)   (ws-encoding-cmd-to-fn ws-deflate-cmd))
+                 ((gzip x-gzip)         (ws-encoding-cmd-to-fn ws-gzip-cmd))
+                 (identity #'identity)
+                 ((exi pack200-zip)
+                  (ws-error proc "`%s' Content-encoding not supported."
+                            content))))
+         (process-plist proc))))
+    (when transfer
+      (set-process-plist proc
+        (append
+         (when (string= transfer "chunked") (list :ender "0\r\n\r\n"))
+         (list :transfer-encoding
+               (ecase (intern transfer)
+                 (chunked  #'ws-chunk)
+                 ((compress x-compress) (ws-encoding-cmd-to-fn 
ws-compress-cmd))
+                 ((deflate x-deflate)   (ws-encoding-cmd-to-fn ws-deflate-cmd))
+                 ((gzip x-gzip)         (ws-encoding-cmd-to-fn ws-gzip-cmd))))
+         (process-plist proc)))))
   (let ((headers
          (cons
           (format "HTTP/1.1 %d %s" code (cdr (assoc code ws-status-codes)))
@@ -522,6 +573,15 @@ Currently CODE should be an HTTP status code, see
     (setcdr (last headers) (list "" ""))
     (process-send-string proc (mapconcat #'identity headers "\r\n"))))
 
+(defun ws-send (proc string)
+  "Send STRING to process PROC.
+If any Content or Transfer encodings are in use, apply them to
+STRING before sending."
+  (let
+      ((cc (or (plist-get (process-plist proc) :content-encoding) #'identity))
+       (tc (or (plist-get (process-plist proc) :transfer-encoding) 
#'identity)))
+    (process-send-string proc (funcall tc (funcall cc string)))))
+
 (defun ws-send-500 (proc &rest msg-and-args)
   "Send 500 \"Internal Server Error\" to PROC with an optional message."
   (ws-response-header proc 500