eschulte pushed a commit to branch master
in repository elpa.
commit e65938b2138a79eff9427e3e3ec69f9e577e07ab
Author: Eric Schulte <schulte.e...@gmail.com>
Date: Sun Jan 5 22:39:52 2014 -0700
no multiple concurrent entry of ws-parse-request
This fixes large file uploads, in which the ws-parse-request function
was entered multiple time simultaneously because of the process filter
preempting a running ws-parse-request.
---
doc/web-server.texi | 28 +++++++++++++++++---
web-server-test.el | 71 ++++++++++++++++++++++++++++-----------------------
web-server.el | 52 +++++++++++++++++++++----------------
3 files changed, 92 insertions(+), 59 deletions(-)
diff --git a/doc/web-server.texi b/doc/web-server.texi
index 0f5bb9a..a994413 100644
--- a/doc/web-server.texi
+++ b/doc/web-server.texi
@@ -159,7 +159,8 @@ These examples demonstrate usage.
* URL Parameter Echo:: Echo Parameters from a URL query string
* POST Echo:: Echo POST parameters back
* Basic Authentication:: BASIC HTTP Authentication
-* Org-mode Export Server:: Export files to HTML and Tex
+* Org-mode Export:: Export files to HTML and Tex
+* File Upload:: Upload files and return their sha1sum
@end menu
@node Hello World, Hello World UTF8, Usage Examples, Usage Examples
@@ -228,7 +229,7 @@ in a @code{POST} request.
@verbatiminclude ../examples/5-post-echo.el
-@node Basic Authentication, Org-mode Export Server, POST Echo, Usage Examples
+@node Basic Authentication, Org-mode Export, POST Echo, Usage Examples
@section Basic Authentication
The following example demonstrates BASIC HTTP authentication. The
@@ -254,8 +255,8 @@ proxy server (e.g., Apache or Nginx) with HTTPS support.
@verbatiminclude ../examples/6-basic-authentication.el
-@node Org-mode Export Server, Function Index, Basic Authentication, Usage
Examples
-@section Org-mode Export Server
+@node Org-mode Export, File Upload, Basic Authentication, Usage Examples
+@section Org-mode Export
The following example exports a directory of Org-mode files as either
text, HTML or LaTeX. The Org-mode export engine is used to export
@@ -263,6 +264,25 @@ files on-demand as they are requested.
@verbatiminclude ../examples/7-org-mode-file-server.el
+@node File Upload, Function Index, Org-mode Export, Usage Examples
+@section File Upload
+
+The following example demonstrates accessing an uploaded file. This
+simple server accesses the file named ``file'' and returns it's
+sha1sum and file name.
+
+@verbatiminclude ../examples/8-file-upload.el
+
+A file may be uploaded from an HTML form, or using the @code{curl}
+program as in the following example.
+
+@example
+$ curl -s -F file=@/usr/share/emacs/24.3/etc/COPYING localhost:9008
+8624bcdae55baeef00cd11d5dfcfa60f68710a02 COPYING
+$ sha1sum /usr/share/emacs/24.3/etc/COPYING
+8624bcdae55baeef00cd11d5dfcfa60f68710a02 /usr/share/emacs/24.3/etc/COPYING
+@end example
+
@node Function Index, Copying, Usage Examples, Top
@chapter Function Index
@cindex function index
diff --git a/web-server-test.el b/web-server-test.el
index ee80ae9..a3c618a 100644
--- a/web-server-test.el
+++ b/web-server-test.el
@@ -73,8 +73,11 @@
(ert-deftest ws/parse-many-headers ()
"Test that a number of headers parse successfully."
(let ((server (ws-start nil ws-test-port))
- (request (make-instance 'ws-request))
- (header-string "GET / HTTP/1.1
+ (request (make-instance 'ws-request)))
+ (unwind-protect
+ (progn
+ (setf (pending request)
+ "GET / HTTP/1.1
Host: localhost:7777
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101
Firefox/26.0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
@@ -84,10 +87,8 @@ DNT: 1
Cookie: __utma=111872281.1462392269.1345929539.1345929539.1345929539.1
Connection: keep-alive
-"))
- (unwind-protect
- (progn
- (ws-parse-request request header-string)
+")
+ (ws-parse-request request)
(let ((headers (cdr (headers request))))
(should (string= (cdr (assoc :ACCEPT-ENCODING headers))
"gzip, deflate"))
@@ -97,8 +98,11 @@ Connection: keep-alive
(ert-deftest ws/parse-post-data ()
(let ((server (ws-start nil ws-test-port))
- (request (make-instance 'ws-request))
- (header-string "POST / HTTP/1.1
+ (request (make-instance 'ws-request)))
+ (unwind-protect
+ (progn
+ (setf (pending request)
+ "POST / HTTP/1.1
User-Agent: curl/7.33.0
Host: localhost:8080
Accept: */*
@@ -116,10 +120,8 @@ Content-Disposition: form-data; name=\"name\"
\"schulte\"
------------------f1270d0deb77af03--
-"))
- (unwind-protect
- (progn
- (ws-parse-request request header-string)
+")
+ (ws-parse-request request)
(let ((headers (cdr (headers request))))
(should (string= (cdr (assoc 'content (cdr (assoc "name"
headers))))
"\"schulte\""))
@@ -130,8 +132,11 @@ Content-Disposition: form-data; name=\"name\"
(ert-deftest ws/parse-another-post-data ()
"This one from an AJAX request."
(let ((server (ws-start nil ws-test-port))
- (request (make-instance 'ws-request))
- (header-string "POST /complex.org HTTP/1.1
+ (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: */*
@@ -147,10 +152,8 @@ Connection: keep-alive
Pragma: no-cache
Cache-Control: no-cache
-org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org"))
- (unwind-protect
- (progn
- (ws-parse-request request header-string)
+org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
+ (ws-parse-request request)
(let ((headers (cdr (headers request))))
(message "headers:%S" headers)
(should (string= (cdr (assoc "path" headers)) "/complex.org"))
@@ -194,15 +197,16 @@
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
"Test that a number of headers parse successfully."
(let* ((server (ws-start nil ws-test-port))
(request (make-instance 'ws-request))
- (username "foo") (password "bar")
- (header-string (format "GET / HTTP/1.1
+ (username "foo") (password "bar"))
+ (unwind-protect
+ (progn
+ (setf (pending request)
+ (format "GET / HTTP/1.1
Authorization: Basic %s
Connection: keep-alive
-" (base64-encode-string (concat username ":" password)))))
- (unwind-protect
- (progn
- (ws-parse-request request header-string)
+" (base64-encode-string (concat username ":" password))))
+ (ws-parse-request request)
(with-slots (headers) request
(cl-tree-equal (cdr (assoc :AUTHORIZATION headers))
(cons :BASIC (cons username password)))))
@@ -212,8 +216,12 @@ Connection: keep-alive
"Test that `ws-parse-request' can handle at large file upload.
At least when it comes in a single chunk."
(let* ((long-string (mapconcat #'int-to-string (number-sequence 0 20000) "
"))
- (long-request
- (format "POST / HTTP/1.1
+ (server (ws-start nil ws-test-port))
+ (request (make-instance 'ws-request)))
+ (unwind-protect
+ (progn
+ (setf (pending request)
+ (format "POST / HTTP/1.1
User-Agent: curl/7.34.0
Host: localhost:9008
Accept: */*
@@ -229,12 +237,11 @@ Content-Type: application/octet-stream
------------------e458fb665704290b--
" long-string))
- (server (ws-start nil ws-test-port))
- (request (make-instance 'ws-request)))
- (unwind-protect
- (progn (ws-parse-request request long-request)
- (should (string= long-string
- (cdr (assoc 'content (cdr (assoc "file"
(headers request))))))))
+ (ws-parse-request request)
+ (should
+ (string= long-string
+ (cdr (assoc 'content
+ (cdr (assoc "file" (headers request))))))))
(ws-stop server))))
(provide 'web-server-test)
diff --git a/web-server.el b/web-server.el
index 3d9b016..44b4432 100644
--- a/web-server.el
+++ b/web-server.el
@@ -45,6 +45,8 @@
(pending :initarg :pending :accessor pending :initform "")
(context :initarg :context :accessor context :initform nil)
(boundary :initarg :boundary :accessor boundary :initform nil)
+ (index :initarg :index :accessor index :initform 0)
+ (active :initarg :active :accessor active :initform 0)
(headers :initarg :headers :accessor headers :initform (list nil))))
(defvar ws-servers nil
@@ -201,28 +203,31 @@ function.
(push (make-instance 'ws-request :process proc) requests))
(let ((request (cl-find-if (lambda (c) (equal proc (process c)))
requests)))
(with-slots (pending) request (setq pending (concat pending string)))
- (when (not (eq (catch 'close-connection
- (if (ws-parse-request request string)
- (ws-call-handler request handlers)
+ ;; if request is currently being parsed, just indicate new content
+ (if (> (active request) 0)
+ (incf (active request))
+ (when (not (eq (catch 'close-connection
+ (if (progn (incf (active request))
+ (ws-parse-request request))
+ (ws-call-handler request handlers)
:keep-open))
- :keep-open))
- (setq requests (cl-remove-if (lambda (r) (eql proc (process r)))
requests))
- (delete-process proc)))))
+ :keep-open))
+ (setq requests (cl-remove-if (lambda (r) (eql proc (process r)))
requests))
+ (delete-process proc))))))
-(defun ws-parse-request (request string)
+(defun ws-parse-request (request)
"Parse request STRING from REQUEST with process PROC.
Return non-nil only when parsing is complete."
- (with-slots (process pending context boundary headers) request
- (setq pending (concat pending string))
- (let ((delimiter (concat "\r\n" (if boundary (concat "--" boundary) "")))
- ;; Track progress through string, always work with the
- ;; section of string between LAST-INDEX and INDEX.
- (last-index 0) index)
- (catch 'finished-parsing-headers
+ (catch 'finished-parsing-headers
+ (with-slots (process pending context boundary headers 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)
;; parse headers and append to request
- (while (setq index (string-match delimiter pending last-index))
- (let ((tmp (+ index (length delimiter))))
- (if (= last-index index) ; double \r\n ends current run of headers
+ (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
(case context
;; Parse URL data.
;; http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4
@@ -231,7 +236,7 @@ Return non-nil only when parsing is complete."
(ws-parse-query-string
(replace-regexp-in-string
"\\+" " "
- (ws-trim (substring pending last-index)))))
+ (ws-trim (substring pending index)))))
(throw 'finished-parsing-headers t))
;; Set custom delimiter for multipart form data.
(multipart/form-data
@@ -242,14 +247,14 @@ Return non-nil only when parsing is complete."
(progn
(setcdr (last headers)
(list (ws-parse-multipart/form process
- (substring pending last-index index))))
+ (substring pending
index next-index))))
;; Boundary suffixed by "--" indicates end of the headers.
(when (and (> (length pending) (+ tmp 2))
(string= (substring pending tmp (+ tmp 2))
"--"))
(throw 'finished-parsing-headers t)))
;; Standard header parsing.
(let ((header (ws-parse process (substring pending
- last-index
index))))
+ index next-index))))
;; Content-Type indicates that the next double \r\n
;; will be followed by a special type of content which
;; will require special parsing. Thus we will note
@@ -262,9 +267,10 @@ Return non-nil only when parsing is complete."
(setq context (intern (downcase type))))
;; All other headers are collected directly.
(setcdr (last headers) header)))))
- (setq last-index tmp)))
- (setq pending (ws-trim (substring pending last-index)))
- nil))))
+ (setq index tmp)))))
+ (decf (active request))
+ (when (> (active request) 0) (ws-parse-request request))
+ nil))
(defun ws-call-handler (request handlers)
(catch 'matched-handler
