[hunchentoot-devel] 'max-threads' behavior for Hunchentoot

Hans Hübner hans.huebner at gmail.com
Tue Jun 1 13:28:59 UTC 2010


Scott,

as we have chosen to implement Hunchentoot as object oriented program,
using generic functions is the proper way to extend the functionality.
 I do agree that this is not the only way how to structure Lisp
programs and it may also not be the best way according to taste and
preference.  Please use generic functions in order not to make the
next guy wonder why part of Hunchentoot is this way, and part of it is
another.

Thanks.
-Hans

On Tue, Jun 1, 2010 at 15:23, Scott McKay <swm at itasoftware.com> wrote:
> 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
>
>
> _______________________________________________
> 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