- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 09 Feb '11

09 Feb '11

Revision: 4644 Author: hans URL: http://bknr.net/trac/changeset/4644 Add skeleton file tree to be served by Hunchentoot in its default configuration. Make error pages customizable through files. Add new :document-root argument to acceptor to specify where files should be served from. U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/misc.lisp A trunk/thirdparty/hunchentoot/www/ A trunk/thirdparty/hunchentoot/www/errors/ A trunk/thirdparty/hunchentoot/www/errors/404.html A trunk/thirdparty/hunchentoot/www/img/ A trunk/thirdparty/hunchentoot/www/img/made-with-lisp-logo.jpg A trunk/thirdparty/hunchentoot/www/index.html Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-02-07 17:42:05 UTC (rev 4643) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-02-09 17:07:08 UTC (rev 4644) @@ -29,6 +29,10 @@ (in-package :hunchentoot) +(eval-when (:load-toplevel) + (defun default-document-directory (&optional sub-directory) + (asdf:system-relative-pathname :hunchentoot (format nil "www/~@[~A~]" sub-directory)))) + (defclass acceptor () ((port :initarg :port :reader acceptor-port @@ -124,7 +128,20 @@ :documentation "Pathname of the server error log file which is used to log informational, warning and error messages in a free-text -format intended for human inspection")) +format intended for human inspection") + (error-template-directory :initarg :error-template-directory + :accessor acceptor-error-template-directory + :documentation "Directory pathname that + contains error message template files for server-generated error + messages. Files must be named <return-code>.html with <return-code> + representing the HTTP return code that the file applies to, + i.e. 404.html would be used as the content for a HTTP 404 Not found + response.") + (document-root :initarg :document-root + :accessor acceptor-document-root + :documentation "Directory pathname that points to +files that are served by the acceptor if no more specific +acceptor-dispatch-request method handles the request.")) (:default-initargs :address nil :port 80 @@ -139,7 +156,9 @@ :read-timeout *default-connection-timeout* :write-timeout *default-connection-timeout* :access-log-pathname nil - :message-log-pathname nil) + :message-log-pathname nil + :document-root (load-time-value (default-document-directory)) + :error-template-directory (load-time-value (default-document-directory "errors/"))) (:documentation "To create a Hunchentoot webserver, you make an instance of this class and use the generic function START to start it \(and STOP to stop it). Use the :PORT initarg if you don't want to @@ -457,7 +476,12 @@ (defmethod acceptor-dispatch-request ((acceptor acceptor) request) "Detault implementation of the request dispatch method, generates a +http-not-found+ error+." (declare (ignore request)) - (setf (return-code *reply*) +http-not-found+)) + (if (acceptor-document-root acceptor) + (handle-static-file (merge-pathnames (if (equal (script-name*) "/") + "index.html" + (subseq (script-name*) 1)) + (acceptor-document-root acceptor))) + (setf (return-code *reply*) +http-not-found+))) (defmethod handle-request ((*acceptor* acceptor) (*request* request)) "Standard method for request handling. Calls the request dispatcher @@ -493,41 +517,72 @@ client. For other return codes, the content can be ignored and/or processed, depending on the requirements of the acceptor class. Note that the CONTENT argument can be NIL if the handler wants to - send the data to the client stream itself.")) + send the data to the client stream itself. + If an ERROR-TEMPLATE-DIRECTORY is set in the current acceptor and + the directory contains a file corresponding to HTTP-RETURN-CODE, + that file is sent to the client after variable substitution. + Variables are referenced by ${<variable-name>}. Currently, only + the ${script-name} variable is supported which contains the current + URL relative to the server's base URL.")) + (defmethod acceptor-handle-return-code ((acceptor acceptor) http-return-code content) "Default function to generate error message sent to the client." - (flet ((cooked-message (format &rest arguments) - (setf (content-type*) "text/html; charset=iso-8859-1") - (format nil "<html><head><title>~D ~A</title></head><body><h1>~:*~A</h1>~?<p><hr>~A</p></body></html>" - http-return-code (reason-phrase http-return-code) - format (mapcar (lambda (arg) - (if (stringp arg) - (escape-for-html arg) - arg)) - arguments) - (address-string)))) - (case http-return-code - ((#.+http-internal-server-error+ - #.+http-ok+) - content) - ((#.+http-moved-temporarily+ - #.+http-moved-permanently+) - (cooked-message "The document has moved <a href='~A'>here</a>" (header-out :location))) - ((#.+http-authorization-required+) - (cooked-message "The server could not verify that you are authorized to access the document requested. ~ + (labels + ((cooked-message (format &rest arguments) + (setf (content-type*) "text/html; charset=iso-8859-1") + (format nil "<html><head><title>~D ~A</title></head><body><h1>~:*~A</h1>~?<p><hr>~A</p></body></html>" + http-return-code (reason-phrase http-return-code) + format (mapcar (lambda (arg) + (if (stringp arg) + (escape-for-html arg) + arg)) + arguments) + (address-string))) + (substitute-request-context-variables (string) + (cl-ppcre:regex-replace-all "(?i)\\$\\{([a-z0-9-_]+)\\}" + string + (lambda (target-string start end match-start match-end reg-starts reg-ends) + (declare (ignore start end match-start match-end)) + (let ((variable (intern (string-upcase (subseq target-string + (aref reg-starts 0) + (aref reg-ends 0))) + :keyword))) + (case variable + (:script-name (script-name*)) + (otherwise (string variable))))))) + (file-contents (file) + (let ((buf (make-string (file-length file)))) + (read-sequence buf file) + buf)) + (error-contents-from-template () + (let ((error-file-template-pathname (and (acceptor-error-template-directory acceptor) + (probe-file (make-pathname :name (princ-to-string http-return-code) + :type "html" + :defaults (acceptor-error-template-directory acceptor)))))) + (when error-file-template-pathname + (with-open-file (file error-file-template-pathname :if-does-not-exist nil :element-type 'character) + (when file + (substitute-request-context-variables (file-contents file)))))))) + (or (error-contents-from-template) + (case http-return-code + ((#.+http-moved-temporarily+ + #.+http-moved-permanently+) + (cooked-message "The document has moved <a href='~A'>here</a>" (header-out :location))) + ((#.+http-authorization-required+) + (cooked-message "The server could not verify that you are authorized to access the document requested. ~ Either you supplied the wrong credentials \(e.g., bad password), or your browser doesn't ~ understand how to supply the credentials required.")) - ((#.+http-forbidden+) - (cooked-message "You don't have permission to access ~A on this server." - (script-name *request*))) - ((#.+http-not-found+) - (cooked-message "The requested URL ~A was not found on this server." - (script-name *request*))) - ((#.+http-bad-request+) - (cooked-message "Your browser sent a request that this server could not understand.")) - (otherwise - content)))) + ((#.+http-forbidden+) + (cooked-message "You don't have permission to access ~A on this server." + (script-name *request*))) + ((#.+http-not-found+) + (cooked-message "The requested URL ~A was not found on this server." + (script-name *request*))) + ((#.+http-bad-request+) + (cooked-message "Your browser sent a request that this server could not understand.")) + (otherwise + content))))) (defgeneric acceptor-remove-session (acceptor session) (:documentation Modified: trunk/thirdparty/hunchentoot/doc/index.xml =================================================================== --- trunk/thirdparty/hunchentoot/doc/index.xml 2011-02-07 17:42:05 UTC (rev 4643) +++ trunk/thirdparty/hunchentoot/doc/index.xml 2011-02-09 17:07:08 UTC (rev 4644) @@ -475,10 +475,10 @@ </clix:returns> </clix:listed-accessor> - <clix:listed-accessor generic='true' name='acceptor-request-dispatcher'> + <clix:listed-accessor generic='true' name='acceptor-error-template-directory'> <clix:lambda-list>acceptor </clix:lambda-list> - <clix:returns>request-dispatcher + <clix:returns>(or pathname null) </clix:returns> </clix:listed-accessor> @@ -531,6 +531,13 @@ </clix:returns> </clix:listed-accessor> + <clix:listed-accessor generic='true' name='acceptor-request-dispatcher'> + <clix:lambda-list>acceptor + </clix:lambda-list> + <clix:returns>request-dispatcher + </clix:returns> + </clix:listed-accessor> + <clix:description> These are accessors for various slots of <clix:ref>ACCEPTOR</clix:ref> objects. See the docstrings of these slots for more information and @@ -685,6 +692,32 @@ </clix:description> </clix:function> + <clix:function name="acceptor-handle-return-code" generic="true"> + <clix:lambda-list>acceptor http-return-code content</clix:lambda-list> + <clix:description> + This function is called after the request's handler has been + invoked, before starting to send any output to the client. It + converts the HTTP return code that has been determined as the + result of the handler invocation into a content body sent to + the user. The content generated by the handler is passed to + this function as <clix:arg>CONTENT</clix:arg> argument. For + positive return codes (i.e. ``200 OK''), the CONTENT is + typically just sent to the client. For other return codes, + the content can be ignored and/or processed, depending on the + requirements of the acceptor class. Note that the + <clix:arg>CONTENT</clix:arg> argument can be NIL if the + handler wants to send the data to the client stream itself. + + If an ERROR-TEMPLATE-DIRECTORY is set in the current acceptor + and the directory contains a file corresponding to + <clix:arg>HTTP-RETURN-CODE</clix:arg>, that file is sent to + the client after variable substitution. Variables are + referenced by ${<variable-name>}. Currently, only the + ${script-name} variable is supported which contains the + current URL relative to the server's base URL. + </clix:description> + </clix:function> + </clix:subchapter> <clix:subchapter name="taskmasters" title="Taskmasters"> Modified: trunk/thirdparty/hunchentoot/easy-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/easy-handlers.lisp 2011-02-07 17:42:05 UTC (rev 4643) +++ trunk/thirdparty/hunchentoot/easy-handlers.lisp 2011-02-09 17:07:08 UTC (rev 4644) @@ -29,7 +29,7 @@ (in-package :hunchentoot) -(defvar *dispatch-table* (list 'dispatch-easy-handlers 'default-dispatcher) +(defvar *dispatch-table* (list 'dispatch-easy-handlers) "A global list of dispatch functions.") (defvar *easy-handler-alist* nil @@ -339,4 +339,4 @@ (loop for dispatcher in *dispatch-table* for action = (funcall dispatcher request) when action return (funcall action) - finally (setf (return-code *reply*) +http-not-found+))) + finally (call-next-method))) Modified: trunk/thirdparty/hunchentoot/misc.lisp =================================================================== --- trunk/thirdparty/hunchentoot/misc.lisp 2011-02-07 17:42:05 UTC (rev 4643) +++ trunk/thirdparty/hunchentoot/misc.lisp 2011-02-09 17:07:08 UTC (rev 4644) @@ -145,28 +145,29 @@ bytes-to-send (1+ (- end start)))) bytes-to-send)) -(defun handle-static-file (path &optional content-type) +(defun handle-static-file (pathname &optional content-type) "A function which acts like a Hunchentoot handler for the file -denoted by PATH. Sends a content type header corresponding to +denoted by PATHNAME. Sends a content type header corresponding to CONTENT-TYPE or \(if that is NIL) tries to determine the content type via the file's suffix." - (when (or (wild-pathname-p path) - (not (fad:file-exists-p path)) - (fad:directory-exists-p path)) + (when (or (wild-pathname-p pathname) + (not (fad:file-exists-p pathname)) + (fad:directory-exists-p pathname)) ;; file does not exist (setf (return-code*) +http-not-found+) (abort-request-handler)) - (let ((time (or (file-write-date path) (get-universal-time))) + (let ((time (or (file-write-date pathname) + (get-universal-time))) bytes-to-send) - (setf (content-type*) (or content-type - (mime-type path) - "application/octet-stream")) (handle-if-modified-since time) - (with-open-file (file path - :direction :input - :element-type 'octet - :if-does-not-exist nil) - (setf (header-out :content-range) (format nil "bytes 0-~D/*" (file-length file)) + (with-open-file (file pathname + :direction :input + :element-type 'octet + :if-does-not-exist nil) + (setf (content-type*) (or content-type + (mime-type pathname) + "application/octet-stream") + (header-out :content-range) (format nil "bytes 0-~D/*" (file-length file)) (header-out :last-modified) (rfc-1123-date time) bytes-to-send (maybe-handle-range-header file) (content-length*) bytes-to-send) Added: trunk/thirdparty/hunchentoot/www/errors/404.html =================================================================== --- trunk/thirdparty/hunchentoot/www/errors/404.html (rev 0) +++ trunk/thirdparty/hunchentoot/www/errors/404.html 2011-02-09 17:07:08 UTC (rev 4644) @@ -0,0 +1,9 @@ +<html> + <head> + <title>Not found</title> + </head> + <body> + Resource ${script-name} not found. + <img src="/img/made-with-lisp-logo.jpg" width="300" height="100"/> + </body> +</html> Added: trunk/thirdparty/hunchentoot/www/img/made-with-lisp-logo.jpg =================================================================== (Binary files differ) Property changes on: trunk/thirdparty/hunchentoot/www/img/made-with-lisp-logo.jpg ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: trunk/thirdparty/hunchentoot/www/index.html =================================================================== --- trunk/thirdparty/hunchentoot/www/index.html (rev 0) +++ trunk/thirdparty/hunchentoot/www/index.html 2011-02-09 17:07:08 UTC (rev 4644) @@ -0,0 +1,17 @@ +<html> + <head> + <title>Welcome to Hunchentoot!</title> + </head> + <body> + <h1>Welcome</h1> + <p> + When you're reading this message, Hunchentoot has been properly installed. + </p> + <p> + Please read the <a href="../doc/index.html">documentation</a>. + </p> + <p> + <img src="img/made-with-lisp-logo.jpg" width="300" height="100"/> + </p> + </body> +</html>

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 07 Feb '11

