eschulte pushed a commit to branch master
in repository elpa.
commit fe9d40141d2a87d4c6ffd68a9e5b55a68160691b
Author: Eric Schulte <schulte.e...@gmail.com>
Date: Wed Dec 25 00:25:36 2013 -0700
new request object
---
NOTES | 12 ++++-
doc/emacs-web-server.texi | 119 ++++++++++++++++++++++++++++++--------------
emacs-web-server-test.el | 38 +++++++-------
emacs-web-server.el | 90 +++++++++++++++-------------------
4 files changed, 150 insertions(+), 109 deletions(-)
diff --git a/NOTES b/NOTES
index a415dc1..26e018a 100644
--- a/NOTES
+++ b/NOTES
@@ -1,7 +1,7 @@
-*- org -*-
* Notes
-* Tasks [6/9]
+* Tasks [7/9]
** TODO Documentation [0/4]
- [ ] introduction
- [ ] handlers
@@ -41,12 +41,20 @@ e.g., parameter strings
- [X] function to send a file (with mime handling)
- [X] send a 404 with some default text
-** TODO Lazy header processing
+** CANCELED Lazy header processing
+ - State "CANCELED" from "TODO" [2013-12-25 Wed 12:21] \\
+ premature optimization
Use lazy sequence functions for header a-list to avoid parsing all
headers. For regexp matchers should stop when matched header is
encountered (often the first one when :GET), For function matchers
provide lazy version of assoc.
+Also, there is the issue of how a lazy request for more parameters
+should act before all incoming text has been received. Emacs does not
+provide a light-weight mechanism for a function to wait for incoming
+process text without something gross like the =(sit-for 0.1)= used in
+the test suite.
+
** TODO use gnutls for https
I think this should work.
* Documentation
diff --git a/doc/emacs-web-server.texi b/doc/emacs-web-server.texi
index e41421e..e5ac1c9 100644
--- a/doc/emacs-web-server.texi
+++ b/doc/emacs-web-server.texi
@@ -43,7 +43,7 @@ A copy of the license is included in the section entitled
@menu
* Introduction:: Getting to know the Emacs Web Server
* Handlers:: Handlers respond to HTTP requests
-* Request Headers:: Getting information on HTTP requests
+* Request:: Getting information on HTTP requests
* Usage Examples:: Examples demonstrating usage
* Function Index:: List of Functions
@@ -68,56 +68,63 @@ Appendices
The Emacs Web Server is a Web server implemented in Emacs Lisp using
Emacs network communication primitives. HTTP requests are matched to
handlers (@pxref{Handlers}) which are implemented as Emacs Lisp
-functions. Handler functions receive the HTTP connection process and
-a request object (@pxref{Request Headers}) which holds information
-about the request. Handlers write responses directly to the
-connection process.
+functions. Handler functions receive a request object
+(@pxref{Request}) which holds information about the request and the
+HTTP connection process. Handlers write their responses directly to
+the connection process.
A number of examples (@pxref{Usage Examples}) demonstrate usage of the
-Emacs Web Server, as well as a complete list of the functions defining
-the interface (@pxref{Function Index}).
+Emacs Web Server. Finally, the functions defining the interface are
+listed (@pxref{Function Index}).
-@node Handlers, Request Headers, Handlers, Top
+@node Handlers, Request, Handlers, Top
@chapter Handlers
@cindex handlers
-A handler looks like this and does this.
+The Emacs Web Server is started with the @code{ews-start} function
+which takes a ``handlers'' association list which is composed of pairs
+of matchers and handler functions.
-@node Request Headers, Usage Examples, Handlers, Top
-@chapter Request Headers
-@cindex request headers
+@emph{Matchers} may be either a simple regular expression or a
+function. A simple matcher consists of an HTTP header and a regular
+expression. When the regular expression matches the content of that
+header the simple matcher succeeds and the associated handler is
+called. For example the following matches any @code{GET} request
+whose path starts with the substring ``foo''.
-Information on requests is stored in a @code{request} object. This object is
-used to decide which handler to call, and is passed to the called handler.
-Request objects hold information such as the type of request (@code{GET},
-@code{POST}, etc.), the path of the request, and any parameter information
-encoded in the request URL as form data.
+@example
+(:GET . "^foo")
+@end example
+
+A complex matcher is a function which takes the request object
+(@pxref{Request}) and succeeds when the function returns a non-nil
+value. For example the following matcher matches every request
-The request is received as a string which is parsed into an alist.
-This parsing is only performed as needed by a handler or as necessary
-to select a handler to call. HTML Headers are keyed using uppercase
-keywords (e.g., @code{:GET}), and user supplied parameters are keyed
-using the string name of the parameter. The following functions may
-be used to read request alists and cause any needed parsing to take
-place as a side effect.
+@example
+(lambda (_) t)
+@end example
-@defun ews-get item request
-@code{ews-get} returns the value associated with @code{item} in
-@code{request}. Any pending parsing of the @code{request} is
-performed until @code{item} is found.
+and the following matches only requests in which the supplied
+``number'' parameter is odd.
@example
-(ews-get :GET request)
- @result{} "/"
- ;; Effect: Only the first line of the request is parsed.
-(ews-get "foo" request)
- @result{} "bar"
- ;; Effect: Parameters are parsed until one named "foo" is
- ;; found or no more parameters are left.
+(lambda (request) (oddp (cdr (assoc "number" request))))
@end example
-@end defun
-@node Usage Examples, Hello World, Request Headers, Top
+@node Request, Usage Examples, Handlers, Top
+@chapter Request
+@cindex request
+
+Information on requests is stored in a @code{request} object. The
+request object is used to decide which handler to call, and is passed
+to the called handler. This object holds information on the request
+including the request process, all HTTP headers, and parameters.
+
+The text of the request is parsed into an alist. HTML Headers are
+keyed using uppercase keywords (e.g., @code{:GET}), and user supplied
+parameters are keyed using the string name of the parameter.
+
+@node Usage Examples, Hello World, Request, Top
@chapter Usage Examples
@cindex usage examples
@@ -161,7 +168,43 @@ POST parameters are used for example when HTML forms are
submitted.
@chapter Function Index
@cindex function index
-These are the main functions one would use.
+The following functions implement the Emacs Web Server public API.
+
+To start and stop servers, use the following functions.
+
+@itemize
+@item ews-start
+@item ews-stop
+@end itemize
+
+All running servers are stored in the @code{ews-servers} variable.
+
+@itemize
+@item ews-servers
+@end itemize
+
+Each ews-server is an instance of the @code{ews-server} class.
+
+@itemize
+@item ews-server
+@end itemize
+
+Each request object is an instance of the @code{ews-client} class.
+
+@itemize
+@item ews-request
+@end itemize
+
+The following convenience functions automate many common tasks
+associated with responding to HTTP requests.
+
+@itemize
+@item ews-response-header
+@item ews-send-500
+@item ews-send-404
+@item ews-send-file
+@item ews-subdirectoryp
+@end itemize
@node Copying, GNU Free Documentation License, Function Index, Top
@appendix GNU GENERAL PUBLIC LICENSE
diff --git a/emacs-web-server-test.el b/emacs-web-server-test.el
index 3f16b1d..62dad3e 100644
--- a/emacs-web-server-test.el
+++ b/emacs-web-server-test.el
@@ -18,9 +18,8 @@
(async-shell-command
(format "curl -m 4 %s %s localhost:%s/%s"
(if get-params
- (format "%s %S"
- (mapconcat (lambda (p) (format "%s=%s" (car p) (cdr p)))
- get-params "&"))
+ (mapconcat (lambda (p) (format "-d '%s=%s'" (car p) (cdr p)))
+ get-params " ")
"")
(if post-params
(mapconcat (lambda (p) (format "-s -F '%s=%s'" (car p) (cdr p)))
@@ -36,7 +35,7 @@
(defmacro ews-test-with (handler &rest body)
(declare (indent 1))
- (let ((srv (gensym)))
+ (let ((srv (cl-gensym)))
`(let* ((,srv (ews-start ,handler ews-test-port)))
(unwind-protect (progn ,@body) (ews-stop ,srv)))))
(def-edebug-spec ews-test-with (form body))
@@ -45,10 +44,10 @@
"Ensure that a simple keyword-style handler matches correctly."
(ews-test-with (mapcar (lambda (letter)
`((:GET . ,letter) .
- (lambda (proc request)
- (ews-response-header proc 200
+ (lambda (request)
+ (ews-response-header (process request) 200
'("Content-type" . "text/plain"))
- (process-send-string proc
+ (process-send-string (process request)
(concat "returned:" ,letter)))))
'("a" "b"))
(should (string= "returned:a" (ews-test-curl-to-string "a")))
@@ -58,9 +57,10 @@
"Test that a simple hello-world server responds."
(ews-test-with
'(((lambda (_) t) .
- (lambda (proc request)
- (ews-response-header proc 200 '("Content-type" . "text/plain"))
- (process-send-string proc "hello world"))))
+ (lambda (request)
+ (ews-response-header (process request) 200
+ '("Content-type" . "text/plain"))
+ (process-send-string (process request) "hello world"))))
(should (string= (ews-test-curl-to-string "") "hello world"))))
(ert-deftest ews/removed-from-ews-servers-after-stop ()
@@ -73,7 +73,7 @@
(ert-deftest ews/parse-many-headers ()
"Test that a number of headers parse successfully."
(let ((server (ews-start nil ews-test-port))
- (client (make-instance 'ews-client))
+ (request (make-instance 'ews-request))
(header-string "GET / HTTP/1.1
Host: localhost:7777
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101
Firefox/26.0
@@ -87,8 +87,8 @@ Connection: keep-alive
"))
(unwind-protect
(progn
- (ews-parse-request (process server) client header-string)
- (let ((headers (cdr (headers client))))
+ (ews-parse-request request header-string)
+ (let ((headers (cdr (headers request))))
(should (string= (cdr (assoc :ACCEPT-ENCODING headers))
"gzip, deflate"))
(should (string= (cdr (assoc :GET headers)) "/"))
@@ -97,7 +97,7 @@ Connection: keep-alive
(ert-deftest ews/parse-post-data ()
(let ((server (ews-start nil ews-test-port))
- (client (make-instance 'ews-client))
+ (request (make-instance 'ews-request))
(header-string "POST / HTTP/1.1
User-Agent: curl/7.33.0
Host: localhost:8080
@@ -119,8 +119,8 @@ Content-Disposition: form-data; name=\"name\"
"))
(unwind-protect
(progn
- (ews-parse-request (process server) client header-string)
- (let ((headers (cdr (headers client))))
+ (ews-parse-request request header-string)
+ (let ((headers (cdr (headers request))))
(should (string= (cdr (assoc "name" headers))
"\"schulte\""))
(should (string= (cdr (assoc "date" headers))
@@ -130,7 +130,7 @@ Content-Disposition: form-data; name=\"name\"
(ert-deftest ews/parse-another-post-data ()
"This one from an AJAX request."
(let ((server (ews-start nil ews-test-port))
- (client (make-instance 'ews-client))
+ (request (make-instance 'ews-request))
(header-string "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
@@ -150,8 +150,8 @@ Cache-Control: no-cache
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org"))
(unwind-protect
(progn
- (ews-parse-request (process server) client header-string)
- (let ((headers (cdr (headers client))))
+ (ews-parse-request request header-string)
+ (let ((headers (cdr (headers request))))
(message "headers:%S" headers)
(should (string= (cdr (assoc "path" headers)) "/complex.org"))
(should (string= (cdr (assoc "beg" headers)) "646"))
diff --git a/emacs-web-server.el b/emacs-web-server.el
index 23e6cbf..a97e56e 100644
--- a/emacs-web-server.el
+++ b/emacs-web-server.el
@@ -17,19 +17,20 @@
(defclass ews-server ()
((handlers :initarg :handlers :accessor handlers :initform nil)
- (process :initarg :process :accessor process :initform nil)
- (port :initarg :port :accessor port :initform nil)
- (clients :initarg :clients :accessor clients :initform nil)))
+ (process :initarg :process :accessor process :initform nil)
+ (port :initarg :port :accessor port :initform nil)
+ (requests :initarg :requests :accessor requests :initform nil)))
-(defclass ews-client ()
- ((leftover :initarg :leftover :accessor leftover :initform "")
+(defclass ews-request ()
+ ((process :initarg :process :accessor process :initform nil)
+ (pending :initarg :pending :accessor pending :initform "")
(boundary :initarg :boundary :accessor boundary :initform nil)
(headers :initarg :headers :accessor headers :initform (list nil))))
(defvar ews-servers nil
"List holding all ews servers.")
-(defvar ews-time-format "%Y.%m.%d.%H.%M.%S.%N"
+(defvar ews-log-time-format "%Y.%m.%d.%H.%M.%S.%N"
"Logging time format passed to `format-time-string'.")
(defun ews-start (handlers port &optional log-buffer &rest network-args)
@@ -84,13 +85,13 @@ function.
:plist (append (list :server server)
(when log (list :log-buffer log)))
:log (when log
- (lambda (proc client message)
- (let ((c (process-contact client))
+ (lambda (proc request message)
+ (let ((c (process-contact request))
(buf (plist-get (process-plist proc) :log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(insert (format "%s\t%s\t%s\t%s"
- (format-time-string ews-time-format)
+ (format-time-string
ews-log-time-format)
(first c) (second c) message))))))
network-args))
(push server ews-servers)
@@ -99,7 +100,7 @@ function.
(defun ews-stop (server)
"Stop SERVER."
(setq ews-servers (remove server ews-servers))
- (mapc #'delete-process (append (mapcar #'car (clients server))
+ (mapc #'delete-process (append (mapcar #'car (requests server))
(list (process server)))))
(defvar ews-http-common-methods '(GET HEAD POST PUT DELETE TRACE)
@@ -145,25 +146,25 @@ function.
(ews-trim (substring string (match-end 0)))))))
(defun ews-filter (proc string)
- (with-slots (handlers clients) (plist-get (process-plist proc) :server)
- (unless (assoc proc clients)
- (push (cons proc (make-instance 'ews-client)) clients))
- (let ((c (cdr (assoc proc clients))))
+ (with-slots (handlers requests) (plist-get (process-plist proc) :server)
+ (unless (cl-find-if (lambda (c) (equal proc (process c))) requests)
+ (push (make-instance 'ews-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 (ews-parse-request proc c string)
- (ews-call-handler proc (cdr (headers c)) handlers)
- :keep-open))
+ (if (ews-parse-request request string)
+ (ews-call-handler request handlers)
+ :keep-open))
:keep-open))
- (setq clients (assq-delete-all proc clients))
+ (setq requests (cl-remove-if (lambda (r) (eql proc (process r)))
requests))
(delete-process proc)))))
-(defun ews-parse-request (proc client string)
- "Parse request STRING from CLIENT with process PROC.
-Return non-nil only when parsing is complete and CLIENT may be
-deleted."
- (with-slots (leftover boundary headers) client
- (let ((pending (concat leftover string))
- (delimiter (concat "\r\n" (if boundary (concat "--" boundary) "")))
+(defun ews-parse-request (request string)
+ "Parse request STRING from REQUEST with process PROC.
+Return non-nil only when parsing is complete."
+ (with-slots (process pending 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
@@ -171,7 +172,7 @@ deleted."
;; custom parsing or nil for no special parsing.
context)
(catch 'finished-parsing-headers
- ;; parse headers and append to client
+ ;; 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
@@ -201,8 +202,8 @@ deleted."
(string= (substring pending tmp (+ tmp 2))
"--"))
(throw 'finished-parsing-headers t)))
;; Standard header parsing.
- (let ((header
- (ews-parse proc (substring pending last-index index))))
+ (let ((header (ews-parse process (substring pending
+ last-index
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
@@ -216,25 +217,27 @@ deleted."
;; All other headers are collected directly.
(setcdr (last headers) header)))))
(setq last-index tmp)))
- (setq leftover (ews-trim (substring pending last-index)))
+ (setq pending (ews-trim (substring pending last-index)))
nil))))
-(defun ews-call-handler (proc request handlers)
+ (defun ews-call-handler (request handlers)
(catch 'matched-handler
(mapc (lambda (handler)
(let ((match (car handler))
(function (cdr handler)))
(when (or (and (consp match)
- (assoc (car match) request)
+ (assoc (car match) (headers request))
(string-match (cdr match)
- (cdr (assoc (car match) request))))
+ (cdr (assoc (car match)
+ (headers request)))))
(and (functionp match) (funcall match request)))
(throw 'matched-handler
- (condition-case e
- (funcall function proc request)
- (error (ews-error proc "Caught Error: %S" e)))))))
+ (condition-case e (funcall function request)
+ (error (ews-error (process request)
+ "Caught Error: %S" e)))))))
handlers)
- (ews-error proc "no handler matched request: %S" request)))
+ (ews-error (process request) "no handler matched request: %S"
+ (headers request))))
(defun ews-error (proc msg &rest args)
(let ((buf (plist-get (process-plist proc) :log-buffer))
@@ -243,25 +246,12 @@ deleted."
(with-current-buffer buf
(goto-char (point-max))
(insert (format "%s\t%s\t%s\tEWS-ERROR: %s"
- (format-time-string ews-time-format)
+ (format-time-string ews-log-time-format)
(first c) (second c)
(apply #'format msg args)))))
(apply #'ews-send-500 proc msg args)))
-;;; Lazy request access functions
-(defun ews-get (item request)
- "Get ITEM from Request.
-Perform any pending parsing of REQUEST until ITEM is found. This
-is equivalent to calling (cdr (assoc ITEM (ews-alist REQUEST)))
-except that once ITEM is found no further parsing is performed."
- )
-
-(defun ews-alist (request)
- "Finish parsing REQUEST and return the resulting alist."
- )
-
-
;;; Convenience functions to write responses
(defun ews-response-header (proc code &rest header)
"Send the headers for an HTTP response to PROC.
