eschulte pushed a commit to branch master
in repository elpa.
commit 3ba0f3c39ee9b5fc819d549fe4c81f16496bad5d
Author: Eric Schulte <schulte.e...@gmail.com>
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))
"--"))