07 Feb '11

Revision: 4643 Author: hans URL: http://bknr.net/trac/changeset/4643 Numerous changes. Please note that startup has changed: (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242)) Please test Hunchentoot and report problems: (hunchentoot-test:test-hunchentoot "http://localhost:4242") Summary of changes: Overhaul error and return code handling. Improve behavior for internal errors. Support Range: header in static file handler. Use generic functions instead of closures in core functionality: acceptor-server-name, acceptor-remove-session, acceptor-dispatch-request, acceptor-handle-return-code I attempted to document all changes, but please report if there are any missing bits. _U trunk/thirdparty/hunchentoot/ U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp _U trunk/thirdparty/hunchentoot/test/ U trunk/thirdparty/hunchentoot/test/script-engine.lisp U trunk/thirdparty/hunchentoot/test/script.lisp U trunk/thirdparty/hunchentoot/test/test-handlers.lisp U trunk/thirdparty/hunchentoot/util.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/thirdparty/drakma/
by BKNR Commits 07 Feb '11

07 Feb '11

Revision: 4642 Author: hans URL: http://bknr.net/trac/changeset/4642 support Range: header to retrieve partial resources U trunk/thirdparty/drakma/doc/index.html U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2011-02-05 07:45:59 UTC (rev 4641) +++ trunk/thirdparty/drakma/doc/index.html 2011-02-07 17:27:23 UTC (rev 4642) @@ -731,7 +731,55 @@  -<p><br><table border=0><tr><td colspan=4 valign=top>[Function]</td></tr><tr><td valign=top style="white-space:nowrap"><a class=none name='http-request'><b>http-request</b></a> </td><td valign=top><i><a class=none href="#uri">uri</a> </i></td><td valign=top><tt>&key</tt> </td><td><i><a class=none href="#protocol">protocol</a> <a class=none href="#method">method</a> <a class=none href="#force-ssl">force-ssl</a> <a class=none href="#parameters">parameters</a> <a class=none href="#form-data">form-data</a> <a class=none href="#content">content</a> <a class=none href="#content-length">content-length</a> <a class=none href="#content-type">content-type</a> <a class=none href="#cookie-jar-param">cookie-jar</a> <a class=none href="#basic-authorization">basic-authorization</a> <a class=none href="#user-agent">user-agent</a> <a class=none href="#accept">accept</a> <a class=none href="#proxy">proxy</a> <a class=none href="#proxy-basic-authorization">proxy-basic-authorization</a> <a class=none href="#additional-headers">additional-headers</a> <a class=none href="#redirect">redirect</a> <a class=none href="#redirect-methods">redirect-methods</a> <a class=none href="#auto-referer">auto-referer</a> <a class=none href="#keep-alive">keep-alive</a> <a class=none href="#close">close</a> <a class=none href="#external-format-out">external-format-out</a> <a class=none href="#external-format-in">external-format-in</a> <a class=none href="#force-binary">force-binary</a> <a class=none href="#want-stream">want-stream</a> <a class=none href="#stream">stream</a> <a class=none href="#connection-timeout">connection-timeout</a> <a class=none href="#read-timeout">read-timeout</a> <a class=none href="#write-timeout">write-timeout</a> <a class=none href="#deadline">deadline</a></i></td></tr><tr><td colspan=2></td><td colspan=2 valign=top> => <i>body-or-stream, status-code, headers, uri, stream, <a class=none href="#must-close">must-close</a>, reason-phrase</i></td></tr></table> +<p> + <br> + <table border=0> + <tr> + <td colspan=4 valign=top>[Function]</td> + </tr> + <tr> + <td valign=top style="white-space:nowrap"><a class=none name='http-request'><b>http-request</b></a> </td> + <td valign=top><i><a class=none href="#uri">uri</a> </i></td> + <td valign=top><tt>&key</tt> </td> + <td> + <i> + <a class=none href="#protocol">protocol</a> + <a class=none href="#method">method</a> + <a class=none href="#force-ssl">force-ssl</a> + <a class=none href="#parameters">parameters</a> + <a class=none href="#form-data">form-data</a> + <a class=none href="#content">content</a> + <a class=none href="#content-length">content-length</a> + <a class=none href="#content-type">content-type</a> + <a class=none href="#cookie-jar-param">cookie-jar</a> + <a class=none href="#basic-authorization">basic-authorization</a> + <a class=none href="#user-agent">user-agent</a> + <a class=none href="#accept">accept</a> + <a class=none href="#range">range</a> + <a class=none href="#proxy">proxy</a> + <a class=none href="#proxy-basic-authorization">proxy-basic-authorization</a> + <a class=none href="#additional-headers">additional-headers</a> + <a class=none href="#redirect">redirect</a> + <a class=none href="#redirect-methods">redirect-methods</a> + <a class=none href="#auto-referer">auto-referer</a> + <a class=none href="#keep-alive">keep-alive</a> + <a class=none href="#close">close</a> + <a class=none href="#external-format-out">external-format-out</a> + <a class=none href="#external-format-in">external-format-in</a> + <a class=none href="#force-binary">force-binary</a> + <a class=none href="#want-stream">want-stream</a> + <a class=none href="#stream">stream</a> + <a class=none href="#connection-timeout">connection-timeout</a> + <a class=none href="#read-timeout">read-timeout</a> + <a class=none href="#write-timeout">write-timeout</a> + <a class=none href="#deadline">deadline</a></i> + </td> + </tr> + <tr> + <td colspan=2></td> + <td colspan=2 valign=top> => <i>body-or-stream, status-code, headers, uri, stream, <a class=none href="#must-close">must-close</a>, reason-phrase</i></td> + </tr> + </table> <blockquote><br> Sends an <a href="http://www.rfc.net/rfc2616.html">HTTP</a> request to a web server and returns its reply. @@ -935,6 +983,10 @@ it can be a string which is used directly. <a class=none name="accept"><code><i>accept</i></code></a>, if not <code>NIL</code>, is the 'Accept' header sent - the default is <code>"*/*"</code>. +<a class=none name="range"><code><i>range</i></code></a> optionally +specifies a subrange of the resource to be requested. It must be +specified as list of two integers which indicate the start and +(inclusive) end offset of the requested range, in bytes <p> If <a class=none name="proxy"><code><i>proxy</i></code></a> is not <code>NIL</code>, it should be a string denoting Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2011-02-05 07:45:59 UTC (rev 4641) +++ trunk/thirdparty/drakma/request.lisp 2011-02-07 17:27:23 UTC (rev 4642) @@ -190,6 +190,7 @@ basic-authorization (user-agent :drakma) (accept "*/*") + range proxy proxy-basic-authorization additional-headers @@ -314,9 +315,15 @@ which denote the current version of Drakma or, in the latter four cases, a fixed string corresponding to a more or less recent \(as of August 2006) version of the corresponding browser. Or it can -be a string which is used directly. ACCEPT, if not NIL, is the -`Accept' header sent. +be a string which is used directly. +ACCEPT, if not NIL, specifies the contents of the `Accept' header +sent. + +RANGE optionally specifies a subrange of the resource to be requested. +It must be specified as list of two integers which indicate the start +and (inclusive) end offset of the requested range, in bytes. + If PROXY is not NIL, it should be a string denoting a proxy server through which the request should be sent. Or it can be a list of two values - a string denoting the proxy server and an @@ -404,6 +411,12 @@ (parameter-error "CLOSE and KEEP-ALIVE must not be both true.")) (when (and form-data (not (eq method :post))) (parameter-error "FORM-DATA makes only sense with POST requests.")) + (when range + (unless (and (listp range) + (integerp (first range)) + (integerp (second range)) + (<= (first range) (second range))) + (parameter-error "RANGE parameter must be specified as list of two integers, with the second larger or equal to the first"))) ;; convert PROXY argument to canonical form (when proxy (when (atom proxy) @@ -558,6 +571,8 @@ (second proxy-basic-authorization))))) (when accept (write-header "Accept" "~A" accept)) + (when range + (write-header "Range" "bytes ~A-~A" (first range) (second range))) (when cookie-jar ;; write all cookies in one fell swoop, so even Sun's ;; web server has a chance to get it

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/acceptor.lisp
by BKNR Commits 05 Feb '11

