[elpa] 65/119: handle POST file uploads w/example

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit 3ba0f3c39ee9b5fc819d549fe4c81f16496bad5d
Author: Eric Schulte <address@hidden>
Date:   Sat Jan 4 22:16:14 2014 -0700

    handle POST file uploads w/example
---
 examples/5-post-echo.el   |    2 +-
 examples/8-file-upload.el |   11 +++++++++++
 web-server-test.el        |    8 ++++----
 web-server.el             |   23 ++++++++++++++++-------
 4 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/examples/5-post-echo.el b/examples/5-post-echo.el
index daa2e30..068b410 100644
--- a/examples/5-post-echo.el
+++ b/examples/5-post-echo.el
@@ -7,7 +7,7 @@
           (ws-response-header process 200 '("Content-type" . "text/plain"))
           (process-send-string process
             (if message
-                (format "you said %S\n" message)
+                (format "you said %S\n" (cdr (assoc 'content message)))
               "This is a POST request, but it has no \"message\".\n"))))))
    ((:GET . ".*") .
     (lambda (request)
diff --git a/examples/8-file-upload.el b/examples/8-file-upload.el
new file mode 100644
index 0000000..d445c97
--- /dev/null
+++ b/examples/8-file-upload.el
@@ -0,0 +1,11 @@
+;;; file-upload.el --- use an uploaded file
+(ws-start
+ '(((:POST . ".*") .
+    (lambda (request)
+      (with-slots (process headers) request
+        (ws-response-header process 200 '("Content-type" . "text/plain"))
+        (let ((file (cdr (assoc "file" headers))))
+          (process-send-string process
+            (concat (sha1 (cdr (assoc 'content file))) "  "
+                    (cdr (assoc 'filename file)) "\n")))))))
+ 9008)
diff --git a/web-server-test.el b/web-server-test.el
index b371e7d..3a889ce 100644
--- a/web-server-test.el
+++ b/web-server-test.el
@@ -121,10 +121,10 @@ Content-Disposition: form-data; name=\"name\"
         (progn
           (ws-parse-request request header-string)
           (let ((headers (cdr (headers request))))
-            (should (string= (cdr (assoc "name" headers))
+            (should (string= (cdr (assoc 'content (cdr (assoc "name" 
headers))))
                              "\"schulte\""))
-            (should (string= (cdr (assoc "date" headers))
-                             "Wed Dec 18 00:55:39 MST 2013"))))
+            (should (string= (cdr (assoc 'content (cdr (assoc "date" 
headers))))
+                             "Wed Dec 18 00:55:39 MST 2013\n"))))
       (ws-stop server))))
 
 (ert-deftest ws/parse-another-post-data ()
@@ -175,7 +175,7 @@ 
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
                (ws-response-header process 200
                  '("Content-type" . "text/plain"))
                (process-send-string process
-                 (format "you said %S\n" message)))))))
+                 (format "you said %S\n" (cdr (assoc 'content message)))))))))
     (should (string= (ws-test-curl-to-string "" nil '(("message" . "foo")))
                      "you said \"foo\"\n"))))
 
diff --git a/web-server.el b/web-server.el
index 06ed2b9..3d9b016 100644
--- a/web-server.el
+++ b/web-server.el
@@ -178,12 +178,22 @@ function.
                        (setq string (substring string 1))))))
   string)
 
-(defun ws-parse-multipart/form (string)
+(defun ws-parse-multipart/form (proc string)
   ;; ignore empty and non-content blocks
   (when (string-match "Content-Disposition:[[:space:]]*\\(.*\\)\r\n" string)
-    (let ((dp (mail-header-parse-content-disposition (match-string 1 string))))
-      (cons (cdr (assoc 'name (cdr dp)))
-            (ws-trim (substring string (match-end 0)))))))
+    (let ((dp (cdr (mail-header-parse-content-disposition
+                    (match-string 1 string))))
+          (last-index (match-end 0))
+          index)
+      ;; every line up until the double \r\n is a header
+      (while (and (setq index (string-match "\r\n" string last-index))
+                  (not (= index last-index)))
+        (setcdr (last dp) (ws-parse proc (substring string last-index index)))
+        (setq last-index (+ 2 index)))
+      ;; after double \r\n is all content
+      (cons (cdr (assoc 'name dp))
+            (cons (cons 'content (substring string (+ 2 last-index)))
+                  dp)))))
 
 (defun ws-filter (proc string)
   (with-slots (handlers requests) (plist-get (process-plist proc) :server)
@@ -231,9 +241,8 @@ Return non-nil only when parsing is complete."
               (if (eql context 'multipart/form-data)
                   (progn
                     (setcdr (last headers)
-                            (list (ws-parse-multipart/form
-                                   (ws-trim
-                                    (substring pending last-index index)))))
+                            (list (ws-parse-multipart/form process
+                                   (substring pending last-index index))))
                     ;; Boundary suffixed by "--" indicates end of the headers.
                     (when (and (> (length pending) (+ tmp 2))
                                (string= (substring pending tmp (+ tmp 2)) 
"--"))