[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Thu Feb 26 13:17:12 UTC 2009
Revision: 4323
Author: hans
URL: http://bknr.net/trac/changeset/4323
re-add usocket condition mapping
U trunk/thirdparty/hunchentoot/acceptor.lisp
U trunk/thirdparty/hunchentoot/headers.lisp
U trunk/thirdparty/hunchentoot/request.lisp
U trunk/thirdparty/hunchentoot/util.lisp
Modified: trunk/thirdparty/hunchentoot/acceptor.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-25 07:44:09 UTC (rev 4322)
+++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-26 13:17:12 UTC (rev 4323)
@@ -286,7 +286,8 @@
(lambda (cond)
(log-message *lisp-warnings-log-level*
"Warning while processing connection: ~A" cond))))
- (call-next-method)))
+ (with-mapped-conditions ()
+ (call-next-method))))
(defmethod process-connection ((*acceptor* acceptor) (socket t))
(let ((*hunchentoot-stream*
Modified: trunk/thirdparty/hunchentoot/headers.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-25 07:44:09 UTC (rev 4322)
+++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-26 13:17:12 UTC (rev 4323)
@@ -230,15 +230,21 @@
(start-output))
(defun read-initial-request-line (stream)
- "Reads and returns the initial HTTP request line, catching permitted
-errors and handling *BREAK-EVEN-WHILE-READING-REQUEST-TYPE-P*. If no
-request could be read, returns NIL."
+ "Reads and returns the initial HTTP request line, catching permitted errors
+and handling *BREAK-EVEN-WHILE-READING-REQUEST-TYPE-P*. If no request could
+be read, returns NIL. At this point, both an end-of-file as well as a
+timeout condition are normal. end-of-file will occur when the client has
+decided to not send another request but close the connection. A timeout
+indicates that the connection timeout established by Hunchentoot has expired
+and we do not want to wait for another request any longer."
(let ((*break-on-signals* (and *break-even-while-reading-request-type-p*
*break-on-signals*)))
(handler-case
(let ((*current-error-message* "While reading initial request line:"))
- (read-line* stream))
- ((or end-of-file #-:lispworks usocket:timeout-error) ()
+ (with-mapped-conditions ()
+ (read-line* stream)))
+ ((or end-of-file
+ #-:lispworks usocket:timeout-error) ()
nil))))
(defun get-request-data (stream)
Modified: trunk/thirdparty/hunchentoot/request.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/request.lisp 2009-02-25 07:44:09 UTC (rev 4322)
+++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-26 13:17:12 UTC (rev 4323)
@@ -216,37 +216,38 @@
doing."
(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)))))
+ (with-mapped-conditions ()
+ (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
Modified: trunk/thirdparty/hunchentoot/util.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/util.lisp 2009-02-25 07:44:09 UTC (rev 4322)
+++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-26 13:17:12 UTC (rev 4323)
@@ -320,3 +320,11 @@
"Whether the current connection to the client is secure."
(acceptor-ssl-p acceptor))
+(defmacro with-mapped-conditions (() &body body)
+ "Run BODY with usocket condition mapping in effect, i.e. platform specific network errors will be
+ signalled as usocket conditions. For Lispworks, no mapping is performed."
+ #+:lispworks
+ `(progn , at body)
+ #-:lispworks
+ `(usocket:with-mapped-conditions ()
+ , at body))
\ No newline at end of file
More information about the Bknr-cvs
mailing list