Revision: 4227 Author: edi URL: http://bknr.net/trac/changeset/4227

More

U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/test/test.lisp U trunk/thirdparty/hunchentoot/util.lisp

Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -31,9 +31,11 @@

(defclass acceptor () ((port :initarg :port + :reader acceptor-port :documentation "The port the acceptor is listening on. See START-SERVER.") (address :initarg :address + :reader acceptor-address :documentation "The address the acceptor is listening on. See START-SERVER.") (name :initarg :name @@ -183,14 +185,6 @@ (format stream "(host ~A, port ~A)" (or (acceptor-address acceptor) "*") (acceptor-port acceptor))))

-(defun acceptor-address (&optional (acceptor *acceptor*)) - "Returns the address at which the current request arrived." - (slot-value acceptor 'address)) - -(defun acceptor-port (&optional (acceptor *acceptor*)) - "Returns the port at which the current request arrived." - (slot-value acceptor 'port)) - (defgeneric start (acceptor) (:documentation "Start the ACCEPTOR so that it begins accepting connections.")

Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -29,13 +29,10 @@

(in-package :hunchentoot)

-;;; The connection-dispatcher protocol defines how Hunchentoot schedules -;;; request execution to worker threads or for inline execution. - (defclass connection-dispatcher () ((acceptor :initarg :acceptor - :reader acceptor - :documentation "The Hunchentoot acceptor instance that this + :reader 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.")) @@ -69,9 +66,9 @@ (defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated with the connection dispatcher, if any.") - (:method ((manager t)) + (:method ((dispatcher t)) #+:lispworks - (when-let (acceptor (acceptor-acceptor (acceptor manager))) + (when-let (acceptor (acceptor-acceptor (acceptor dispatcher))) ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER (mp:process-kill acceptor)))) @@ -81,11 +78,11 @@ (:documentation "Connection Dispatcher that runs synchronously in the thread that invoked the START-SERVER function."))

-(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) - (accept-connections (acceptor manager))) +(defmethod execute-acceptor ((dispatcher single-threaded-connection-dispatcher)) + (accept-connections (acceptor dispatcher)))

-(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) - (process-connection (acceptor manager) socket)) +(defmethod handle-incoming-connection ((dispatcher single-threaded-connection-dispatcher) socket) + (process-connection (acceptor dispatcher) socket))

(defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process @@ -96,25 +93,25 @@ listening to incoming requests and one thread for each incoming connection."))

-(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) +(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) #+:lispworks - (accept-connections (acceptor manager)) + (accept-connections (acceptor dispatcher)) #-:lispworks - (setf (acceptor-process manager) + (setf (acceptor-process dispatcher) (bt:make-thread (lambda () - (accept-connections (acceptor manager))) + (accept-connections (acceptor dispatcher))) :name (format nil "Hunchentoot acceptor (~A:~A)" - (or (acceptor-address (acceptor manager)) "*") - (acceptor-port (acceptor manager)))))) + (or (acceptor-address (acceptor dispatcher)) "*") + (acceptor-port (acceptor dispatcher))))))

#-:lispworks -(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) +(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) (loop - while (bt:thread-alive-p (acceptor-process manager)) + while (bt:thread-alive-p (acceptor-process dispatcher)) do (sleep 1)))

#+:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* @@ -125,7 +122,7 @@ (multiple-value-list (get-peer-address-and-port handle))) nil #'process-connection - (acceptor manager) handle)) + (acceptor dispatcher) handle))

#-:lispworks (defun client-as-string (socket) @@ -137,7 +134,7 @@ port))))

#-:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) (bt:make-thread (lambda () - (process-connection (acceptor manager) socket)) + (process-connection (acceptor dispatcher) socket)) :name (format nil "Hunchentoot worker (client: ~A)" (client-as-string socket))))

Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -119,7 +119,7 @@ " since its handler was compiled.") (info-table (host) (acceptor-address *acceptor*) - (acceptor-port) + (acceptor-port *acceptor*) (remote-addr*) (remote-port*) (real-remote-addr)

Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -374,7 +374,7 @@ (escape-for-html (lisp-implementation-version)) (or (host *request*) (acceptor-address *acceptor*)) (scan ":\d+$" (or (host *request*) "")) - (acceptor-port))) + (acceptor-port *acceptor*)))

(defun server-name-header () "Returns a string which can be used for 'Server' headers."