On Thu, Mar 21, 2013 at 12:14 AM, Faré fahree@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.