[hunchentoot-devel] spawning threads

[Faré]

On Thu, Mar 21, 2013 at 12:14 AM, Faré <fahree at gmail.com> wrote:
> In quux-hunchentoot, I introduce a gf
>
> (defgeneric start-thread (context thunk &key))
>
> with a method
>
> (defmethod start-thread ((taskmaster thread-pooling-taskmaster) thunk &key name)
>   (declare (ignorable taskmaster))
>   (bt:make-thread thunk :name name))
>
> that offers an extension point so that applications can specify
> bindings, handlers, etc.,
> around the spawning of threads.
>
> I believe this technique could be advantageously adopted by
> hunchentoot in general.
>
> PS: if this reminds you of "interface-passing style", that's not a coincidence.
>
Here's the code I'd like to see used (with the function exported):

(in-package :quux-hunchentoot)

(defgeneric start-thread (context thunk &key))

(defmethod start-thread (context thunk &key name)
  (declare (ignorable context))
  #-lispworks
  (bt:make-thread thunk :name name)
  #+lispworks
  (mp:process-run-function name nil thunk))


;;; This overrides the default methods from hunchentoot/taskmaster.lisp,
;;; providing the desired extension point, so you can wrap the
hunchentoot-provided thunk
;;; in a set of default bindings, condition handlers, etc.
(defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster))
  (setf (acceptor-process taskmaster)
        (start-thread
         taskmaster
         (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 create-request-handler-thread ((taskmaster
one-thread-per-connection-taskmaster) socket)
  "Create a thread for handling a single request"
  ;; we are handling all conditions here as we want to make sure that
  ;; the acceptor process never crashes while trying to create a
  ;; worker thread; one such problem exists in
  ;; GET-PEER-ADDRESS-AND-PORT which can signal socket conditions on
  ;; some platforms in certain situations.
  (handler-case*
   (start-thread
    taskmaster
    (lambda () (handle-incoming-connection% taskmaster socket))
    :name (format nil (taskmaster-worker-thread-name-format
taskmaster) (client-as-string socket)))
   (error (cond)
          ;; need to bind *ACCEPTOR* so that LOG-MESSAGE* can do its work.
          (let ((*acceptor* (taskmaster-acceptor taskmaster)))
            (ignore-errors
              (close (make-socket-stream socket *acceptor*) :abort t))
            (log-message* *lisp-errors-log-level*
                         "Error while creating worker thread for new
incoming connection: ~A" cond)))))

—♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org
I discovered a few years ago that happiness was something you put into life,
not something you get out of it — and I was transformed.