[elpa] master b0d5113 8/8: Merge commit '33afdb46e1cd61251736816d965495525b36c9cd'

[Stefan Monnier]

branch: master
commit b0d5113230fdac14c2676fb2f698ae4087a289a3
Merge: c7480d7 33afdb4
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Merge commit '33afdb46e1cd61251736816d965495525b36c9cd'
---
 packages/web-server/web-server-test.el | 39 ++++++++++++++++++-
 packages/web-server/web-server.el      | 68 ++++++++++++++++++++--------------
 2 files changed, 79 insertions(+), 28 deletions(-)

diff --git a/packages/web-server/web-server-test.el 
b/packages/web-server/web-server-test.el
index 78c6efc..7ea02fa 100644
--- a/packages/web-server/web-server-test.el
+++ b/packages/web-server/web-server-test.el
@@ -177,9 +177,46 @@ 
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
 - three
 - four
 
-"))))
+"))
+            (should (string= (cdr (assoc :CONTENT-TYPE headers))
+                             "application/x-www-form-urlencoded; 
charset=UTF-8"))
+            (should (string= (oref request body)
+                             
"org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org"))))
       (ws-stop server))))
 
+(ert-deftest ws/parse-json-data ()
+  "Ensure we can send arbitrary data through to the handler
+
+The handler can then parse it itself."
+  (let ((server (ws-start nil ws-test-port))
+        (request (make-instance 'ws-request)))
+    (unwind-protect
+        (progn
+          (setf (pending request)
+                "POST /complex.org HTTP/1.1
+Host: localhost:4444
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 
Firefox/26.0
+Accept: */*
+Accept-Language: en-US,en;q=0.5
+Accept-Encoding: gzip, deflate
+DNT: 1
+Content-Type: application/json
+Referer: http://localhost:4444/complex.org
+Content-Length: 33
+Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
+Connection: keep-alive
+Pragma: no-cache
+Cache-Control: no-cache
+
+{\"some example\": \"json data\"}")
+          (ws-parse-request request)
+          (let ((headers (cdr (headers request))))
+            (should (string= (cdr (assoc :CONTENT-TYPE headers))
+                             "application/json"))
+            (should (string= (oref request body)
+                             "{\"some example\": \"json data\"}")))
+      (ws-stop server)))))
+
 (ert-deftest ws/simple-post ()
   "Test a simple POST server."
   (ws-test-with
diff --git a/packages/web-server/web-server.el 
b/packages/web-server/web-server.el
index 1c06304..ab8da73 100644
--- a/packages/web-server/web-server.el
+++ b/packages/web-server/web-server.el
@@ -4,7 +4,7 @@
 
 ;; Author: Eric Schulte <address@hidden>
 ;; Maintainer: Eric Schulte <address@hidden>
-;; Version: 0.1.1
+;; Version: 0.1.2
 ;; Package-Requires: ((emacs "24.3"))
 ;; Keywords: http, server, network
 ;; URL: https://github.com/eschulte/emacs-web-server
@@ -62,7 +62,8 @@
    (boundary :initarg :boundary :accessor boundary :initform nil)
    (index    :initarg :index    :accessor index    :initform 0)
    (active   :initarg :active   :accessor active   :initform nil)
-   (headers  :initarg :headers  :accessor headers  :initform (list nil))))
+   (headers  :initarg :headers  :accessor headers  :initform (list nil))
+   (body     :initarg :body     :accessor body     :initform "")))
 
 (defvar ws-servers nil
   "List holding all web servers.")
@@ -123,7 +124,7 @@ function.
            :service (port server)
            :filter 'ws-filter
            :server t
-           :nowait t
+           :nowait (< emacs-major-version 26)
            :family 'ipv4
            :coding 'no-conversion
            :plist (append (list :server server)
@@ -246,30 +247,43 @@ function.
   "Parse request STRING from REQUEST with process PROC.
 Return non-nil only when parsing is complete."
   (catch 'finished-parsing-headers
-    (with-slots (process pending context boundary headers index) request
+    (with-slots (process pending context boundary headers body index) request
       (let ((delimiter (concat "\r\n" (if boundary (concat "--" boundary) "")))
             ;; Track progress through string, always work with the
             ;; section of string between INDEX and NEXT-INDEX.
-            next-index)
+            next-index
+            body-stored)
         ;; parse headers and append to request
         (while (setq next-index (string-match delimiter pending index))
           (let ((tmp (+ next-index (length delimiter))))
             (if (= index next-index) ; double \r\n ends current run of headers
-                (cl-case context
-                  ;; Parse URL data.
-                  ;; http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4
-                  (application/x-www-form-urlencoded
-                   (mapc (lambda (pair) (setcdr (last headers) (list pair)))
-                         (ws-parse-query-string
-                          (replace-regexp-in-string
-                           "\\+" " "
-                           (ws-trim (substring pending index)))))
-                   (throw 'finished-parsing-headers t))
-                  ;; Set custom delimiter for multipart form data.
-                  (multipart/form-data
-                   (setq delimiter (concat "\r\n--" boundary)))
-                  ;; No special context so we're done.
-                  (t (throw 'finished-parsing-headers t)))
+                (progn
+                  ;; Store the body
+                  (unless
+                      ;; Multipart form data has multiple passes - store on
+                      ;; first pass only.
+                      body-stored
+                    (let ((after-headers (substring pending index)))
+                      (when (string-prefix-p "\r\n" after-headers)
+                        (setq body
+                              ;; Trim off the additional CRLF
+                              (substring after-headers 2))))
+                    (setq body-stored t))
+                  (cl-case context
+                    ;; Parse URL data.
+                    ;; http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4
+                    (application/x-www-form-urlencoded
+                     (mapc (lambda (pair) (setcdr (last headers) (list pair)))
+                           (ws-parse-query-string
+                            (replace-regexp-in-string
+                             "\\+" " "
+                             (ws-trim (substring pending index)))))
+                     (throw 'finished-parsing-headers t))
+                    ;; Set custom delimiter for multipart form data.
+                    (multipart/form-data
+                     (setq delimiter (concat "\r\n--" boundary)))
+                    ;; No special context so we're done.
+                    (t (throw 'finished-parsing-headers t))))
               (if (eql context 'multipart/form-data)
                   (progn
                     (setcdr (last headers)
@@ -287,13 +301,13 @@ Return non-nil only when parsing is complete."
                   ;; will require special parsing.  Thus we will note
                   ;; the type in the CONTEXT variable for parsing
                   ;; dispatch above.
-                  (if (and (caar header) (eql (caar header) :CONTENT-TYPE))
-                      (cl-destructuring-bind (type &rest data)
-                          (mail-header-parse-content-type (cdar header))
-                        (setq boundary (cdr (assoc 'boundary data)))
-                        (setq context (intern (downcase type))))
-                    ;; All other headers are collected directly.
-                    (setcdr (last headers) header)))))
+                  (when (and (caar header) (eql (caar header) :CONTENT-TYPE))
+                    (cl-destructuring-bind (type &rest data)
+                        (mail-header-parse-content-type (cdar header))
+                      (setq boundary (cdr (assoc 'boundary data)))
+                      (setq context (intern (downcase type)))))
+                  ;; All other headers are collected directly.
+                  (setcdr (last headers) header))))
             (setq index tmp)))))
     (setf (active request) nil)
     nil))