[hunchentoot-devel] Customizing acceptor behaviour

[Sebastian Tennant]

Hi there,

I've managed to set up two acceptors which use different dispatch tables and
write to different message log files by using packages and passing modified
copies of LOG-MESSAGE-TO-FILE and LIST-REQUEST-DISPATCHER as keyword args when
instantiating each acceptor (within each package).

It works but there is a lot of code duplication going on so I decided to try
and creating a third package (maytal) which does essentially the same thing in
an abstracted way by subclassing TBNL:ACCEPTOR.

I should point out that If I'm barking up the wrong tree entirely, it's because
I'm new to CLOS (and relatively new to OOP in general).

In short, I'm trying to create a package (maytal) which I can use in other
packages like so:

 ;; set up and enter development environment package
 (in-package :cl-user)
 (defpackage "DEV-ENV" (:use :cl))
 (in-package :dev-env)

 ;; dev-env::*dispatch-table*
 (defvar *dispatch-table* '())

 ;; instantiate dev-env::*acceptor*
 (defvar *acceptor* (make-instance 'maytal::acceptor
                                   :port 49154
                                   :msg-log-file "./messages/dev.log"
                                   :dispatch-table *dispatch-table*))

 (tbnl:start *acceptor*)
 (msg 'info "DEV-ENV::*ACCEPTOR* started on port 49154")



Here's my first stab at creating maytal:

 (in-package :cl-user)
 (defpackage "MAYTAL" (:use :cl))
 (in-package :maytal)

 (defclass acceptor (tbnl:acceptor)
   ((msg-log-file :initarg :msg-log-file)
    (dispatch-table :initarg :dispatch-table)))

 (defmethod initialize-instance :after ((a acceptor) &key)
   ;; prepare local environment for closures
   (let ((mlf (slot-value a 'msg-log-file))
	 (dt (slot-value a 'dispatch-table)))

     ;; handy (i.e., short-name) message log function based on tbnl:log-message-to-file
     (defun msg (log-level format-string &rest format-arguments)
       (tbnl::with-log-file
        (stream mlf (tbnl::make-lock (symbol-name (gensym))))
        (format stream "[~A~@[ [~A]~]] ~?~%" (tbnl::iso-time) log-level
                format-string format-arguments)))

     (setf (slot-value a 'tbnl::message-logger) 'msg)

     ;; annonymous request dispatcher function based on tbnl:list-request-dispatcher but
     ;; which uses a locally defined dispatch table variable
     (setf (slot-value a 'tbnl::request-dispatcher)
	   (lambda (request)
	     (loop for dispatcher in dt
		   for action = (funcall dispatcher request)
		   when action return (funcall action)
		     finally (setf (tbnl:return-code tbnl:*reply*)
				   tbnl:+http-not-found+)))
     ))

Needless to say it doesn't work. The function 'msg' is defined in the maytal package
rather than in the package which is current when an instance of maytal::acceptor is
created (thus defeating the whole purpose of my efforts), and although the request
dispatcher functions in different packages appear to use different dispatch tables, they
don't actually work!

 ;;; (in-package :dev-env)
 (msg 'info "Acceptor ITI-DEV::*ACCEPTOR* started on port 49154")
 ;;; => Undefined function MSG called with arguments [...]                                                                           
 (tbnl::acceptor-message-logger *acceptor*)
 ;;; => MAYTAL::MSG

 (tbnl::acceptor-request-dispatcher *acceptor*)
 ;;; => #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL (INITIALIZE-INSTANCE :AFTER (MAYTAL::ACCEPTOR))) #x91D16C6>                        
Any and all help very much appreciated.

Regards,

Seb
-- 
Emacs' AlsaPlayer - Music Without Jolts
Lightweight, full-featured and mindful of your idyllic happiness.
http://home.gna.org/eap