Revision: 4255
Author: hans
URL: http://bknr.net/trac/changeset/4255
add some documentation on the testing facility
U trunk/thirdparty/hunchentoot/doc/index.xml
U trunk/thirdparty/hunchentoot/test/script-engine.lisp
U trunk/thirdparty/hunchentoot/test/script.lisp
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-16 12:00:15 UTC (rev 4255)
@@ -2592,12 +2592,51 @@
using <clix:ref>RAW-POST-DATA</clix:ref> instead of reading
the request body using a flexi stream. Usually, this is
automatically done right by Hunchentoot to read POST data, and
- you should only use the <clix:arg>want-stream</clix:arg> keyword argument to the
- <clix:ref>RAW-POST-DATA</clix:ref> in rare circumstances.
+ you should only use the <clix:arg>want-stream</clix:arg>
+ keyword argument to the <clix:ref>RAW-POST-DATA</clix:ref> in
+ rare circumstances.
</li>
</ul>
</clix:chapter>
+ <clix:chapter name="testing" title="Testing">
+ Hunchentoot comes with a test script that verifies that the
+ example web server responds as expected. This test script uses the
+ <a href="http://weitz.de/drakma/">Drakma</a> HTTP client library
+ and thus shares a significant amount of its base code with
+ Hunchentoot itself. Still, running the test script is a useful
+ confidence test, and it is also possible to run the script across
+ machines in order to verify a new Hunchentoot (or, for that matter
+ Drakma) port.
+ <p>
+ To run the confidence test, start
+ the <clix:ref>example</clix:ref> web server. Then, in your Lisp
+ listener, type
+<pre>(hunchentoot-test:test-hunchentoot "http://localhost:4242")</pre>
+ You will see some diagnostic output and a summary line that
+ reports whether any tests have failed.
+ </p>
+
+ <clix:function name="hunchentoot-test:test-hunchentoot">
+ <clix:lambda-list>base-url <clix:lkw>key</clix:lkw></clix:lambda-list>
+ <clix:returns>|</clix:returns>
+ <clix:description>
+ Run the built-in confidence
+ test. <clix:arg>base-url</clix:arg> is the base URL to use
+ for testing, it should not have a trailing slash. The keyword
+ arguments accepted are for future extension and should not
+ currently be used.
+ <p>
+ The script expects the Hunchentoot example test server to be
+ running at the given <clix:arg>base-url</clix:arg> and
+ retrieves various pages from that server, expecting certain
+ responses.
+ </p>
+ </clix:description>
+ </clix:function>
+
+ </clix:chapter>
+
<clix:chapter name="history" title="History">
Hunchentoot's predecessor <a href="http://weitz.de/tbnl/">TBNL</a>
Modified: trunk/thirdparty/hunchentoot/test/script-engine.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-16 12:00:15 UTC (rev 4255)
@@ -47,13 +47,21 @@
(defvar *script-context* nil
"Current script context")
-(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys) &body body)
+(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys)
+ &body body)
`(let ((*script-context* (make-instance ',context-class-name ,@args))
- (*default-pathname-defaults* *this-file*))
+ (*default-pathname-defaults* *this-file*)
+ failed)
(handler-bind
((assertion-failed (lambda (condition)
+ (push condition failed)
(format t "Assertion failed:~%~A~%" condition))))
- (progn ,@body))))
+ (prog1
+ (progn ,@body
+ (values))
+ (if failed
+ (format t ";; ~A assertion~:P FAILED~%" (length failed))
+ (format t ";; all tests PASSED~%"))))))
(defclass http-reply ()
((body :initarg :body)
Modified: trunk/thirdparty/hunchentoot/test/script.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-16 12:00:15 UTC (rev 4255)
@@ -33,21 +33,30 @@
(with-open-file (f pathname)
(princ-to-string (file-length f))))
+(defun say (fmt &rest args)
+ (format t "; ")
+ (apply #'format t fmt args)
+ (terpri))
+
(defun test-hunchentoot (base-url &key (make-cookie-jar (lambda () (make-instance 'drakma:cookie-jar))))
+
+ "Run the built-in confidence test. The keyword arguments accepted
+ are for future extension and should not currently be used."
+
(with-script-context (:base-url (format nil "~A/hunchentoot/test/" base-url))
- (format t "Request home page~%")
+ (say "Request home page")
(http-request "")
(http-assert 'status-code 200)
(http-assert-header :content-type "^text/html")
- (format t "Test cookies~%")
+ (say "Test cookies")
(let ((cookie-jar (funcall make-cookie-jar)))
(http-request "cookie.html" :cookie-jar cookie-jar)
(http-request "cookie.html" :cookie-jar cookie-jar)
(http-assert-body "(?ms)COOKIE-IN "pumpkin".*"barking""))
- (format t "Test session variables~%")
+ (say "Test session variables")
(let ((cookie-jar (funcall make-cookie-jar)))
(http-request "session.html" :cookie-jar cookie-jar
:method :post :parameters '(("new-foo-value" . "ABC") ("new-bar-value" . "DEF")))
@@ -56,26 +65,26 @@
(http-assert-body "\(HUNCHENTOOT-TEST::FOO . "ABC"\)")
(http-assert-body "\(HUNCHENTOOT-TEST::BAR . "DEF"\)"))
- (format t "Test GET parameters with foreign characters (Latin-1)~%")
+ (say "Test GET parameters with foreign characters (Latin-1)")
(http-request "parameter_latin1_get.html?foo=H%FChner")
(http-assert-header :content-type "text/html; charset=ISO-8859-1")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test POST parameters with foreign characters (Latin-1)~%")
+ (say "Test POST parameters with foreign characters (Latin-1)")
(http-request "parameter_latin1_post.html"
:method :post :parameters (list (cons "foo" (format nil "H~Chner" #.(code-char 252)))))
(http-assert-header :content-type "text/html; charset=ISO-8859-1")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test GET parameters with foreign characters (UTF-8)~%")
+ (say "Test GET parameters with foreign characters (UTF-8)")
(http-request "parameter_utf8_get.html?foo=H%C3%BChner")
(http-assert-header :content-type "text/html; charset=UTF-8")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test POST parameters with foreign characters (UTF-8)~%")
+ (say "Test POST parameters with foreign characters (UTF-8)")
(http-request "parameter_utf8_post.html"
:method :post
:external-format-out :utf-8
@@ -84,31 +93,31 @@
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test redirection~%")
+ (say "Test redirection")
(http-request "redir.html")
(http-assert 'uri (lambda (uri)
(matches (princ-to-string uri) "info.html\\?redirected=1")))
- (format t "Test authorization~%")
+ (say "Test authorization")
(http-request "authorization.html")
(http-assert 'status-code 401)
(http-request "authorization.html"
:basic-authorization '("nanook" "igloo"))
(http-assert 'status-code 200)
- (format t "Request the Zappa image~%")
+ (say "Request the Zappa image")
(http-request "image.jpg")
(http-assert-header :content-length (file-length-string #P"fz.jpg"))
(http-assert-header :content-type "image/jpeg")
(http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg"))
- (format t "Request the Zappa image from RAM~%")
+ (say "Request the Zappa image from RAM")
(http-request "image-ram.jpg")
(http-assert-header :content-length (file-length-string #P"fz.jpg"))
(http-assert-header :content-type "image/jpeg")
(http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg"))
- (format t "Upload a file~%")
+ (say "Upload a file")
(http-request "upload.html"
:method :post :parameters '(("clean" . "doit")))
(http-request "upload.html"
Revision: 4252
Author: edi
URL: http://bknr.net/trac/changeset/4252
Rename file as well
D trunk/thirdparty/hunchentoot/connection-dispatcher.lisp
U trunk/thirdparty/hunchentoot/hunchentoot.asd
A trunk/thirdparty/hunchentoot/taskmaster.lisp
Deleted: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:30:55 UTC (rev 4251)
+++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:31:38 UTC (rev 4252)
@@ -1,151 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
-;;; $Header$
-
-;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :hunchentoot)
-
-(defclass taskmaster ()
- ((acceptor :accessor taskmaster-acceptor
- :documentation "The acceptor instance that this
-taskmaster works for."))
- (:documentation "Base class for all taskmaster classes. Its purpose
-is to carry the back pointer to the acceptor instance."))
-
-(defgeneric execute-acceptor (taskmaster)
- (:documentation
- "This function is called once Hunchentoot has performed all initial
-processing to start listening for incoming connections. It does so by
-calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from
-the ACCEPTOR slot of the taskmaster instance.
-
-In a multi-threaded environment, the taskmaster starts a new
-thread and calls THUNK in that thread. In a single-threaded
-environment, the thunk will be called directly."))
-
-(defgeneric handle-incoming-connection (taskmaster socket)
- (:documentation
- "This function is called by Hunchentoot to start processing of
-requests on a new incoming connection. SOCKET is the usocket instance
-that represents the new connection \(or a socket handle on LispWorks).
-The taskmaster starts processing requests on the incoming
-connection by calling the START-REQUEST-PROCESSING function of the
-acceptor instance, taken from the ACCEPTOR slot in the taskmaster
-instance. The SOCKET argument is passed to START-REQUEST-PROCESSING
-as argument.
-
-In a multi-threaded environment, the taskmaster runs this function
-in a separate thread. In a single-threaded environment, this function
-is called directly."))
-
-(defgeneric shutdown (taskmaster)
- (:documentation "Terminate all threads that are currently associated
-with the taskmaster, if any."))
-
-(defclass single-threaded-taskmaster (taskmaster)
- ()
- (:documentation "Taskmaster that runs synchronously in the
-thread that invoked the START-SERVER function."))
-
-(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster))
- (accept-connections (taskmaster-acceptor taskmaster)))
-
-(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket)
- (process-connection (taskmaster-acceptor taskmaster) socket))
-
-(defclass one-thread-per-taskmaster (taskmaster)
- ((acceptor-process :accessor acceptor-process
- :documentation "Process that accepts incoming
-connections and hands them off to new processes for request
-handling."))
- (:documentation "Taskmaster that starts one thread for
-listening to incoming requests and one thread for each incoming
-connection."))
-
-;; usocket implementation
-
-#-:lispworks
-(defmethod shutdown ((taskmaster taskmaster)))
-
-#-:lispworks
-(defmethod shutdown ((taskmaster one-thread-per-taskmaster))
- ;; just wait until the acceptor process has finished, then return
- (loop
- (unless (bt:thread-alive-p (acceptor-process taskmaster))
- (return))
- (sleep 1)))
-
-#-:lispworks
-(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
- (setf (acceptor-process taskmaster)
- (bt:make-thread (lambda ()
- (accept-connections (taskmaster-acceptor taskmaster)))
- :name (format nil "Hunchentoot acceptor \(~A:~A)"
- (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
- (acceptor-port (taskmaster-acceptor taskmaster))))))
-
-#-:lispworks
-(defun client-as-string (socket)
- (let ((address (usocket:get-peer-address socket))
- (port (usocket:get-peer-port socket)))
- (when (and address port)
- (format nil "~A:~A"
- (usocket:vector-quad-to-dotted-quad address)
- port))))
-
-#-:lispworks
-(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket)
- (bt:make-thread (lambda ()
- (process-connection (taskmaster-acceptor taskmaster) socket))
- :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
-
-;; LispWorks implementation
-
-#+:lispworks
-(defmethod shutdown ((taskmaster taskmaster))
- (when-let (process (acceptor-process (taskmaster-acceptor taskmaster)))
- ;; kill the main acceptor process, see LW documentation for
- ;; COMM:START-UP-SERVER
- (mp:process-kill process)))
-
-#+:lispworks
-(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
- (accept-connections (taskmaster-acceptor taskmaster)))
-
-#+:lispworks
-(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle)
- (incf *worker-counter*)
- ;; check if we need to perform a global GC
- (when (and *cleanup-interval*
- (zerop (mod *worker-counter* *cleanup-interval*)))
- (when *cleanup-function*
- (funcall *cleanup-function*)))
- (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})"
- (multiple-value-list
- (get-peer-address-and-port handle)))
- nil #'process-connection
- (taskmaster-acceptor taskmaster) handle))
Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd
===================================================================
--- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 23:30:55 UTC (rev 4251)
+++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 23:31:38 UTC (rev 4252)
@@ -76,6 +76,6 @@
(:file "easy-handlers")
(:file "headers")
(:file "set-timeouts")
- (:file "connection-dispatcher")
+ (:file "taskmaster")
(:file "acceptor")
#-:hunchentoot-no-ssl (:file "ssl")))
Copied: trunk/thirdparty/hunchentoot/taskmaster.lisp (from rev 4251, trunk/thirdparty/hunchentoot/connection-dispatcher.lisp)
===================================================================
--- trunk/thirdparty/hunchentoot/taskmaster.lisp (rev 0)
+++ trunk/thirdparty/hunchentoot/taskmaster.lisp 2009-02-12 23:31:38 UTC (rev 4252)
@@ -0,0 +1,151 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
+;;; $Header$
+
+;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :hunchentoot)
+
+(defclass taskmaster ()
+ ((acceptor :accessor taskmaster-acceptor
+ :documentation "The acceptor instance that this
+taskmaster works for."))
+ (:documentation "Base class for all taskmaster classes. Its purpose
+is to carry the back pointer to the acceptor instance."))
+
+(defgeneric execute-acceptor (taskmaster)
+ (:documentation
+ "This function is called once Hunchentoot has performed all initial
+processing to start listening for incoming connections. It does so by
+calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from
+the ACCEPTOR slot of the taskmaster instance.
+
+In a multi-threaded environment, the taskmaster starts a new
+thread and calls THUNK in that thread. In a single-threaded
+environment, the thunk will be called directly."))
+
+(defgeneric handle-incoming-connection (taskmaster socket)
+ (:documentation
+ "This function is called by Hunchentoot to start processing of
+requests on a new incoming connection. SOCKET is the usocket instance
+that represents the new connection \(or a socket handle on LispWorks).
+The taskmaster starts processing requests on the incoming
+connection by calling the START-REQUEST-PROCESSING function of the
+acceptor instance, taken from the ACCEPTOR slot in the taskmaster
+instance. The SOCKET argument is passed to START-REQUEST-PROCESSING
+as argument.
+
+In a multi-threaded environment, the taskmaster runs this function
+in a separate thread. In a single-threaded environment, this function
+is called directly."))
+
+(defgeneric shutdown (taskmaster)
+ (:documentation "Terminate all threads that are currently associated
+with the taskmaster, if any."))
+
+(defclass single-threaded-taskmaster (taskmaster)
+ ()
+ (:documentation "Taskmaster that runs synchronously in the
+thread that invoked the START-SERVER function."))
+
+(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster))
+ (accept-connections (taskmaster-acceptor taskmaster)))
+
+(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket)
+ (process-connection (taskmaster-acceptor taskmaster) socket))
+
+(defclass one-thread-per-taskmaster (taskmaster)
+ ((acceptor-process :accessor acceptor-process
+ :documentation "Process that accepts incoming
+connections and hands them off to new processes for request
+handling."))
+ (:documentation "Taskmaster that starts one thread for
+listening to incoming requests and one thread for each incoming
+connection."))
+
+;; usocket implementation
+
+#-:lispworks
+(defmethod shutdown ((taskmaster taskmaster)))
+
+#-:lispworks
+(defmethod shutdown ((taskmaster one-thread-per-taskmaster))
+ ;; just wait until the acceptor process has finished, then return
+ (loop
+ (unless (bt:thread-alive-p (acceptor-process taskmaster))
+ (return))
+ (sleep 1)))
+
+#-:lispworks
+(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
+ (setf (acceptor-process taskmaster)
+ (bt:make-thread (lambda ()
+ (accept-connections (taskmaster-acceptor taskmaster)))
+ :name (format nil "Hunchentoot acceptor \(~A:~A)"
+ (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
+ (acceptor-port (taskmaster-acceptor taskmaster))))))
+
+#-:lispworks
+(defun client-as-string (socket)
+ (let ((address (usocket:get-peer-address socket))
+ (port (usocket:get-peer-port socket)))
+ (when (and address port)
+ (format nil "~A:~A"
+ (usocket:vector-quad-to-dotted-quad address)
+ port))))
+
+#-:lispworks
+(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket)
+ (bt:make-thread (lambda ()
+ (process-connection (taskmaster-acceptor taskmaster) socket))
+ :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
+
+;; LispWorks implementation
+
+#+:lispworks
+(defmethod shutdown ((taskmaster taskmaster))
+ (when-let (process (acceptor-process (taskmaster-acceptor taskmaster)))
+ ;; kill the main acceptor process, see LW documentation for
+ ;; COMM:START-UP-SERVER
+ (mp:process-kill process)))
+
+#+:lispworks
+(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
+ (accept-connections (taskmaster-acceptor taskmaster)))
+
+#+:lispworks
+(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle)
+ (incf *worker-counter*)
+ ;; check if we need to perform a global GC
+ (when (and *cleanup-interval*
+ (zerop (mod *worker-counter* *cleanup-interval*)))
+ (when *cleanup-function*
+ (funcall *cleanup-function*)))
+ (mp:process-run-function (format nil "Hunchentoot worker \(client: ~{~A:~A~})"
+ (multiple-value-list
+ (get-peer-address-and-port handle)))
+ nil #'process-connection
+ (taskmaster-acceptor taskmaster) handle))
Revision: 4251
Author: edi
URL: http://bknr.net/trac/changeset/4251
Rename
U trunk/thirdparty/hunchentoot/acceptor.lisp
U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp
U trunk/thirdparty/hunchentoot/packages.lisp
Modified: trunk/thirdparty/hunchentoot/acceptor.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:09:58 UTC (rev 4250)
+++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 23:30:55 UTC (rev 4251)
@@ -50,11 +50,10 @@
used by this acceptor. A function which accepts a REQUEST object and
calls a request handler of its choice \(and returns its return
value).")
- (connection-dispatcher :initarg :connection-dispatcher
- :reader acceptor-connection-dispatcher
- :documentation "The connection dispatcher that is
-responsible for listening to new connections and scheduling them for
-execution.")
+ (taskmaster :initarg :taskmaster
+ :reader acceptor-taskmaster
+ :documentation "The taskmaster that is responsible for
+scheduling the work for this acceptor.")
(output-chunking-p :initarg :output-chunking-p
:accessor acceptor-output-chunking-p
:documentation "Whether the acceptor may use output chunking.")
@@ -124,8 +123,8 @@
:name (gensym)
:request-class 'request
:handler-selector 'list-handler-selector
- :connection-dispatcher (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-dispatcher)
- (t 'single-threaded-connection-dispatcher)))
+ :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-taskmaster)
+ (t 'single-threaded-taskmaster)))
:output-chunking-p t
:input-chunking-p t
:persistent-connections-p t
@@ -157,9 +156,9 @@
in use' or similar)."))
(defgeneric accept-connections (acceptor)
- (:documentation "In a loop, accepts a connection and
-dispatches it to the acceptor's connection dispatcher object for processing
-using HANDLE-INCOMING-CONNECTION."))
+ (:documentation "In a loop, accepts a connection and dispatches it
+to the acceptor's taskmaster for processing using
+HANDLE-INCOMING-CONNECTION."))
(defgeneric initialize-connection-stream (acceptor stream)
(:documentation "Wraps the given STREAM with all the additional
@@ -174,13 +173,12 @@
the stream."))
(defgeneric process-connection (acceptor socket)
- (:documentation "This function is called by the connection
-dispatcher when a new client connection has been established.
-Arguments are the ACCEPTOR object and a usocket socket stream object
-\(or a LispWorks socket handle) in SOCKET. It reads the request
-headers and hands over to PROCESS-REQUEST. This is done in a loop
-until the stream has to be closed or until a connection timeout
-occurs."))
+ (:documentation "This function is called by the taskmaster when a
+new client connection has been established. Arguments are the
+ACCEPTOR object and a usocket socket stream object \(or a LispWorks
+socket handle) in SOCKET. It reads the request headers and hands over
+to PROCESS-REQUEST. This is done in a loop until the stream has to be
+closed or until a connection timeout occurs."))
(defgeneric acceptor-ssl-p (acceptor)
(:documentation "Returns a true value if ACCEPTOR uses SSL
@@ -197,14 +195,14 @@
(defmethod start ((acceptor acceptor))
(start-listening acceptor)
- (let ((connection-dispatcher (acceptor-connection-dispatcher acceptor)))
- (setf (acceptor connection-dispatcher) acceptor)
- (execute-acceptor connection-dispatcher))
+ (let ((taskmaster (acceptor-taskmaster acceptor)))
+ (setf (taskmaster-acceptor taskmaster) acceptor)
+ (execute-acceptor taskmaster))
acceptor)
(defmethod stop ((acceptor acceptor))
(setf (acceptor-shutdown-p acceptor) t)
- (shutdown (acceptor-connection-dispatcher acceptor))
+ (shutdown (acceptor-taskmaster acceptor))
#-:lispworks
(usocket:socket-close (acceptor-listen-socket acceptor)))
@@ -228,7 +226,7 @@
(defmethod process-connection :around ((*acceptor* acceptor) (socket t))
"The around method is responsible for error handling."
(declare (ignore socket))
- ;; note that this call also binds *ACCEPTOR*
+ ;; note that this method also binds *ACCEPTOR*
(handler-bind ((error
;; abort if there's an error which isn't caught inside
(lambda (cond)
@@ -299,8 +297,9 @@
(defun process-request (request)
"This function is called by PROCESS-CONNECTION after the incoming
headers have been read. It sets up the REQUEST and REPLY objects,
-dispatches to a handler, and finally sends the output to the client
-using START-OUTPUT. If all goes as planned, the function returns T."
+selects and calls a handler, and finally sends the output to the
+client using START-OUTPUT. If all goes as planned, the function
+returns T."
(let (*tmp-files* *headers-sent*)
(unwind-protect
(let* ((*request* request))
@@ -369,7 +368,7 @@
(set-timeouts client-connection
(acceptor-read-timeout acceptor)
(acceptor-write-timeout acceptor))
- (handle-incoming-connection (acceptor-connection-dispatcher acceptor)
+ (handle-incoming-connection (acceptor-taskmaster acceptor)
client-connection))
;; ignore condition
(usocket:connection-aborted-error ()))))))
@@ -395,7 +394,7 @@
:function (lambda (handle)
(unless (acceptor-shutdown-p acceptor)
(handle-incoming-connection
- (acceptor-connection-dispatcher acceptor) handle)))
+ (acceptor-taskmaster acceptor) handle)))
;; wait until the acceptor was successfully started
;; or an error condition is returned
:wait t)
Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:09:58 UTC (rev 4250)
+++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-12 23:30:55 UTC (rev 4251)
@@ -29,84 +29,84 @@
(in-package :hunchentoot)
-(defclass connection-dispatcher ()
- ((acceptor :accessor acceptor
+(defclass taskmaster ()
+ ((acceptor :accessor taskmaster-acceptor
:documentation "The acceptor instance that this
-connection dispatcher works for."))
- (:documentation "Base class for all connection dispatchers classes.
-Its purpose is to carry the back pointer to the acceptor instance."))
+taskmaster works for."))
+ (:documentation "Base class for all taskmaster classes. Its purpose
+is to carry the back pointer to the acceptor instance."))
-(defgeneric execute-acceptor (connection-dispatcher)
+(defgeneric execute-acceptor (taskmaster)
(:documentation
"This function is called once Hunchentoot has performed all initial
processing to start listening for incoming connections. It does so by
calling the ACCEPT-CONNECTIONS functions of the acceptor, taken from
-the ACCEPTOR slot of the connection dispatcher instance.
+the ACCEPTOR slot of the taskmaster instance.
-In a multi-threaded environment, the connection dispatcher starts a new
+In a multi-threaded environment, the taskmaster starts a new
thread and calls THUNK in that thread. In a single-threaded
environment, the thunk will be called directly."))
-(defgeneric handle-incoming-connection (connection-dispatcher socket)
+(defgeneric handle-incoming-connection (taskmaster socket)
(:documentation
"This function is called by Hunchentoot to start processing of
requests on a new incoming connection. SOCKET is the usocket instance
that represents the new connection \(or a socket handle on LispWorks).
-The connection dispatcher starts processing requests on the incoming
+The taskmaster starts processing requests on the incoming
connection by calling the START-REQUEST-PROCESSING function of the
-acceptor instance, taken from the ACCEPTOR slot in the connection dispatcher
+acceptor instance, taken from the ACCEPTOR slot in the taskmaster
instance. The SOCKET argument is passed to START-REQUEST-PROCESSING
as argument.
-In a multi-threaded environment, the connection dispatcher runs this function
+In a multi-threaded environment, the taskmaster runs this function
in a separate thread. In a single-threaded environment, this function
is called directly."))
-(defgeneric shutdown (connection-dispatcher)
+(defgeneric shutdown (taskmaster)
(:documentation "Terminate all threads that are currently associated
-with the connection dispatcher, if any."))
+with the taskmaster, if any."))
-(defclass single-threaded-connection-dispatcher (connection-dispatcher)
+(defclass single-threaded-taskmaster (taskmaster)
()
- (:documentation "Connection Dispatcher that runs synchronously in the
+ (:documentation "Taskmaster that runs synchronously in the
thread that invoked the START-SERVER function."))
-(defmethod execute-acceptor ((dispatcher single-threaded-connection-dispatcher))
- (accept-connections (acceptor dispatcher)))
+(defmethod execute-acceptor ((taskmaster single-threaded-taskmaster))
+ (accept-connections (taskmaster-acceptor taskmaster)))
-(defmethod handle-incoming-connection ((dispatcher single-threaded-connection-dispatcher) socket)
- (process-connection (acceptor dispatcher) socket))
+(defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket)
+ (process-connection (taskmaster-acceptor taskmaster) socket))
-(defclass one-thread-per-connection-dispatcher (connection-dispatcher)
+(defclass one-thread-per-taskmaster (taskmaster)
((acceptor-process :accessor acceptor-process
:documentation "Process that accepts incoming
-connections and dispatches them to new processes for request
-execution."))
- (:documentation "Connection Dispatcher that starts one thread for
+connections and hands them off to new processes for request
+handling."))
+ (:documentation "Taskmaster that starts one thread for
listening to incoming requests and one thread for each incoming
connection."))
;; usocket implementation
#-:lispworks
-(defmethod shutdown ((dispatcher connection-dispatcher)))
+(defmethod shutdown ((taskmaster taskmaster)))
#-:lispworks
-(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher))
+(defmethod shutdown ((taskmaster one-thread-per-taskmaster))
;; just wait until the acceptor process has finished, then return
(loop
- (unless (bt:thread-alive-p (acceptor-process dispatcher))
+ (unless (bt:thread-alive-p (acceptor-process taskmaster))
(return))
(sleep 1)))
#-:lispworks
-(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher))
- (setf (acceptor-process dispatcher)
+(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
+ (setf (acceptor-process taskmaster)
(bt:make-thread (lambda ()
- (accept-connections (acceptor dispatcher)))
+ (accept-connections (taskmaster-acceptor taskmaster)))
:name (format nil "Hunchentoot acceptor \(~A:~A)"
- (or (acceptor-address (acceptor dispatcher)) "*")
- (acceptor-port (acceptor dispatcher))))))
+ (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
+ (acceptor-port (taskmaster-acceptor taskmaster))))))
#-:lispworks
(defun client-as-string (socket)
@@ -118,26 +118,26 @@
port))))
#-:lispworks
-(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket)
+(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) socket)
(bt:make-thread (lambda ()
- (process-connection (acceptor dispatcher) socket))
+ (process-connection (taskmaster-acceptor taskmaster) socket))
:name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
;; LispWorks implementation
#+:lispworks
-(defmethod shutdown ((dispatcher connection-dispatcher))
- (when-let (process (acceptor-process (acceptor dispatcher)))
+(defmethod shutdown ((taskmaster taskmaster))
+ (when-let (process (acceptor-process (taskmaster-acceptor taskmaster)))
;; kill the main acceptor process, see LW documentation for
;; COMM:START-UP-SERVER
(mp:process-kill process)))
#+:lispworks
-(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher))
- (accept-connections (acceptor dispatcher)))
+(defmethod execute-acceptor ((taskmaster one-thread-per-taskmaster))
+ (accept-connections (taskmaster-acceptor taskmaster)))
#+:lispworks
-(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle)
+(defmethod handle-incoming-connection ((taskmaster one-thread-per-taskmaster) handle)
(incf *worker-counter*)
;; check if we need to perform a global GC
(when (and *cleanup-interval*
@@ -148,4 +148,4 @@
(multiple-value-list
(get-peer-address-and-port handle)))
nil #'process-connection
- (acceptor dispatcher) handle))
+ (taskmaster-acceptor taskmaster) handle))
Modified: trunk/thirdparty/hunchentoot/packages.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:09:58 UTC (rev 4250)
+++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 23:30:55 UTC (rev 4251)
@@ -117,7 +117,6 @@
"+HTTP-USE-PROXY+"
"+HTTP-VERSION-NOT-SUPPORTED+"
"ABORT-REQUEST-HANDLER"
- "ACCEPTOR"
"ACCEPTOR-ACCESS-LOGGER"
"ACCEPTOR-ADDRESS"
"ACCEPTOR-HANDLER-SELECTOR"
@@ -150,7 +149,6 @@
"COOKIES-IN"
"COOKIES-IN*"
"COOKIES-OUT"
- "CONNECTION-DISPATCHER"
"CREATE-FOLDER-DISPATCHER-AND-HANDLER"
"CREATE-PREFIX-DISPATCHER"
"CREATE-REGEX-DISPATCHER"
@@ -239,6 +237,8 @@
"START-LISTENING"
"START-SESSION"
"STOP"
+ "TASKMASTER"
+ "TASKMASTER-ACCEPTOR"
"URL-DECODE"
"URL-ENCODE"
"USER-AGENT"))
Revision: 4249
Author: edi
URL: http://bknr.net/trac/changeset/4249
First stab at logging
U trunk/thirdparty/hunchentoot/acceptor.lisp
U trunk/thirdparty/hunchentoot/headers.lisp
U trunk/thirdparty/hunchentoot/log.lisp
U trunk/thirdparty/hunchentoot/misc.lisp
U trunk/thirdparty/hunchentoot/packages.lisp
U trunk/thirdparty/hunchentoot/request.lisp
U trunk/thirdparty/hunchentoot/session.lisp
U trunk/thirdparty/hunchentoot/specials.lisp
U trunk/thirdparty/hunchentoot/test/packages.lisp
U trunk/thirdparty/hunchentoot/test/script.lisp
Change set too large, please see URL above