[hunchentoot-devel] 'max-threads' behavior for Hunchentoot
Scott McKay
swm at itasoftware.com
Tue Jun 1 13:23:32 UTC 2010
I'll address all these issues, then send the next set
of changes back according to the referenced file.
BTW, I chose not to use a generic function for the thread
creation function and the too-many-threads handler for what
I have to assume is the same reason that the various logger
functions are also done as slots: so that you aren't forced
to subclass just to provide a couple of functions. If this
were Java, I'd say subclassing is the right approach, but
since it's Lisp, I think supplying a function is better.
After all, that's what first-class functions are for! :-)
Thanks!
On May 30, 2010, at 5:56 AM, Hans Hübner wrote:
> Hi Scott,
>
> first off, thank you for taking the time to improve Hunchentoot and
> for sending a proposed patch. Please have a look at
> http://weitz.de/patches.html before submitting your next patch for
> review. In particular, it makes reviews much easier if there is
> documentation about what the patch means to do.
>
> On Thu, May 27, 2010 at 16:57, Scott McKay <swm at itasoftware.com> wrote:
>> A few notes:
>> - The function conditionalized out with #+++potentially-faster-way
>> is meant to be a hint as to how we might refuse the connection
>> without invoking the overhead of accepting the over-the-limit
>> connection. It might be slightly faster, but I don't know if
>> I like the idea of constantly closing and reopening the listener.
>
> I don't like the idea, as it opens up a race condition which will
> result in connections being rejected under high load.
>
>> - 'handle-incoming-connection' on 'one-thread-per-connection-taskmaster'
>> should really try to generate an HTTP 503 error, instead of just
>> closing the connection. I tried several things to make this happen,
>> but nothing seemed to work properly. It seems a shame to have to
>> open the client connection, suck in the whole request, etc etc,
>> just to do this. Is there a better way? Is there some sort of
>> "connection refused" we can do at the socket level?
>
> I don't see a need to read the request in order to reply with a 503
> error. If the server can't dispatch the request because a resource
> limit has been hit, there is nothing wrong with just sending a 503
> reply without looking at the request at all. Berkeley sockets do not
> provide a means to reject individual pending connections.
>
> Further comments inline:
>
>>
>> --Scott
>>
>>
>> Modified: trunk/qres/lisp/libs/hunchentoot/packages.lisp
>> ==============================================================================
>> --- trunk/qres/lisp/libs/hunchentoot/packages.lisp (original)
>> +++ trunk/qres/lisp/libs/hunchentoot/packages.lisp Thu May 27 10:31:21 2010
>> @@ -192,7 +192,6 @@
>> "MIME-TYPE"
>> "NEXT-SESSION-ID"
>> "NO-CACHE"
>> - "ONE-THREAD-PER-CONNECTION-TASKMASTER"
>> "PARAMETER"
>> "PARAMETER-ERROR"
>> "POST-PARAMETER"
>> @@ -250,7 +249,6 @@
>> "SET-COOKIE"
>> "SET-COOKIE*"
>> "SHUTDOWN"
>> - "SINGLE-THREADED-TASKMASTER"
>> #-:hunchentoot-no-ssl "SSL-ACCEPTOR"
>> "SSL-P"
>> "START"
>> @@ -259,7 +257,12 @@
>> "STOP"
>> "TASKMASTER"
>> "TASKMASTER-ACCEPTOR"
>> - "URL-DECODE"
>> + "SINGLE-THREADED-TASKMASTER"
>> + "ONE-THREAD-PER-CONNECTION-TASKMASTER"
>> + "POOLED-THREAD-PER-CONNECTION-TASKMASTER"
>> + "INCREMENT-TASKMASTER-THREAD-COUNT"
>> + "DECREMENT-TASKMASTER-THREAD-COUNT"
>> + "URL-DECODE"
>> "URL-ENCODE"
>> "USER-AGENT"))
>>
>> Modified: trunk/qres/lisp/libs/hunchentoot/acceptor.lisp
>> ==============================================================================
>> --- trunk/qres/lisp/libs/hunchentoot/acceptor.lisp (original)
>> +++ trunk/qres/lisp/libs/hunchentoot/acceptor.lisp Thu May 27 10:31:21 2010
>> @@ -86,7 +86,7 @@
>> reason to change this to NIL.")
>> (input-chunking-p :initarg :input-chunking-p
>> :accessor acceptor-input-chunking-p
>> - :documentation "A generalized boolean denoting
>> + :documentation "A generalized boolean denoting
>> whether the acceptor may use chunked encoding for input, i.e. when
>> accepting request bodies from the client. The default is T and
>> there's usually no reason to change this to NIL.")
>> @@ -117,8 +117,7 @@
>> process different from the one where START was called.")
>> #-:lispworks
>> (listen-socket :accessor acceptor-listen-socket
>> - :documentation "The socket listening for incoming
>> -connections.")
>> + :documentation "The socket listening for incoming connections.")
>> (acceptor-shutdown-p :initform nil
>> :accessor acceptor-shutdown-p
>> :documentation "A flag that makes the acceptor
>> @@ -349,9 +348,12 @@
>> ;; the default is to always answer "no"
>> nil)
>>
>> -;; usocket implementation
>> +
>> +;;; usocket implementation
>>
>> #-:lispworks
>> +(progn
>
> What is this progn needed for?
>
>> +
>> (defmethod start-listening ((acceptor acceptor))
>> (setf (acceptor-listen-socket acceptor)
>> (usocket:socket-listen (or (acceptor-address acceptor)
>> @@ -361,26 +363,61 @@
>> :element-type '(unsigned-byte 8)))
>> (values))
>>
>> -#-:lispworks
>> (defmethod accept-connections ((acceptor acceptor))
>> (usocket:with-server-socket (listener (acceptor-listen-socket acceptor))
>> (loop
>> - (when (acceptor-shutdown-p acceptor)
>> - (return))
>> - (when (usocket:wait-for-input listener :timeout +new-connection-wait-time+)
>> - (handler-case
>> - (when-let (client-connection (usocket:socket-accept listener))
>> - (set-timeouts client-connection
>> - (acceptor-read-timeout acceptor)
>> - (acceptor-write-timeout acceptor))
>> - (handle-incoming-connection (acceptor-taskmaster acceptor)
>> - client-connection))
>> - ;; ignore condition
>> - (usocket:connection-aborted-error ()))))))
>> + (when (acceptor-shutdown-p acceptor)
>> + (return))
>> + (when (usocket:wait-for-input listener :timeout +new-connection-wait-time+)
>> + (handler-case
>> + (let ((taskmaster (acceptor-taskmaster acceptor)))
>> + (when-let (client-connection (usocket:socket-accept listener))
>> + (set-timeouts client-connection
>> + (acceptor-read-timeout acceptor)
>> + (acceptor-write-timeout acceptor))
>> + ;; This will bail if the taskmaster has reached its thread limit
>> + (handle-incoming-connection taskmaster client-connection)))
>> + ;; Ignore the error
>> + (usocket:connection-aborted-error ()))))))
>> +
>> +#+++potentially-faster-way
>> +(defmethod accept-connections ((acceptor acceptor))
>> + (loop
>> + (usocket:with-server-socket (listener (acceptor-listen-socket acceptor))
>> + (loop named waiter doing
>> + (when (acceptor-shutdown-p acceptor)
>> + (return-from accept-connections))
>> + (when (usocket:wait-for-input listener :timeout +new-connection-wait-time+)
>> + (handler-case
>> + (let ((taskmaster (acceptor-taskmaster acceptor)))
>> + ;; Optimization to avoid creating the client connection:
>> + ;; if the taskmaster has reached its thread limit, just close
>> + ;; and reopen the listener socket, and don't even call 'accept'
>> + (when (and (taskmaster-max-threads taskmaster)
>> + (> (taskmaster-thread-count taskmaster) (taskmaster-max-threads taskmaster)))
>> + (when-let (handler (taskmaster-too-many-threads-handler taskmaster))
>> + (funcall handler taskmaster listener))
>> + (usocket:socket-close listener) ;close the listener
>> + (setq listener nil)
>> + (start-listening acceptor) ;and start up a new one
>> + (return-from waiter))
>> + (when-let (client-connection (usocket:socket-accept listener))
>> + (set-timeouts client-connection
>> + (acceptor-read-timeout acceptor)
>> + (acceptor-write-timeout acceptor))
>> + ;; This will bail if the taskmaster has reached its thread limit
>> + (handle-incoming-connection taskmaster client-connection)))
>> + ;; Ignore the error
>> + (usocket:connection-aborted-error ())))))))
>> +
>> +) ;#-:lispworks
>>
>> -;; LispWorks implementation
>> +
>> +;;; LispWorks implementation
>>
>> #+:lispworks
>> +(progn
>> +
>
> Don't use progn here. Conditionalize the individual top-level forms.
> Otherwise, automatic reindentation will screw up the source file.
>
>> (defmethod start-listening ((acceptor acceptor))
>> (multiple-value-bind (listener-process startup-condition)
>> (comm:start-up-server :service (acceptor-port acceptor)
>> @@ -398,8 +435,8 @@
>> ;; is made
>> :function (lambda (handle)
>> (unless (acceptor-shutdown-p acceptor)
>> - (handle-incoming-connection
>> - (acceptor-taskmaster acceptor) handle)))
>> + (let ((taskmaster (acceptor-taskmaster acceptor)))
>> + (handle-incoming-connection taskmaster client-connection))))
>> ;; wait until the acceptor was successfully started
>> ;; or an error condition is returned
>> :wait t)
>> @@ -409,11 +446,13 @@
>> (setf (acceptor-process acceptor) listener-process)
>> (values)))
>>
>> -#+:lispworks
>> (defmethod accept-connections ((acceptor acceptor))
>> (mp:process-unstop (acceptor-process acceptor))
>> nil)
>>
>> +) ;#+:lispworks
>> +
>> +
>> (defun list-request-dispatcher (request)
>> "The default request dispatcher which selects a request handler
>> based on a list of individual request dispatchers all of which can
>>
>> Modified: trunk/qres/lisp/libs/hunchentoot/taskmaster.lisp
>> ==============================================================================
>> --- trunk/qres/lisp/libs/hunchentoot/taskmaster.lisp (original)
>> +++ trunk/qres/lisp/libs/hunchentoot/taskmaster.lisp Thu May 27 10:31:21 2010
>> @@ -62,6 +62,21 @@
>> might terminate all threads that are currently associated with it.
>> This function is called by the acceptor's STOP method."))
>>
>> +;; Default method
>> +(defmethod taskmaster-max-threads ((taskmaster taskmaster))
>> + nil)
>> +
>> +;; Default method
>> +(defmethod taskmaster-thread-count ((taskmaster taskmaster))
>> + 0)
>> +
>> +(defmethod increment-taskmaster-thread-count ((taskmaster taskmaster))
>> + nil)
>> +
>> +(defmethod decrement-taskmaster-thread-count ((taskmaster taskmaster))
>> + nil)
>> +
>> +
>> (defclass single-threaded-taskmaster (taskmaster)
>> ()
>> (:documentation "A taskmaster that runs synchronously in the thread
>> @@ -80,25 +95,95 @@
>> ;; in a single-threaded environment we just call PROCESS-CONNECTION
>> (process-connection (taskmaster-acceptor taskmaster) socket))
>>
>> +
>> (defclass one-thread-per-connection-taskmaster (taskmaster)
>> (#-:lispworks
>> - (acceptor-process :accessor acceptor-process
>> - :documentation "A process that accepts incoming
>> -connections and hands them off to new processes for request
>> -handling."))
>> + (acceptor-process
>> + :accessor acceptor-process
>> + :documentation
>> + "A process that accepts incoming connections and hands them off to new processes
>> + for request handling.")
>> + (create-thread-function
>> + :initarg :create-thread-function
>> + :initform 'create-taskmaster-thread
>> + :accessor taskmaster-create-thread-function
>> + :documentation
>> + "Function called to create the handler thread;
>> + takes two arguments, the taskmaster and the socket")
>> + ;; Support for bounding the number of threads we'll create
>> + (max-threads
>> + :type (or integer null)
>> + :initarg :max-threads
>> + :initform nil
>> + :accessor taskmaster-max-threads)
>> + (thread-count
>> + :type integer
>> + :initform 0
>> + :accessor taskmaster-thread-count)
>> + (thread-count-lock
>> + :initform (bt:make-lock "taskmaster-thread-count")
>> + :accessor taskmaster-thread-count-lock)
>> + (worker-thread-name-format
>> + :type (or string null)
>> + :initarg :worker-thread-name-format
>> + :initform "hunchentoot-worker-~A"
>> + :accessor taskmaster-worker-thread-name-format)
>> + (too-many-threads-handler
>> + :initarg :too-many-threads-handler
>> + :initform nil
>> + :accessor taskmaster-too-many-threads-handler
>> + :documentation
>> + "Function called with two arguments, the taskmaster and the socket,
>> + when too many threads reached, just prior to closing the connection"))
>> + (:default-initargs
>> + :too-many-threads-handler 'log-too-many-threads)
>> (:documentation "A taskmaster that starts one thread for listening
>> -to incoming requests and one thread for each incoming connection.
>> +to incoming requests and one new thread for each incoming connection.
>> +If 'max-threads' is supplied, the number of threads is limited to that.
>
> Why did you chose to implement create-threads-function and
> too-many-threads-handler as slots rather than generic functions? The
> latter seems much more natural to me.
>
>>
>> This is the default taskmaster implementation for multi-threaded Lisp
>> implementations."))
>>
>> -;; usocket implementation
>> +(defmethod increment-taskmaster-thread-count ((taskmaster one-thread-per-connection-taskmaster))
>> + (when (taskmaster-max-threads taskmaster)
>> + (bt:with-lock-held ((taskmaster-thread-count-lock taskmaster))
>> + (incf (taskmaster-thread-count taskmaster)))))
>> +
>> +(defmethod decrement-taskmaster-thread-count ((taskmaster one-thread-per-connection-taskmaster))
>> + (when (taskmaster-max-threads taskmaster)
>> + (bt:with-lock-held ((taskmaster-thread-count-lock taskmaster))
>> + (decf (taskmaster-thread-count taskmaster)))))
>> +
>> +(defun log-too-many-threads (taskmaster socket)
>> + (declare (ignore socket))
>> + (let* ((acceptor (taskmaster-acceptor taskmaster))
>> + (logger (and acceptor (acceptor-message-logger acceptor))))
>> + (when logger
>> + (funcall logger :warning "Can't handle a new connection, too many threads already"))))
>> +
>> +
>> +;;--- If thread creation is too slow, it would be worth finishing this
>> +;;--- For now, it's just a synonym for 'one-thread-per-connection-taskmaster'
>> +(defclass pooled-thread-per-connection-taskmaster (one-thread-per-connection-taskmaster)
>> + ((create-thread-function
>> + :initarg :create-thread-function
>> + :initform 'create-taskmaster-thread
>> + :accessor taskmaster-create-thread-function
>> + :documentation
>> + "Function called to create the handler thread"))
>> + (:documentation "A taskmaster that starts one thread for listening
>> +to incoming requests and then uses a thread pool for each incoming connection.
>> +If 'max-threads' is supplied, the number of threads is limited to that."))
>> +
>> +
>> +;;; usocket implementation
>>
>> #-:lispworks
>> +(progn
>> +
>
> Another top-level progn that should go.
>
>> (defmethod shutdown ((taskmaster taskmaster))
>> taskmaster)
>>
>> -#-:lispworks
>> (defmethod shutdown ((taskmaster one-thread-per-connection-taskmaster))
>> ;; just wait until the acceptor process has finished, then return
>> (loop
>> @@ -107,16 +192,39 @@
>> (sleep 1))
>> taskmaster)
>>
>> -#-:lispworks
>> (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster))
>> (setf (acceptor-process taskmaster)
>> - (bt:make-thread (lambda ()
>> - (accept-connections (taskmaster-acceptor taskmaster)))
>> - :name (format nil "Hunchentoot listener \(~A:~A)"
>> - (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
>> - (acceptor-port (taskmaster-acceptor taskmaster))))))
>> + (bt:make-thread
>> + (lambda ()
>> + (accept-connections (taskmaster-acceptor taskmaster)))
>> + :name (format nil "hunchentoot-listener-~A:~A"
>> + (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
>> + (acceptor-port (taskmaster-acceptor taskmaster))))))
>> +
>> +(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket)
>> + ;; Only take lock if necessary
>> + (if (taskmaster-max-threads taskmaster)
>> + (if (< (taskmaster-thread-count taskmaster) (taskmaster-max-threads taskmaster))
>> + (progn
>> + (increment-taskmaster-thread-count taskmaster)
>> + (funcall (taskmaster-create-thread-function taskmaster) taskmaster socket))
>> + (progn
>> + (when-let (handler (taskmaster-too-many-threads-handler taskmaster))
>> + (funcall handler taskmaster socket))
>> + ;; Just close the socket, which will effectively abort the request
>> + ;;--- It sure would be nice to be able to generate an HTTP 503 error,
>> + ;;--- but I just can't seem to get that to work properly
>> + (usocket:socket-close socket)))
>
> Please do not use (if .. (progn ..) (progn ..)). Use cond instead or
> refactor. In this case, I'd think that the maintenance of the thread
> count could be moved into the generic function that creates the
> thread, once the callback slot has been replaced by a gf.
>
>> + (funcall (taskmaster-create-thread-function taskmaster) taskmaster socket)))
>> +
>> +(defun create-taskmaster-thread (taskmaster socket)
>> + (bt:make-thread
>> + (lambda ()
>> + (multiple-value-prog1
>> + (process-connection (taskmaster-acceptor taskmaster) socket)
>> + (decrement-taskmaster-thread-count taskmaster)))
>> + :name (format nil (taskmaster-worker-thread-name-format taskmaster) (client-as-string socket))))
>>
>> -#-:lispworks
>> (defun client-as-string (socket)
>> "A helper function which returns the client's address and port as a
>> string and tries to act robustly in the presence of network problems."
>> @@ -127,15 +235,14 @@
>> (usocket:vector-quad-to-dotted-quad address)
>> port))))
>>
>> -#-:lispworks
>> -(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket)
>> - (bt:make-thread (lambda ()
>> - (process-connection (taskmaster-acceptor taskmaster) socket))
>> - :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket))))
>> +) ;#-:lispworks
>> +
>>
>> -;; LispWorks implementation
>> +;;; LispWorks implementation
>>
>> #+:lispworks
>> +(progn
>> +
>
> Another top-level progn (not going to point at those if there are any
> more, please let them all go).
>
>> (defmethod shutdown ((taskmaster taskmaster))
>> (when-let (process (acceptor-process (taskmaster-acceptor taskmaster)))
>> ;; kill the main acceptor process, see LW documentation for
>> @@ -143,20 +250,38 @@
>> (mp:process-kill process))
>> taskmaster)
>>
>> -#+:lispworks
>> (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster))
>> (accept-connections (taskmaster-acceptor taskmaster)))
>>
>> -#+:lispworks
>> -(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) handle)
>> +(defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket)
>> (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))
>> + (if (taskmaster-max-threads taskmaster)
>> + (if (< (taskmaster-thread-count taskmaster) (taskmaster-max-threads taskmaster))
>> + (progn
>> + (increment-taskmaster-thread-count taskmaster)
>> + (funcall (taskmaster-create-thread-function taskmaster) taskmaster socket))
>> + ;; With any luck, we never get this far if we've exceeded the thread count
>> + ;; "Good" implementations of 'accept-connections' won't even accept connection requests
>> + (progn
>> + (when-let (handler (taskmaster-too-many-threads-handler taskmaster))
>> + (funcall handler taskmaster socket))
>> + (usocket:socket-close socket)))
>> + (funcall (taskmaster-create-thread-function taskmaster) taskmaster socket)))
>
> Another (if ... (progn ..)) that should be improved.
>
>> +
>> +(defun create-taskmaster-thread (taskmaster socket)
>> + (flet ((process (taskmaster sock)
>> + (multiple-value-prog1
>> + (process-connection (taskmaster-acceptor taskmaster) socket)
>> + (decrement-taskmaster-thread-count taskmaster))))
>> + (mp:process-run-function (format nil "hunchentoot-worker-{~A:~A~})"
>> + (multiple-value-list
>> + (get-peer-address-and-port socket)))
>> + nil #'process taskmaster socket)))
>> +
>> +) ;#+:lispworks
>> +
>>
>>
>> _______________________________________________
>> tbnl-devel site list
>> tbnl-devel at common-lisp.net
>> http://common-lisp.net/mailman/listinfo/tbnl-devel
>>
>
> _______________________________________________
> tbnl-devel site list
> tbnl-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/tbnl-devel
More information about the Tbnl-devel
mailing list