[elpa] 45/119: new request object

[Eric Schulte]

eschulte pushed a commit to branch master
in repository elpa.

commit fe9d40141d2a87d4c6ffd68a9e5b55a68160691b
Author: Eric Schulte <address@hidden>
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}).
 
address@hidden Handlers, Request Headers, Handlers, Top
address@hidden 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.
 
address@hidden Request Headers, Usage Examples, Handlers, Top
address@hidden Request Headers
address@hidden request headers
address@hidden 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},
address@hidden, etc.), the path of the request, and any parameter information
-encoded in the request URL as form data.
address@hidden
+(:GET . "^foo")
address@hidden 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.
address@hidden
+(lambda (_) t)
address@hidden example
 
address@hidden ews-get item request
address@hidden returns the value associated with @code{item} in
address@hidden  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
address@hidden defun
 
address@hidden Usage Examples, Hello World, Request Headers, Top
address@hidden Request, Usage Examples, Handlers, Top
address@hidden Request
address@hidden 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.
+
address@hidden 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.
+
address@hidden
address@hidden ews-start
address@hidden ews-stop
address@hidden itemize
+
+All running servers are stored in the @code{ews-servers} variable.
+
address@hidden
address@hidden ews-servers
address@hidden itemize
+
+Each ews-server is an instance of the @code{ews-server} class.
+
address@hidden
address@hidden ews-server
address@hidden itemize
+
+Each request object is an instance of the @code{ews-client} class.
+
address@hidden
address@hidden ews-request
address@hidden itemize
+
+The following convenience functions automate many common tasks
+associated with responding to HTTP requests.
+
address@hidden
address@hidden ews-response-header
address@hidden ews-send-500
address@hidden ews-send-404
address@hidden ews-send-file
address@hidden ews-subdirectoryp
address@hidden 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.