05 Feb '11

Revision: 4641 Author: hans URL: http://bknr.net/trac/changeset/4641 Use FINISH-OUTPUT instead of FORCE-OUTPUT before connection teardown. Thanks to Ilya Perminov for reporting. U trunk/thirdparty/hunchentoot/acceptor.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-01-25 11:43:07 UTC (rev 4640) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-02-05 07:45:59 UTC (rev 4641) @@ -323,7 +323,7 @@ :method method :uri url-string :server-protocol protocol)))) - (force-output *hunchentoot-stream*) + (finish-output *hunchentoot-stream*) (setq *hunchentoot-stream* (reset-connection-stream *acceptor* *hunchentoot-stream*)) (when *close-hunchentoot-stream* (return))))) @@ -332,7 +332,7 @@ ;; errors that may occur while flushing and/or closing the ;; stream. (ignore-errors* - (force-output *hunchentoot-stream*)) + (finish-output *hunchentoot-stream*)) (ignore-errors* (close *hunchentoot-stream* :abort t))))))

1 0

[bknr-cvs] hans changed deployed/bos/projects/bos/m2/config.lisp
by BKNR Commits 25 Jan '11

25 Jan '11

Revision: 4640 Author: hans URL: http://bknr.net/trac/changeset/4640 change email address as requested by joscha U deployed/bos/projects/bos/m2/config.lisp Modified: deployed/bos/projects/bos/m2/config.lisp =================================================================== --- deployed/bos/projects/bos/m2/config.lisp 2011-01-23 09:40:32 UTC (rev 4639) +++ deployed/bos/projects/bos/m2/config.lisp 2011-01-25 11:43:07 UTC (rev 4640) @@ -53,7 +53,7 @@ ;; Mail-Stuff (defparameter *mail-sender* "mxm-automail(a)create-rainforest.org" "Absender für automatisch generierte Mails") -(defparameter *office-mail-address* "mxm-office(a)bos-deutschland.de" +(defparameter *office-mail-address* "mxm(a)bos-deutschland.de" "Empfänger für Office-Mails") ;; Urkundenerzeugung

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 23 Jan '11

