Revision: 4279 Author: hans URL: http://bknr.net/trac/changeset/4279

Warn about unbound *session-secret* when sessions are first used, not upon startup. Rename handler-selector to request-dispatcher. Make PROCESS-REQUEST a generic function and export it so that applications can bind special variables early in the request processing chain.

U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp

Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -62,13 +62,13 @@ objects is created when a request is served in and should be (a symbol naming) a class which inherits from REPLY. The default is the symbol REPLY.") - (handler-selector :initarg :handler-selector - :accessor acceptor-handler-selector - :documentation "A designator for the handler -selector function used by this acceptor. A function which accepts a + (request-dispatcher :initarg :request-dispatcher + :accessor acceptor-request-dispatcher + :documentation "A designator for the request +dispatcher function used by this acceptor. A function which accepts a REQUEST object and calls a request handler of its choice (and returns its return value). The default is the unexported symbol -LIST-HANDLER-SELECTOR which works through the list *DISPATCH-TABLE*.") +LIST-REQUEST-DISPATCHER which works through the list *DISPATCH-TABLE*.") (taskmaster :initarg :taskmaster :reader acceptor-taskmaster :documentation "The taskmaster (i.e. an instance of a @@ -151,7 +151,7 @@ :name (gensym) :request-class 'request :reply-class 'reply - :handler-selector 'list-handler-selector + :request-dispatcher 'list-request-dispatcher :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-taskmaster) (t 'single-threaded-taskmaster))) :output-chunking-p t @@ -230,11 +230,6 @@

;; general implementation

-(defmethod start :before ((acceptor acceptor)) - (unless (boundp '*session-secret*) - (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") - (reset-session-secret))) - (defmethod start ((acceptor acceptor)) (start-listening acceptor) (let ((taskmaster (acceptor-taskmaster acceptor))) @@ -286,7 +281,6 @@ (defmethod process-connection ((*acceptor* acceptor) (socket t)) (let ((*hunchentoot-stream* (initialize-connection-stream *acceptor* (make-socket-stream socket *acceptor*)))) - (print *hunchentoot-stream*) (unwind-protect ;; process requests until either the acceptor is shut down, ;; *CLOSE-HUNCHENTOOT-STREAM* has been set to T by the @@ -337,53 +331,6 @@ (ignore-errors (force-output *hunchentoot-stream*) (close *hunchentoot-stream* :abort t)))))) - -(defun process-request (request) - "This function is called by PROCESS-CONNECTION after the incoming -headers have been read. It selects and calls a handler and sends the -output of this handler to the client using START-OUTPUT. It also sets -up simple error handling for the actual request handler. - -The return value of this function is ignored." - (let (*tmp-files* *headers-sent*) - (unwind-protect - (let* ((*request* request)) - (multiple-value-bind (body error) - (catch 'handler-done - (handler-bind ((error - (lambda (cond) - (when *log-lisp-errors-p* - (log-message *lisp-errors-log-level* "~A" cond)) - ;; if the headers were already sent - ;; the error happens within the body - ;; and we have to close the stream - (when *headers-sent* - (setq *close-hunchentoot-stream* t)) - (throw 'handler-done - (values nil cond)))) - (warning - (lambda (cond) - (when *log-lisp-warnings-p* - (log-message *lisp-warnings-log-level* "~A" cond))))) - ;; skip dispatch if bad request - (when (eql (return-code *reply*) +http-ok+) - ;; now do the work - (funcall (acceptor-handler-selector *acceptor*) *request*)))) - (when error - (setf (return-code *reply*) - +http-internal-server-error+)) - (start-output :content (cond ((and error *show-lisp-errors-p*) - (format nil "<pre>~A</pre>" - (escape-for-html (format nil "~A" error)))) - (error - "An error has occured.") - (t body))))) - (dolist (path *tmp-files*) - (when (and (pathnamep path) (probe-file path)) - ;; the handler may have chosen to (re)move the uploaded - ;; file, so ignore errors that happen during deletion - (ignore-errors - (delete-file path)))))))

(defmethod acceptor-ssl-p ((acceptor t)) ;; the default is to always answer "no" @@ -454,7 +401,7 @@ (mp:process-unstop (acceptor-process acceptor)) nil)

-(defun list-handler-selector (request) +(defun list-request-dispatcher (request) "The default handler selector which selects a request handler based on a list of individual request dispatchers all of which can either return a handler or neglect by returning NIL."

Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -121,7 +121,7 @@ "ACCEPTOR-ACCESS-LOGGER" "ACCEPTOR-ADDRESS" "ACCEPT-CONNECTIONS" - "ACCEPTOR-HANDLER-SELECTOR" + "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-INPUT-CHUNKING-P" "ACCEPTOR-MESSAGE-LOGGER" "ACCEPTOR-NAME" @@ -194,6 +194,7 @@ "POST-PARAMETERS" "POST-PARAMETERS*" "PROCESS-CONNECTION" + "PROCESS-REQUEST" "QUERY-STRING" "QUERY-STRING*" "RAW-POST-DATA"

Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -95,6 +95,14 @@ can subclass REQUEST in order to implement your own behaviour. See the REQUEST-CLASS slot of the ACCEPTOR class."))

+(defgeneric process-request (request) + (:documentation "This function is called by PROCESS-CONNECTION after the incoming +headers have been read. It selects and calls a handler and sends the +output of this handler to the client using START-OUTPUT. It also sets +up simple error handling for the actual request handler. + +The return value of this function is ignored.")) + (defun convert-hack (string external-format) "The rfc2388 package is buggy in that it operates on a character stream and thus only accepts encodings which are 8 bit transparent. @@ -195,6 +203,50 @@ ;; we assume it's not our fault... (setf (return-code*) +http-bad-request+)))))

+(defmethod process-request (request) + + "Standard implementation for processing a request." + + (let (*tmp-files* *headers-sent*) + (unwind-protect + (let* ((*request* request)) + (multiple-value-bind (body error) + (catch 'handler-done + (handler-bind ((error + (lambda (cond) + (when *log-lisp-errors-p* + (log-message *lisp-errors-log-level* "~A" cond)) + ;; if the headers were already sent + ;; the error happens within the body + ;; and we have to close the stream + (when *headers-sent* + (setq *close-hunchentoot-stream* t)) + (throw 'handler-done + (values nil cond)))) + (warning + (lambda (cond) + (when *log-lisp-warnings-p* + (log-message *lisp-warnings-log-level* "~A" cond))))) + ;; skip dispatch if bad request + (when (eql (return-code *reply*) +http-ok+) + ;; now do the work + (funcall (acceptor-request-dispatcher *acceptor*) *request*)))) + (when error + (setf (return-code *reply*) + +http-internal-server-error+)) + (start-output :content (cond ((and error *show-lisp-errors-p*) + (format nil "<pre>~A</pre>" + (escape-for-html (format nil "~A" error)))) + (error + "An error has occured.") + (t body))))) + (dolist (path *tmp-files*) + (when (and (pathnamep path) (probe-file path)) + ;; the handler may have chosen to (re)move the uploaded + ;; file, so ignore errors that happen during deletion + (ignore-errors + (delete-file path))))))) + (defun parse-multipart-form-data (request external-format) "Parse the REQUEST body as multipart/form-data, assuming that its content type has already been verified. Returns the form data as

Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 00:32:16 UTC (rev 4278) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-18 14:57:40 UTC (rev 4279) @@ -129,6 +129,9 @@ USER-AGENT, REMOTE-ADDR, and START" ;; *SESSION-SECRET* is used twice due to known theoretical ;; vulnerabilities of MD5 encoding + (unless (boundp '*session-secret*) + (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") + (reset-session-secret)) (md5-hex (concatenate 'string *session-secret* (md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A"