[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Tue Feb 10 10:30:10 UTC 2009
Revision: 4219
Author: edi
URL: http://bknr.net/trac/changeset/4219
Rename, part 2
A trunk/thirdparty/hunchentoot/connection-dispatcher.lisp
D trunk/thirdparty/hunchentoot/connection-manager.lisp
U trunk/thirdparty/hunchentoot/hunchentoot.asd
Copied: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp (from rev 4218, trunk/thirdparty/hunchentoot/connection-manager.lisp)
===================================================================
--- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp (rev 0)
+++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 10:30:10 UTC (rev 4219)
@@ -0,0 +1,143 @@
+;;; -*- 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)
+
+;;; The connection-dispatcher protocol defines how Hunchentoot schedules
+;;; request execution to worker threads or for inline execution.
+
+(defclass connection-dispatcher ()
+ ((server :initarg :server
+ :reader server
+ :documentation "The Hunchentoot server 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 server instance."))
+
+(defgeneric execute-acceptor (connection-dispatcher)
+ (: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 server, taken from
+the SERVER slot of the connection dispatcher instance.
+
+In a multi-threaded environment, the connection dispatcher 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)
+ (: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
+connection by calling the START-REQUEST-PROCESSING function of the
+server instance, taken from the SERVER slot in the connection dispatcher
+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 separate thread. In a single-threaded environment, this function
+is called directly."))
+
+(defgeneric shutdown (connection-dispatcher)
+ (:documentation "Terminate all threads that are currently associated
+with the connection dispatcher, if any.")
+ (:method ((manager t))
+ #+:lispworks
+ (when-let (acceptor (server-acceptor (server manager)))
+ ;; kill the main acceptor process, see LW documentation for
+ ;; COMM:START-UP-SERVER
+ (mp:process-kill acceptor))))
+
+(defclass single-threaded-connection-dispatcher (connection-dispatcher)
+ ()
+ (: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 (server manager)))
+
+(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket)
+ (process-connection (server manager) socket))
+
+(defclass one-thread-per-connection-dispatcher (connection-dispatcher)
+ ((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
+listening to incoming requests and one thread for each incoming
+connection."))
+
+(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher))
+ #+:lispworks
+ (accept-connections (server manager))
+ #-:lispworks
+ (setf (acceptor-process manager)
+ (bt:make-thread (lambda ()
+ (accept-connections (server manager)))
+ :name (format nil "Hunchentoot acceptor \(~A:~A)"
+ (or (server-address (server manager)) "*")
+ (server-port (server manager))))))
+
+#-:lispworks
+(defmethod shutdown ((manager one-thread-per-connection-dispatcher))
+ (loop
+ while (bt:thread-alive-p (acceptor-process manager))
+ do (sleep 1)))
+
+#+:lispworks
+(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) 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
+ (server manager) handle))
+
+#-: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 ((manager one-thread-per-connection-dispatcher) socket)
+ (bt:make-thread (lambda ()
+ (process-connection (server manager) socket))
+ :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
Deleted: trunk/thirdparty/hunchentoot/connection-manager.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 10:28:58 UTC (rev 4218)
+++ trunk/thirdparty/hunchentoot/connection-manager.lisp 2009-02-10 10:30:10 UTC (rev 4219)
@@ -1,143 +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)
-
-;;; The connection-dispatcher protocol defines how Hunchentoot schedules
-;;; request execution to worker threads or for inline execution.
-
-(defclass connection-dispatcher ()
- ((server :initarg :server
- :reader server
- :documentation "The Hunchentoot server 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 server instance."))
-
-(defgeneric execute-acceptor (connection-dispatcher)
- (: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 server, taken from
-the SERVER slot of the connection dispatcher instance.
-
-In a multi-threaded environment, the connection dispatcher 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)
- (: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
-connection by calling the START-REQUEST-PROCESSING function of the
-server instance, taken from the SERVER slot in the connection dispatcher
-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 separate thread. In a single-threaded environment, this function
-is called directly."))
-
-(defgeneric shutdown (connection-dispatcher)
- (:documentation "Terminate all threads that are currently associated
-with the connection dispatcher, if any.")
- (:method ((manager t))
- #+:lispworks
- (when-let (acceptor (server-acceptor (server manager)))
- ;; kill the main acceptor process, see LW documentation for
- ;; COMM:START-UP-SERVER
- (mp:process-kill acceptor))))
-
-(defclass single-threaded-connection-dispatcher (connection-dispatcher)
- ()
- (: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 (server manager)))
-
-(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket)
- (process-connection (server manager) socket))
-
-(defclass one-thread-per-connection-dispatcher (connection-dispatcher)
- ((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
-listening to incoming requests and one thread for each incoming
-connection."))
-
-(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher))
- #+:lispworks
- (accept-connections (server manager))
- #-:lispworks
- (setf (acceptor-process manager)
- (bt:make-thread (lambda ()
- (accept-connections (server manager)))
- :name (format nil "Hunchentoot acceptor \(~A:~A)"
- (or (server-address (server manager)) "*")
- (server-port (server manager))))))
-
-#-:lispworks
-(defmethod shutdown ((manager one-thread-per-connection-dispatcher))
- (loop
- while (bt:thread-alive-p (acceptor-process manager))
- do (sleep 1)))
-
-#+:lispworks
-(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) 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
- (server manager) handle))
-
-#-: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 ((manager one-thread-per-connection-dispatcher) socket)
- (bt:make-thread (lambda ()
- (process-connection (server manager) socket))
- :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd
===================================================================
--- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:28:58 UTC (rev 4218)
+++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:30:10 UTC (rev 4219)
@@ -78,7 +78,7 @@
#+(and :sbcl :unix (not :win32)) (:file "unix-sbcl")
#+(and (not (or :allegro :clisp :cmu :lispworks :openmcl :sbcl)) :unix) (:file "unix-other")
(:file "set-timeouts")
- (:file "connection-manager")
+ (:file "connection-dispatcher")
(:file "server")
#-:hunchentoot-no-ssl
(:file "ssl")))
More information about the Bknr-cvs
mailing list