23 Jan '11

Revision: 4639 Author: hans URL: http://bknr.net/trac/changeset/4639 Rework logging API, log to *error-output* by default. U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/doc/index.xml U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/misc.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/taskmaster.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/request.lisp
by BKNR Commits 22 Jan '11

22 Jan '11

Revision: 4638 Author: hans URL: http://bknr.net/trac/changeset/4638 Observe *catch-errors-p* when invoking start-output. U trunk/thirdparty/hunchentoot/request.lisp Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2011-01-21 22:31:40 UTC (rev 4637) +++ trunk/thirdparty/hunchentoot/request.lisp 2011-01-22 06:51:03 UTC (rev 4638) @@ -234,7 +234,8 @@ ;; error occured in request handler (report-error-to-client error backtrace)) (handler-case - (start-output body) + (with-debugger + (start-output body)) (error (e) ;; error occured while writing to the client. attempt to report. (report-error-to-client e))))))

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 21 Jan '11

21 Jan '11

Revision: 4637 Author: hans URL: http://bknr.net/trac/changeset/4637 Improve error handling. Move code around in START-OUTPUT so that if content has been supplied, it is first converted to binary if necessary before anything is written to the client. Move error logging up to process-request. If START-OUTPUT fails, try logging and sending error information back to the client. U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/request.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2011-01-21 22:13:30 UTC (rev 4636) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2011-01-21 22:31:40 UTC (rev 4637) @@ -437,11 +437,6 @@ handler." (handler-bind ((error (lambda (cond) - (when *log-lisp-errors-p* - (log-message *lisp-errors-log-level* - "~A~@[~%~A~]" - cond - (and *log-lisp-backtraces-p* (get-backtrace)))) ;; if the headers were already sent, the error ;; happened within the body and we have to close ;; the stream Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2011-01-21 22:13:30 UTC (rev 4636) +++ trunk/thirdparty/hunchentoot/headers.lisp 2011-01-21 22:31:40 UTC (rev 4637) @@ -70,22 +70,15 @@ (:method (key value) (write-header-line key (princ-to-string value)))) -(defun start-output (&key (content nil content-provided-p) - (request *request*)) +(defun start-output (&optional (content nil content-provided-p)) "Sends all headers and maybe the content body to *HUNCHENTOOT-STREAM*. Returns immediately and does nothing if called more than once per request. Handles the supported return codes accordingly. Called by PROCESS-REQUEST and/or SEND-HEADERS. Returns the stream to write to." - ;; send headers only once - (when *headers-sent* - (return-from start-output)) - (setq *headers-sent* t) - ;; Read post data to clear stream - Force binary mode to avoid OCTETS-TO-STRING overhead. - (raw-post-data :force-binary t) (let* ((return-code (return-code*)) (chunkedp (and (acceptor-output-chunking-p *acceptor*) - (eq (server-protocol request) :http/1.1) + (eq (server-protocol *request*) :http/1.1) ;; only turn chunking on if the content ;; length is unknown at this point... (null (or (content-length*) content-provided-p)) @@ -94,11 +87,11 @@ ;; own content (member return-code *approved-return-codes*))) (reason-phrase (reason-phrase return-code)) - (request-method (request-method request)) + (request-method (request-method *request*)) (head-request-p (eq request-method :head)) content-modified-p) (multiple-value-bind (keep-alive-p keep-alive-requested-p) - (keep-alive-p request) + (keep-alive-p *request*) (when keep-alive-p (setq keep-alive-p ;; use keep-alive if there's a way for the client to @@ -115,7 +108,7 @@ (cond (keep-alive-p (setf *close-hunchentoot-stream* nil) (when (and (acceptor-read-timeout *acceptor*) - (or (not (eq (server-protocol request) :http/1.1)) + (or (not (eq (server-protocol *request*) :http/1.1)) keep-alive-requested-p)) ;; persistent connections are implicitly assumed for ;; HTTP/1.1, but we return a 'Keep-Alive' header if the @@ -162,20 +155,14 @@ "The server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials \(e.g., bad password), or your browser doesn't understand how to supply the credentials required.") ((#.+http-forbidden+) (format nil "You don't have permission to access ~A on this server." - (escape-for-html (script-name request)))) + (escape-for-html (script-name *request*)))) ((#.+http-not-found+) (format nil "The requested URL ~A was not found on this server." - (escape-for-html (script-name request)))) + (escape-for-html (script-name *request*)))) ((#.+http-bad-request+) "Your browser sent a request that this server could not understand.") (otherwise "")) (address-string)))))) - ;; start with status line - (let ((first-line - (format nil "HTTP/1.1 ~D ~A" return-code reason-phrase))) - (write-sequence (map 'list #'char-code first-line) *hunchentoot-stream*) - (write-sequence +crlf+ *hunchentoot-stream*) - (maybe-write-to-header-stream first-line)) (when (and (stringp content) (not content-modified-p) (starts-with-one-of-p (or (content-type*) "") @@ -192,6 +179,18 @@ ;; the Content-Length header properly; maybe the user specified ;; a different content length, but that will wrong anyway (setf (header-out :content-length) (length content))) + ;; send headers only once + (when *headers-sent* + (return-from start-output)) + (setq *headers-sent* t) + ;; Read post data to clear stream - Force binary mode to avoid OCTETS-TO-STRING overhead. + (raw-post-data :force-binary t) + ;; start with status line + (let ((first-line + (format nil "HTTP/1.1 ~D ~A" return-code reason-phrase))) + (write-sequence (map 'list #'char-code first-line) *hunchentoot-stream*) + (write-sequence +crlf+ *hunchentoot-stream*) + (maybe-write-to-header-stream first-line)) ;; write all headers from the REPLY object (loop for (key . value) in (headers-out*) when value Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2011-01-21 22:13:30 UTC (rev 4636) +++ trunk/thirdparty/hunchentoot/request.lisp 2011-01-21 22:31:40 UTC (rev 4637) @@ -212,26 +212,32 @@ "Standard implementation for processing a request. You should not change or replace this functionality unless you know what you're doing." - (let (*tmp-files* *headers-sent*) + (let (*tmp-files* + *headers-sent* + (*request* request)) (unwind-protect - (with-mapped-conditions () - (let* ((*request* request)) - (multiple-value-bind (body error backtrace) - ;; skip dispatch if bad request - (when (eql (return-code *reply*) +http-ok+) - (catch 'handler-done - (handle-request *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~@[~%~%Backtrace:~A~]</pre>" - (escape-for-html (format nil "~A" error)) - (when *show-lisp-backtraces-p* - (escape-for-html (format nil "~A" backtrace))))) - (error - "An error has occured.") - (t body)))))) + (with-mapped-conditions () + (labels + ((report-error-to-client (error &optional backtrace) + (setf (return-code *reply*) +http-internal-server-error+) + (when *log-lisp-errors-p* + (log-message *lisp-errors-log-level* "~A~@[~%~A~]" error backtrace)) + (start-output (if *show-lisp-errors-p* + (format nil "<pre>~A</pre>" (escape-for-html (format nil "~A" error))) + "An error has occured") ))) + (multiple-value-bind (body error backtrace) + ;; skip dispatch if bad request + (when (eql (return-code *reply*) +http-ok+) + (catch 'handler-done + (handle-request *acceptor* *request*))) + (when error + ;; error occured in request handler + (report-error-to-client error backtrace)) + (handler-case + (start-output body) + (error (e) + ;; error occured while writing to the client. attempt to report. + (report-error-to-client e)))))) (dolist (path *tmp-files*) (when (and (pathnamep path) (probe-file path)) ;; the handler may have chosen to (re)move the uploaded

1 0

[bknr-cvs] hans changed branches/hunchentoot-1.1.1/
by BKNR Commits 21 Jan '11

21 Jan '11

Revision: 4636 Author: hans URL: http://bknr.net/trac/changeset/4636 scrap that D branches/hunchentoot-1.1.1/

1 0

[bknr-cvs] hans changed branches/hunchentoot-1.1.1/
by BKNR Commits 21 Jan '11

21 Jan '11

Revision: 4635 Author: hans URL: http://bknr.net/trac/changeset/4635 temp branch A branches/hunchentoot-1.1.1/

1 0