hunchentoot-1.2.35/0000755000004100000410000000000012656661410014177 5ustar www-datawww-datahunchentoot-1.2.35/set-timeouts.lisp0000644000004100000410000000706212656661410017537 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defun set-timeouts (usocket read-timeout write-timeout) "Sets up timeouts on the given USOCKET object. READ-TIMEOUT is the read timeout period, WRITE-TIMEOUT is the write timeout, specified in \(fractional) seconds. The timeouts can either be implemented using the low-level socket options SO_RCVTIMEO and SO_SNDTIMEO or some other, implementation specific mechanism. On platforms that do not support separate read and write timeouts, both must be equal or an error will be signaled. READ-TIMEOUT and WRITE-TIMEOUT may be NIL, which means that the corresponding socket timeout value will not be set." (declare (ignorable usocket read-timeout write-timeout)) ;; add other Lisps here if necessary #+(or :sbcl :cmu :abcl) (unless (eql read-timeout write-timeout) (parameter-error "Read and write timeouts for socket must be equal.")) #+:clisp (when read-timeout (socket:socket-options (usocket:socket usocket) :SO-RCVTIMEO read-timeout)) #+:clisp (when write-timeout (socket:socket-options (usocket:socket usocket) :SO-SNDTIMEO write-timeout)) #+:ecl (when read-timeout (setf (sb-bsd-sockets:sockopt-receive-timeout (usocket:socket usocket)) read-timeout)) #+:ecl (when write-timeout (setf (sb-bsd-sockets:sockopt-send-timeout (usocket:socket usocket)) write-timeout)) #+:openmcl (when read-timeout (setf (ccl:stream-input-timeout (usocket:socket usocket)) read-timeout)) #+:openmcl (when write-timeout (setf (ccl:stream-output-timeout (usocket:socket usocket)) write-timeout)) #+:sbcl (when read-timeout (setf (sb-impl::fd-stream-timeout (usocket:socket-stream usocket)) (coerce read-timeout 'single-float))) #+:cmu (setf (lisp::fd-stream-timeout (usocket:socket-stream usocket)) (coerce read-timeout 'integer)) #+:abcl (when read-timeout (java:jcall (java:jmethod "java.net.Socket" "setSoTimeout" "int") (usocket:socket usocket) (* 1000 read-timeout))) #+:abcl (when write-timeout (warn "Unimplemented.")) #-(or :clisp :allegro :openmcl :sbcl :lispworks :cmu :ecl :abcl) (not-implemented 'set-timeouts)) hunchentoot-1.2.35/cookie.lisp0000644000004100000410000001226312656661410016345 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defclass cookie () ((name :initarg :name :reader cookie-name :type string :documentation "The name of the cookie - a string.") (value :initarg :value :accessor cookie-value :initform "" :documentation "The value of the cookie. Will be URL-encoded when sent to the browser.") (expires :initarg :expires :initform nil :accessor cookie-expires :documentation "The time \(a universal time) when the cookie expires \(or NIL).") (max-age :initarg :max-age :initform nil :accessor cookie-max-age :documentation "The time delta \(in seconds) after which the cookie expires \(or NIL).") (path :initarg :path :initform nil :accessor cookie-path :documentation "The path this cookie is valid for \(or NIL).") (domain :initarg :domain :initform nil :accessor cookie-domain :documentation "The domain this cookie is valid for \(or NIL).") (secure :initarg :secure :initform nil :accessor cookie-secure :documentation "A generalized boolean denoting whether this cookie is a secure cookie.") (http-only :initarg :http-only :initform nil :accessor cookie-http-only :documentation "A generalized boolean denoting whether this cookie is a `HttpOnly' cookie. This is a Microsoft extension that has been implemented in Firefox as well. See .")) (:documentation "Each COOKIE objects describes one outgoing cookie.")) (defmethod initialize-instance :around ((cookie cookie) &rest init-args) "Ensure COOKIE has a correct slot-value for NAME." (let ((name (getf init-args :name))) (unless (http-token-p name) (parameter-error "~S is not a legal name for a cookie." name))) (call-next-method)) (defun set-cookie* (cookie &optional (reply *reply*)) "Adds the COOKIE object COOKIE to the outgoing cookies of the REPLY object REPLY. If a cookie with the same name \(case-sensitive) already exists, it is replaced." (let* ((name (cookie-name cookie)) (place (assoc name (cookies-out reply) :test #'string=))) (cond (place (setf (cdr place) cookie)) (t (push (cons name cookie) (cookies-out reply)) cookie)))) (defun set-cookie (name &key (value "") expires max-age path domain secure http-only (reply *reply*)) "Creates a cookie object from the parameters provided and adds it to the outgoing cookies of the REPLY object REPLY. If a cookie with the name NAME \(case-sensitive) already exists, it is replaced." (set-cookie* (make-instance 'cookie :name name :value value :expires expires :max-age max-age :path path :domain domain :secure secure :http-only http-only) reply)) (defun cookie-date (universal-time) "Converts UNIVERSAL-TIME to cookie date format." (and universal-time (rfc-1123-date universal-time))) (defmethod stringify-cookie ((cookie cookie)) "Converts the COOKIE object COOKIE to a string suitable for a 'Set-Cookie' header to be sent to the client." (format nil "~A=~A~@[; Expires=~A~]~@[; Max-Age=~A~]~@[; Domain=~A~]~@[; Path=~A~]~:[~;; Secure~]~:[~;; HttpOnly~]" (cookie-name cookie) (cookie-value cookie) (cookie-date (cookie-expires cookie)) (cookie-max-age cookie) (cookie-domain cookie) (cookie-path cookie) (cookie-secure cookie) (cookie-http-only cookie))) hunchentoot-1.2.35/specials.lisp0000644000004100000410000003303412656661410016676 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defmacro defconstant (name value &optional doc) "Make sure VALUE is evaluated only once \(to appease SBCL)." `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) ,@(when doc (list doc)))) (eval-when (:compile-toplevel :execute :load-toplevel) (defmacro defvar-unbound (name &optional (doc-string "")) "Convenience macro to declare unbound special variables with a documentation string." `(progn (defvar ,name) (setf (documentation ',name 'variable) ,doc-string) ',name)) (defvar *http-reason-phrase-map* (make-hash-table) "Used to map numerical return codes to reason phrases.") (defmacro def-http-return-code (name value reason-phrase) "Shortcut to define constants for return codes. NAME is a Lisp symbol, VALUE is the numerical value of the return code, and REASON-PHRASE is the phrase \(a string) to be shown in the server's status line." `(eval-when (:compile-toplevel :execute :load-toplevel) (defconstant ,name ,value ,(format nil "HTTP return code \(~A) for '~A'." value reason-phrase)) (setf (gethash ,value *http-reason-phrase-map*) ,reason-phrase)))) (defconstant +crlf+ (make-array 2 :element-type '(unsigned-byte 8) :initial-contents (mapcar 'char-code '(#\Return #\Linefeed))) "A 2-element array consisting of the character codes for a CRLF sequence.") (def-http-return-code +http-continue+ 100 "Continue") (def-http-return-code +http-switching-protocols+ 101 "Switching Protocols") (def-http-return-code +http-ok+ 200 "OK") (def-http-return-code +http-created+ 201 "Created") (def-http-return-code +http-accepted+ 202 "Accepted") (def-http-return-code +http-non-authoritative-information+ 203 "Non-Authoritative Information") (def-http-return-code +http-no-content+ 204 "No Content") (def-http-return-code +http-reset-content+ 205 "Reset Content") (def-http-return-code +http-partial-content+ 206 "Partial Content") (def-http-return-code +http-multi-status+ 207 "Multi-Status") (def-http-return-code +http-multiple-choices+ 300 "Multiple Choices") (def-http-return-code +http-moved-permanently+ 301 "Moved Permanently") (def-http-return-code +http-moved-temporarily+ 302 "Moved Temporarily") (def-http-return-code +http-see-other+ 303 "See Other") (def-http-return-code +http-not-modified+ 304 "Not Modified") (def-http-return-code +http-use-proxy+ 305 "Use Proxy") (def-http-return-code +http-temporary-redirect+ 307 "Temporary Redirect") (def-http-return-code +http-bad-request+ 400 "Bad Request") (def-http-return-code +http-authorization-required+ 401 "Authorization Required") (def-http-return-code +http-payment-required+ 402 "Payment Required") (def-http-return-code +http-forbidden+ 403 "Forbidden") (def-http-return-code +http-not-found+ 404 "Not Found") (def-http-return-code +http-method-not-allowed+ 405 "Method Not Allowed") (def-http-return-code +http-not-acceptable+ 406 "Not Acceptable") (def-http-return-code +http-proxy-authentication-required+ 407 "Proxy Authentication Required") (def-http-return-code +http-request-time-out+ 408 "Request Time-out") (def-http-return-code +http-conflict+ 409 "Conflict") (def-http-return-code +http-gone+ 410 "Gone") (def-http-return-code +http-length-required+ 411 "Length Required") (def-http-return-code +http-precondition-failed+ 412 "Precondition Failed") (def-http-return-code +http-request-entity-too-large+ 413 "Request Entity Too Large") (def-http-return-code +http-request-uri-too-large+ 414 "Request-URI Too Large") (def-http-return-code +http-unsupported-media-type+ 415 "Unsupported Media Type") (def-http-return-code +http-requested-range-not-satisfiable+ 416 "Requested range not satisfiable") (def-http-return-code +http-expectation-failed+ 417 "Expectation Failed") (def-http-return-code +http-failed-dependency+ 424 "Failed Dependency") (def-http-return-code +http-precondition-required+ 428 "Precondition Required") (def-http-return-code +http-too-many-requests+ 429 "Too Many Requests") (def-http-return-code +http-request-header-fields-too-large+ 431 "Request Header Fields Too Large") (def-http-return-code +http-internal-server-error+ 500 "Internal Server Error") (def-http-return-code +http-not-implemented+ 501 "Not Implemented") (def-http-return-code +http-bad-gateway+ 502 "Bad Gateway") (def-http-return-code +http-service-unavailable+ 503 "Service Unavailable") (def-http-return-code +http-gateway-time-out+ 504 "Gateway Time-out") (def-http-return-code +http-version-not-supported+ 505 "Version not supported") (def-http-return-code +http-network-authentication-required+ 511 "Network Authentication Required") (defconstant +day-names+ #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") "The three-character names of the seven days of the week - needed for cookie date format.") (defconstant +month-names+ #("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") "The three-character names of the twelve months - needed for cookie date format.") (defvar *rewrite-for-session-urls* t "Whether HTML pages should possibly be rewritten for cookie-less session-management.") (defvar *content-types-for-url-rewrite* '("text/html" "application/xhtml+xml") "The content types for which url-rewriting is OK. See *REWRITE-FOR-SESSION-URLS*.") (defvar *the-random-state* (make-random-state t) "A fresh random state.") (defvar-unbound *session-secret* "A random ASCII string that's used to encode the public session data. This variable is initially unbound and will be set \(using RESET-SESSION-SECRET) the first time a session is created, if necessary. You can prevent this from happening if you set the value yourself before starting acceptors.") (defvar-unbound *hunchentoot-stream* "The stream representing the socket Hunchentoot is listening on.") (defvar-unbound *finish-processing-socket* "Will be set to T if PROCESS-CONNECTION is to stop processing more requests on the current socket connection.") (defvar-unbound *close-hunchentoot-stream* "This variable is set to NIL during the processing of a handler to tell the acceptor not to close the connection after it is done.") (defvar *headers-sent* nil "Used internally to check whether the reply headers have already been sent for this request.") (defvar *file-upload-hook* nil "If this is not NIL, it should be a unary function which will be called with a pathname for each file which is uploaded to Hunchentoot. The pathname denotes the temporary file to which the uploaded file is written. The hook is called directly before the file is created.") (defvar *session-db* nil "The default \(global) session database.") (defvar *session-max-time* #.(* 30 60) "The default time \(in seconds) after which a session times out.") (defvar *session-gc-frequency* 50 "A session GC \(see function SESSION-GC) will happen every *SESSION-GC-FREQUENCY* requests \(counting only requests which create a new session) if this variable is not NIL. See SESSION-CREATED.") (defvar *use-user-agent-for-sessions* t "Whether the 'User-Agent' header should be encoded into the session string. If this value is true, a session will cease to be accessible if the client sends a different 'User-Agent' header.") (defvar *use-remote-addr-for-sessions* nil "Whether the client's remote IP \(as returned by REAL-REMOTE-ADDR) should be encoded into the session string. If this value is true, a session will cease to be accessible if the client's remote IP changes. This might for example be an issue if the client uses a proxy server which doesn't send correct 'X_FORWARDED_FOR' headers.") (defvar *default-content-type* "text/html" "The default content-type header which is returned to the client. If this is text content type, the character set used for encoding the response will automatically be added to the content type in a ``charset'' attribute.") (defvar *methods-for-post-parameters* '(:post) "A list of the request method types \(as keywords) for which Hunchentoot will try to compute POST-PARAMETERS.") (defvar *header-stream* nil "If this variable is not NIL, it should be bound to a stream to which incoming and outgoing headers will be written for debugging purposes.") (defvar *show-lisp-errors-p* nil "Whether Lisp errors in request handlers should be shown in HTML output.") (defvar *show-lisp-backtraces-p* t "Whether Lisp errors shown in HTML output should contain backtrace information.") (defvar *log-lisp-errors-p* t "Whether Lisp errors in request handlers should be logged.") (defvar *log-lisp-backtraces-p* t "Whether Lisp backtraces should be logged. Only has an effect if *LOG-LISP-ERRORS-P* is true as well.") (defvar *log-lisp-warnings-p* t "Whether Lisp warnings in request handlers should be logged.") (defvar *lisp-errors-log-level* :error "Log level for Lisp errors. Should be one of :ERROR \(the default), :WARNING, or :INFO.") (defvar *lisp-warnings-log-level* :warning "Log level for Lisp warnings. Should be one of :ERROR, :WARNING \(the default), or :INFO.") (defvar *message-log-lock* (make-lock "global-message-log-lock") "A global lock to prevent concurrent access to the log file used by the ACCEPTOR-LOG-MESSAGE function.") (defvar *access-log-lock* (make-lock "global-access-log-lock") "A global lock to prevent concurrent access to the log file used by the ACCEPTOR-LOG-ACCESS function.") (defvar *catch-errors-p* t "Whether Hunchentoot should catch and log errors \(or rather invoke the debugger).") (defvar-unbound *acceptor* "The current ACCEPTOR object while in the context of a request.") (defvar-unbound *request* "The current REQUEST object while in the context of a request.") (defvar-unbound *reply* "The current REPLY object while in the context of a request.") (defvar-unbound *session* "The current session while in the context of a request, or NIL.") (defconstant +implementation-link+ #+:cmu "http://www.cons.org/cmucl/" #+:sbcl "http://www.sbcl.org/" #+:allegro "http://www.franz.com/products/allegrocl/" #+:lispworks "http://www.lispworks.com/" #+:openmcl "http://openmcl.clozure.com/" "A link to the website of the underlying Lisp implementation.") (defvar *tmp-directory* #+(or :win32 :mswindows) "c:\\hunchentoot-temp\\" #-(or :win32 :mswindows) "/tmp/hunchentoot/" "Directory for temporary files created by MAKE-TMP-FILE-NAME.") (defvar *tmp-files* nil "A list of temporary files created while a request was handled.") (defconstant +latin-1+ (make-external-format :latin1 :eol-style :lf) "A FLEXI-STREAMS external format used for `faithful' input and output of binary data.") (defconstant +utf-8+ (make-external-format :utf8 :eol-style :lf) "A FLEXI-STREAMS external format used internally for logging and to encode cookie values.") (defvar *hunchentoot-default-external-format* +utf-8+ "The external format used to compute the REQUEST object.") (defconstant +buffer-length+ 8192 "Length of buffers used for internal purposes.") (defvar *default-connection-timeout* 20 "The default connection timeout used when an acceptor is reading from and writing to a socket stream.") (eval-when (:compile-toplevel :load-toplevel :execute) (define-symbol-macro *supports-threads-p* #+:lispworks t #-:lispworks bt:*supports-threads-p*)) (defvar *global-session-db-lock* (load-time-value (and *supports-threads-p* (make-lock "global-session-db-lock"))) "A global lock to prevent two threads from modifying *session-db* at the same time \(or NIL for Lisps which don't have threads).") #-:lispworks (defconstant +new-connection-wait-time+ 2 "Time in seconds to wait for a new connection to arrive before performing a cleanup run.") (pushnew :hunchentoot *features*) ;; stuff for Nikodemus Siivola's HYPERDOC ;; see ;; and (defvar *hyperdoc-base-uri* "http://weitz.de/hunchentoot/") (let ((exported-symbols-alist (loop for symbol being the external-symbols of :hunchentoot collect (cons symbol (concatenate 'string "#" (string-downcase symbol)))))) (defun hyperdoc-lookup (symbol type) (declare (ignore type)) (cdr (assoc symbol exported-symbols-alist :test #'eq)))) (defparameter hunchentoot:*hunchentoot-version* #.(asdf:component-version (asdf:find-system :hunchentoot))) hunchentoot-1.2.35/compat.lisp0000644000004100000410000001347312656661410016363 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defmacro when-let ((var form) &body body) "Evaluates FORM and binds VAR to the result, then executes BODY if VAR has a true value." `(let ((,var ,form)) (when ,var ,@body))) (defmacro with-unique-names ((&rest bindings) &body body) "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form* Executes a series of forms with each VAR bound to a fresh, uninterned symbol. The uninterned symbol is as if returned by a call to GENSYM with the string denoted by X - or, if X is not supplied, the string denoted by VAR - as argument. The variable bindings created are lexical unless special declarations are specified. The scopes of the name bindings and declarations do not include the Xs. The forms are evaluated in order, and the values of all but the last are discarded \(that is, the body is an implicit PROGN)." ;; reference implementation posted to comp.lang.lisp as ;; by Vebjorn Ljosa - see also ;; `(let ,(mapcar #'(lambda (binding) (check-type binding (or cons symbol)) (if (consp binding) (destructuring-bind (var x) binding (check-type var symbol) `(,var (gensym ,(etypecase x (symbol (symbol-name x)) (character (string x)) (string x))))) `(,binding (gensym ,(symbol-name binding))))) bindings) ,@body)) (defmacro with-rebinding (bindings &body body) "Syntax: WITH-REBINDING ( { var | (var prefix) }* ) form* Evaluates a series of forms in the lexical environment that is formed by adding the binding of each VAR to a fresh, uninterned symbol, and the binding of that fresh, uninterned symbol to VAR's original value, i.e., its value in the current lexical environment. The uninterned symbol is created as if by a call to GENSYM with the string denoted by PREFIX - or, if PREFIX is not supplied, the string denoted by VAR - as argument. The forms are evaluated in order, and the values of all but the last are discarded \(that is, the body is an implicit PROGN)." ;; reference implementation posted to comp.lang.lisp as ;; by Vebjorn Ljosa - see also ;; (loop for binding in bindings for var = (if (consp binding) (car binding) binding) for name = (gensym) collect `(,name ,var) into renames collect ``(,,var ,,name) into temps finally (return `(let ,renames (with-unique-names ,bindings `(let (,,@temps) ,,@body)))))) (defun get-peer-address-and-port (socket) "Returns the peer address and port of the socket SOCKET as two values. The address is returned as a string in dotted IP address notation." (multiple-value-bind (address port) (usocket:get-peer-name socket) (values (ecase (length address) (4 (usocket:vector-quad-to-dotted-quad address)) #+(or) (16 (usocket:vector-to-ipv6-host address))) port))) (defun get-local-address-and-port (socket) "Returns the local address and port of the socket SOCKET as two values. The address is returned as a string in dotted IP address notation." (multiple-value-bind (address port) (usocket:get-local-name socket) (values (ecase (length address) (4 (usocket:vector-quad-to-dotted-quad address)) #+(or) (16 (usocket:vector-to-ipv6-host address))) port))) (defun make-socket-stream (socket acceptor) "Returns a stream for the socket SOCKET. The ACCEPTOR argument is ignored." (declare (ignore acceptor)) (usocket:socket-stream socket)) (defun make-lock (name) "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." (bt:make-lock name)) (defmacro with-lock-held ((lock) &body body) "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist." `(bt:with-lock-held (,lock) ,@body)) (defun make-condition-variable (&key name) (declare (ignore name)) (bt:make-condition-variable)) (defun condition-variable-signal (condition-variable) (bt:condition-notify condition-variable)) (defun condition-variable-wait (condition-variable lock) (bt:condition-wait condition-variable lock)) hunchentoot-1.2.35/misc.lisp0000644000004100000410000003150412656661410016026 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (let ((scanner-hash (make-hash-table :test #'equal))) (defun scanner-for-get-param (param-name) "Returns a CL-PPCRE scanner which matches a GET parameter in a URL. Scanners are memoized in SCANNER-HASH once they are created." (or (gethash param-name scanner-hash) (setf (gethash param-name scanner-hash) (create-scanner `(:alternation ;; session=value at end of URL (:sequence (:char-class #\? #\&) ,param-name #\= (:greedy-repetition 0 nil (:inverted-char-class #\&)) :end-anchor) ;; session=value with other parameters following (:sequence (:register (:char-class #\? #\&)) ,param-name #\= (:greedy-repetition 0 nil (:inverted-char-class #\&)) #\&)))))) (defun add-cookie-value-to-url (url &key (cookie-name (session-cookie-name *acceptor*)) (value (when-let (session (session *request*)) (session-cookie-value session))) (replace-ampersands-p t)) "Removes all GET parameters named COOKIE-NAME from URL and then adds a new GET parameter with the name COOKIE-NAME and the value VALUE. If REPLACE-AMPERSANDS-P is true all literal ampersands in URL are replaced with '&'. The resulting URL is returned." (unless url ;; see URL-REWRITE:*URL-REWRITE-FILL-TAGS* (setq url (request-uri *request*))) (setq url (regex-replace-all (scanner-for-get-param cookie-name) url "\\1")) (when value (setq url (format nil "~A~:[?~;&~]~A=~A" url (find #\? url) cookie-name (url-encode value)))) (when replace-ampersands-p (setq url (regex-replace-all "&" url "&"))) url)) (defun maybe-rewrite-urls-for-session (html &key (cookie-name (session-cookie-name *acceptor*)) (value (when-let (session (session *request*)) (session-cookie-value session)))) "Rewrites the HTML page HTML such that the name/value pair COOKIE-NAME/COOKIE-VALUE is inserted if the client hasn't sent a cookie of the same name but only if *REWRITE-FOR-SESSION-URLS* is true. See the docs for URL-REWRITE:REWRITE-URLS." (cond ((or (not *rewrite-for-session-urls*) (null value) (cookie-in cookie-name)) html) (t (with-input-from-string (*standard-input* html) (with-output-to-string (*standard-output*) (url-rewrite:rewrite-urls (lambda (url) (add-cookie-value-to-url url :cookie-name cookie-name :value value)))))))) (defun create-prefix-dispatcher (prefix handler) "Creates a request dispatch function which will dispatch to the function denoted by HANDLER if the file name of the current request starts with the string PREFIX." (lambda (request) (let ((mismatch (mismatch (script-name request) prefix :test #'char=))) (and (or (null mismatch) (>= mismatch (length prefix))) handler)))) (defun create-regex-dispatcher (regex handler) "Creates a request dispatch function which will dispatch to the function denoted by HANDLER if the file name of the current request matches the CL-PPCRE regular expression REGEX." (let ((scanner (create-scanner regex))) (lambda (request) (and (scan scanner (script-name request)) handler)))) (defun abort-request-handler (&optional result) "This function can be called by a request handler at any time to immediately abort handling the request. This works as if the handler had returned RESULT. See the source code of REDIRECT for an example." (throw 'handler-done result)) (defun maybe-handle-range-header (file) "Helper function for handle-static-file. Determines whether the requests specifies a Range header. If so, parses the header and position the already opened file to the location specified. Returns the number of bytes to transfer from the file. Invalid specified ranges are reported to the client with a HTTP 416 status code." (let ((bytes-to-send (file-length file))) (cl-ppcre:register-groups-bind (start end) ("^bytes=(\\d+)-(\\d*)$" (header-in* :range) :sharedp t) ;; body won't be executed if regular expression does not match (setf start (parse-integer start)) (setf end (if (> (length end) 0) (parse-integer end) (1- (file-length file)))) (when (or (< start 0) (>= end (file-length file))) (setf (return-code*) +http-requested-range-not-satisfiable+ (header-out :content-range) (format nil "bytes 0-~D/~D" (1- (file-length file)) (file-length file))) (throw 'handler-done (format nil "invalid request range (requested ~D-~D, accepted 0-~D)" start end (1- (file-length file))))) (file-position file start) (setf (return-code*) +http-partial-content+ bytes-to-send (1+ (- end start)) (header-out :content-range) (format nil "bytes ~D-~D/~D" start end (file-length file)))) bytes-to-send)) (defun handle-static-file (pathname &optional content-type) "A function which acts like a Hunchentoot handler for the file 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 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)) (unless content-type (setf content-type (mime-type pathname))) (let ((time (or (file-write-date pathname) (get-universal-time))) bytes-to-send) (setf (content-type*) (or (and content-type (maybe-add-charset-to-content-type-header content-type (reply-external-format*))) "application/octet-stream") (header-out :last-modified) (rfc-1123-date time) (header-out :accept-ranges) "bytes") (handle-if-modified-since time) (with-open-file (file pathname :direction :input :element-type 'octet) (setf bytes-to-send (maybe-handle-range-header file) (content-length*) bytes-to-send) (let ((out (send-headers)) (buf (make-array +buffer-length+ :element-type 'octet))) (loop (when (zerop bytes-to-send) (return)) (let* ((chunk-size (min +buffer-length+ bytes-to-send))) (unless (eql chunk-size (read-sequence buf file :end chunk-size)) (error "can't read from input file")) (write-sequence buf out :end chunk-size) (decf bytes-to-send chunk-size))) (finish-output out))))) (defun create-static-file-dispatcher-and-handler (uri path &optional content-type) "Creates and returns a request dispatch function which will dispatch to a handler function which emits the file denoted by the pathname designator PATH with content type CONTENT-TYPE if the SCRIPT-NAME of the request matches the string URI. If CONTENT-TYPE is NIL, tries to determine the content type via the file's suffix." ;; the dispatcher (lambda (request) (when (string= (script-name request) uri) ;; the handler (lambda () (handle-static-file path content-type))))) (defun create-folder-dispatcher-and-handler (uri-prefix base-path &optional content-type) "Creates and returns a dispatch function which will dispatch to a handler function which emits the file relative to BASE-PATH that is denoted by the URI of the request relative to URI-PREFIX. URI-PREFIX must be a string ending with a slash, BASE-PATH must be a pathname designator for an existing directory. If CONTENT-TYPE is not NIL, it'll be the content type used for all files in the folder." (unless (and (stringp uri-prefix) (plusp (length uri-prefix)) (char= (char uri-prefix (1- (length uri-prefix))) #\/)) (parameter-error "~S must be string ending with a slash." uri-prefix)) (unless (fad:directory-pathname-p base-path) (parameter-error "~S is supposed to denote a directory." base-path)) (flet ((handler () (let ((request-path (request-pathname *request* uri-prefix))) (when (null request-path) (setf (return-code*) +http-forbidden+) (abort-request-handler)) (handle-static-file (merge-pathnames request-path base-path) content-type)))) (create-prefix-dispatcher uri-prefix #'handler))) (defun no-cache () "Adds appropriate headers to completely prevent caching on most browsers." (setf (header-out :expires) "Mon, 26 Jul 1997 05:00:00 GMT" (header-out :cache-control) "no-store, no-cache, must-revalidate, post-check=0, pre-check=0" (header-out :pragma) "no-cache" (header-out :last-modified) (rfc-1123-date)) (values)) (defun redirect (target &key (host (host *request*) host-provided-p) port (protocol (if (ssl-p) :https :http)) (add-session-id (not (or host-provided-p (starts-with-scheme-p target) (cookie-in (session-cookie-name *acceptor*))))) (code +http-moved-temporarily+)) "Redirects the browser to TARGET which should be a string. If TARGET is a full URL starting with a scheme, HOST, PORT and PROTOCOL are ignored. Otherwise, TARGET should denote the path part of a URL, PROTOCOL must be one of the keywords :HTTP or :HTTPS, and the URL to redirect to will be constructed from HOST, PORT, PROTOCOL, and TARGET. Adds a session ID if ADD-SESSION-ID is true. If CODE is a 3xx redirection code, it will be sent as status code." (check-type code (integer 300 399)) (let ((url (if (starts-with-scheme-p target) target (format nil "~A://~A~@[:~A~]~A" (ecase protocol ((:http) "http") ((:https) "https")) (if port (first (ppcre:split ":" (or host ""))) host) port target)))) (when add-session-id (setq url (add-cookie-value-to-url url :replace-ampersands-p nil))) (setf (header-out :location) url (return-code*) code) (abort-request-handler))) (defun require-authorization (&optional (realm "Hunchentoot")) "Sends back appropriate headers to require basic HTTP authentication \(see RFC 2617) for the realm REALM." (setf (header-out :www-authenticate) (format nil "Basic realm=\"~A\"" (quote-string realm)) (return-code *reply*) +http-authorization-required+) (abort-request-handler)) hunchentoot-1.2.35/acceptor.lisp0000644000004100000410000011300712656661410016672 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (eval-when (:load-toplevel :compile-toplevel :execute) (defun default-document-directory (&optional sub-directory) (let ((source-directory #.(or *compile-file-truename* *load-truename*))) (merge-pathnames (make-pathname :directory (append (pathname-directory source-directory) (list "www") (when sub-directory (list sub-directory))) :name nil :type nil :defaults source-directory))))) (defclass acceptor () ((port :initarg :port :reader acceptor-port :documentation "The port the acceptor is listening on. The default is 80. Note that depending on your operating system you might need special privileges to listen on port 80.") (address :initarg :address :reader acceptor-address :documentation "The address the acceptor is listening on. If address is a string denoting an IP address, then the server only receives connections for that address. This must be one of the addresses associated with the machine and allowed values are host names such as \"www.zappa.com\" and address strings such as \"72.3.247.29\". If address is NIL, then the server will receive connections to all IP addresses on the machine. This is the default.") (name :initarg :name :accessor acceptor-name :documentation "The optional name of the acceptor, a symbol. This name can be utilized when defining \"easy handlers\" - see DEFINE-EASY-HANDLER. The default name is an uninterned symbol as returned by GENSYM.") (request-class :initarg :request-class :accessor acceptor-request-class :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol naming) a class which inherits from REQUEST. The default is the symbol REQUEST.") (reply-class :initarg :reply-class :accessor acceptor-reply-class :documentation "Determines which class of reply 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.") (taskmaster :initarg :taskmaster :reader acceptor-taskmaster :documentation "The taskmaster \(i.e. an instance of a subclass of TASKMASTER) that is responsible for scheduling the work for this acceptor. The default depends on the MP capabilities of the underlying Lisp.") (output-chunking-p :initarg :output-chunking-p :accessor acceptor-output-chunking-p :documentation "A generalized boolean denoting whether the acceptor may use chunked encoding for output, i.e. when sending data to the client. The default is T and there's usually no reason to change this to NIL.") (input-chunking-p :initarg :input-chunking-p :accessor acceptor-input-chunking-p :documentation "A generalized boolean denoting whether the acceptor may use chunked encoding for input, i.e. when accepting request bodies from the client. The default is T and there's usually no reason to change this to NIL.") (persistent-connections-p :initarg :persistent-connections-p :accessor acceptor-persistent-connections-p :documentation "A generalized boolean denoting whether the acceptor supports persistent connections, which is the default for threaded acceptors. If this property is NIL, Hunchentoot closes each incoming connection after having processed one request. This is the default for non-threaded acceptors.") (read-timeout :initarg :read-timeout :reader acceptor-read-timeout :documentation "The read timeout of the acceptor, specified in \(fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts. NIL means no timeout.") (write-timeout :initarg :write-timeout :reader acceptor-write-timeout :documentation "The write timeout of the acceptor, specified in \(fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts. NIL means no timeout.") #+:lispworks (process :accessor acceptor-process :documentation "The Lisp process which accepts incoming requests. This is the process started by COMM:START-UP-SERVER and no matter what kind of taskmaster you are using this will always be a new process different from the one where START was called.") #-:lispworks (listen-socket :initform nil :accessor acceptor-listen-socket :documentation "The socket listening for incoming connections.") #-:lispworks (listen-backlog :initarg :listen-backlog :reader acceptor-listen-backlog :documentation "Number of pending connections allowed in the listen socket before the kernel rejects further incoming connections.") (acceptor-shutdown-p :initform t :accessor acceptor-shutdown-p :documentation "A flag that makes the acceptor shutdown itself when set to something other than NIL.") (requests-in-progress :initform 0 :accessor accessor-requests-in-progress :documentation "The number of requests currently in progress.") (shutdown-queue :initform (make-condition-variable) :accessor acceptor-shutdown-queue :documentation "A condition variable used with soft shutdown, signaled when all requests have been processed.") (shutdown-lock :initform (make-lock "hunchentoot-acceptor-shutdown") :accessor acceptor-shutdown-lock :documentation "The lock protecting the shutdown-queue condition variable and the requests-in-progress counter.") (access-log-destination :initarg :access-log-destination :accessor acceptor-access-log-destination :documentation "Destination of the access log which contains one log entry per request handled in a format similar to Apache's access.log. Can be set to a pathname or string designating the log file, to a open output stream or to NIL to suppress logging.") (message-log-destination :initarg :message-log-destination :accessor acceptor-message-log-destination :documentation "Destination of the server error log which is used to log informational, warning and error messages in a free-text format intended for human inspection. Can be set to a pathname or string designating the log file, to a open output stream or to NIL to suppress logging.") (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 .html with 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 :name (gensym) :request-class 'request :reply-class 'reply #-lispworks :listen-backlog #-lispworks 50 :taskmaster (make-instance (cond (*supports-threads-p* 'one-thread-per-connection-taskmaster) (t 'single-threaded-taskmaster))) :output-chunking-p t :input-chunking-p t :persistent-connections-p t :read-timeout *default-connection-timeout* :write-timeout *default-connection-timeout* :access-log-destination *error-output* :message-log-destination *error-output* :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 listen on the default http port 80. There are other initargs most of which you probably won't need very often. They are explained in detail in the docstrings of the slot definitions for this class. Unless you are in a Lisp without MP capabilities, you can have several active instances of ACCEPTOR \(listening on different ports) at the same time.")) (defmethod print-object ((acceptor acceptor) stream) (print-unreadable-object (acceptor stream :type t) (format stream "\(host ~A, port ~A)" (or (acceptor-address acceptor) "*") (acceptor-port acceptor)))) (defmethod initialize-instance :after ((acceptor acceptor) &key) (with-accessors ((document-root acceptor-document-root) (persistent-connections-p acceptor-persistent-connections-p) (taskmaster acceptor-taskmaster) (error-template-directory acceptor-error-template-directory)) acceptor (when (typep taskmaster 'single-threaded-taskmaster) (setf persistent-connections-p nil)) (when document-root (setf document-root (translate-logical-pathname document-root))) (when error-template-directory (setf error-template-directory (translate-logical-pathname error-template-directory))))) (defgeneric start (acceptor) (:documentation "Starts the ACCEPTOR so that it begins accepting connections. Returns the acceptor.")) (defgeneric stop (acceptor &key soft) (:documentation "Stops the ACCEPTOR so that it no longer accepts requests. If SOFT is true, and there are any requests in progress, wait until all requests are fully processed, but meanwhile do not accept new requests. Note that SOFT must not be set when calling STOP from within a request handler, as that will deadlock.")) (defgeneric started-p (acceptor) (:documentation "Tells if ACCEPTOR has been started. The default implementation simply queries ACCEPTOR for its listening status, so if T is returned to the calling thread, then some thread has called START or some thread's call to STOP hasn't finished. If NIL is returned either some thread has called STOP, or some thread's call to START hasn't finished or START was never called at all for ACCEPTOR.") (:method (acceptor) #-lispworks (and (acceptor-listen-socket acceptor) t) #+lispworks (not (acceptor-shutdown-p acceptor)))) (defgeneric start-listening (acceptor) (:documentation "Sets up a listen socket for the given ACCEPTOR and enables it to listen to incoming connections. This function is called from the thread that starts the acceptor initially and may return errors resulting from the listening operation \(like 'address in use' or similar).")) (defgeneric accept-connections (acceptor) (:documentation "In a loop, accepts a connection and hands it over to the acceptor's taskmaster for processing using HANDLE-INCOMING-CONNECTION. On LispWorks, this function returns immediately, on other Lisps it retusn only once the acceptor has been stopped.")) (defgeneric initialize-connection-stream (acceptor stream) (:documentation "Can be used to modify the stream which is used to communicate between client and server before the request is read. The default method of ACCEPTOR does nothing, but see for example the method defined for SSL-ACCEPTOR. All methods of this generic function must return the stream to use.")) (defgeneric reset-connection-stream (acceptor stream) (:documentation "Resets the stream which is used to communicate between client and server after one request has been served so that it can be used to process the next request. This generic function is called after a request has been processed and must return the stream.")) (defgeneric process-connection (acceptor socket) (:documentation "This function is called by the taskmaster when a new client connection has been established. Its arguments are the ACCEPTOR object and a LispWorks socket handle or a usocket socket stream object in SOCKET. It reads the request headers, sets up the request and reply objects, and hands over to PROCESS-REQUEST. This is done in a loop until the stream has to be closed or until a connection timeout occurs. It is probably not a good idea to re-implement this method until you really, really know what you're doing.")) (defgeneric handle-request (acceptor request) (:documentation "This function is called once the request has been read and a REQUEST object has been created. Its job is to set up standard error handling and request logging. Might be a good place for around methods specialized for your subclass of ACCEPTOR which bind or rebind special variables which can then be accessed by your handlers.")) (defgeneric acceptor-dispatch-request (acceptor request) (:documentation "This function is called to actually dispatch the request once the standard logging and error handling has been set up. ACCEPTOR subclasses implement methods for this function in order to perform their own request routing. If a method does not want to handle the request, it is supposed to invoke CALL-NEXT-METHOD so that the next ACCEPTOR in the inheritance chain gets a chance to handle the request.")) (defgeneric acceptor-ssl-p (acceptor) (:documentation "Returns a true value if ACCEPTOR uses SSL connections. The default is to unconditionally return NIL and subclasses of ACCEPTOR must specialize this method to signal that they're using secure connections - see the SSL-ACCEPTOR class.")) ;; general implementation (defmethod start ((acceptor acceptor)) (setf (acceptor-shutdown-p acceptor) nil) (start-listening acceptor) (let ((taskmaster (acceptor-taskmaster acceptor))) (setf (taskmaster-acceptor taskmaster) acceptor) (execute-acceptor taskmaster)) acceptor) (defmethod stop ((acceptor acceptor) &key soft) (setf (acceptor-shutdown-p acceptor) t) (when soft (with-lock-held ((acceptor-shutdown-lock acceptor)) (when (plusp (accessor-requests-in-progress acceptor)) (condition-variable-wait (acceptor-shutdown-queue acceptor) (acceptor-shutdown-lock acceptor))))) (shutdown (acceptor-taskmaster acceptor)) #-lispworks (usocket:socket-close (acceptor-listen-socket acceptor)) #-lispworks (setf (acceptor-listen-socket acceptor) nil) #+lispworks (mp:process-kill (acceptor-process acceptor)) acceptor) (defmethod initialize-connection-stream ((acceptor acceptor) stream) ;; default method does nothing stream) (defmethod reset-connection-stream ((acceptor acceptor) stream) ;; turn chunking off at this point (cond ((typep stream 'chunked-stream) ;; flush the stream first and check if there's unread input ;; which would be an error (setf (chunked-stream-output-chunking-p stream) nil (chunked-stream-input-chunking-p stream) nil) ;; switch back to bare socket stream (chunked-stream-stream stream)) (t stream))) (defmethod process-connection :around ((*acceptor* acceptor) (socket t)) ;; this around method is used for error handling ;; note that this method also binds *ACCEPTOR* (with-conditions-caught-and-logged () (with-mapped-conditions () (call-next-method)))) (defun do-with-acceptor-request-count-incremented (*acceptor* function) (with-lock-held ((acceptor-shutdown-lock *acceptor*)) (incf (accessor-requests-in-progress *acceptor*))) (unwind-protect (funcall function) (with-lock-held ((acceptor-shutdown-lock *acceptor*)) (decf (accessor-requests-in-progress *acceptor*)) (when (acceptor-shutdown-p *acceptor*) (condition-variable-signal (acceptor-shutdown-queue *acceptor*)))))) (defmacro with-acceptor-request-count-incremented ((acceptor) &body body) "Execute BODY with ACCEPTOR-REQUESTS-IN-PROGRESS of ACCEPTOR incremented by one. If the ACCEPTOR-SHUTDOWN-P returns true after the BODY has been executed, the ACCEPTOR-SHUTDOWN-QUEUE condition variable of the ACCEPTOR is signalled in order to finish shutdown processing." `(do-with-acceptor-request-count-incremented ,acceptor (lambda () ,@body))) (defun acceptor-make-request (acceptor socket &key headers-in content-stream method uri server-protocol) "Make a REQUEST instance for the ACCEPTOR, setting up those slots that are determined from the SOCKET by calling the appropriate socket query functions." (multiple-value-bind (remote-addr remote-port) (get-peer-address-and-port socket) (multiple-value-bind (local-addr local-port) (get-local-address-and-port socket) (make-instance (acceptor-request-class acceptor) :acceptor acceptor :local-addr local-addr :local-port local-port :remote-addr remote-addr :remote-port remote-port :headers-in headers-in :content-stream content-stream :method method :uri uri :server-protocol server-protocol)))) (defgeneric detach-socket (acceptor) (:documentation "Indicate to Hunchentoot that it should stop serving requests on the current request's socket. Hunchentoot will finish processing the current request and then return from PROCESS-CONNECTION without closing the connection to the client. DETACH-SOCKET can only be called from within a request handler function.")) (defmethod detach-socket ((acceptor acceptor)) (setf *finish-processing-socket* t *close-hunchentoot-stream* nil)) (defmethod process-connection ((*acceptor* acceptor) (socket t)) (let* ((socket-stream (make-socket-stream socket *acceptor*)) (*hunchentoot-stream*) (*close-hunchentoot-stream* t)) (unwind-protect ;; process requests until either the acceptor is shut down, ;; *CLOSE-HUNCHENTOOT-STREAM* has been set to T by the ;; handler, or the peer fails to send a request (progn (setq *hunchentoot-stream* (initialize-connection-stream *acceptor* socket-stream)) (loop (let ((*finish-processing-socket* t)) (when (acceptor-shutdown-p *acceptor*) (return)) (multiple-value-bind (headers-in method url-string protocol) (get-request-data *hunchentoot-stream*) ;; check if there was a request at all (unless method (return)) ;; bind per-request special variables, then process the ;; request - note that *ACCEPTOR* was bound above already (let ((*reply* (make-instance (acceptor-reply-class *acceptor*))) (*session* nil) (transfer-encodings (cdr (assoc* :transfer-encoding headers-in)))) (when transfer-encodings (setq transfer-encodings (split "\\s*,\\s*" transfer-encodings)) (when (member "chunked" transfer-encodings :test #'equalp) (cond ((acceptor-input-chunking-p *acceptor*) ;; turn chunking on before we read the request body (setf *hunchentoot-stream* (make-chunked-stream *hunchentoot-stream*) (chunked-stream-input-chunking-p *hunchentoot-stream*) t)) (t (hunchentoot-error "Client tried to use ~ chunked encoding, but acceptor is configured to not use it."))))) (with-acceptor-request-count-incremented (*acceptor*) (process-request (acceptor-make-request *acceptor* socket :headers-in headers-in :content-stream *hunchentoot-stream* :method method :uri url-string :server-protocol protocol)))) (finish-output *hunchentoot-stream*) (setq *hunchentoot-stream* (reset-connection-stream *acceptor* *hunchentoot-stream*)) (when *finish-processing-socket* (return)))))) (when *close-hunchentoot-stream* (flet ((close-stream (stream) ;; as we are at the end of the request here, we ignore all ;; errors that may occur while flushing and/or closing the ;; stream. (ignore-errors* (finish-output stream)) (ignore-errors* (close stream :abort t)))) (unless (or (not *hunchentoot-stream*) (eql socket-stream *hunchentoot-stream*)) (close-stream *hunchentoot-stream*)) (close-stream socket-stream)))))) (defmethod acceptor-ssl-p ((acceptor t)) ;; the default is to always answer "no" nil) (defgeneric acceptor-log-access (acceptor &key return-code) (:documentation "Function to call to log access to the acceptor. The RETURN-CODE, CONTENT and CONTENT-LENGTH keyword arguments contain additional information about the request to log. In addition, it can use the standard request accessor functions that are available to handler functions to find out more information about the request.")) (defmethod acceptor-log-access ((acceptor acceptor) &key return-code) "Default method for access logging. It logs the information to the destination determined by (ACCEPTOR-ACCESS-LOG-DESTINATION ACCEPTOR) \(unless that value is NIL) in a format that can be parsed by most Apache log analysis tools.)" (with-log-stream (stream (acceptor-access-log-destination acceptor) *access-log-lock*) (format stream "~:[-~@[ (~A)~]~;~:*~A~@[ (~A)~]~] ~:[-~;~:*~A~] [~A] \"~A ~A~@[?~A~] ~ ~A\" ~D ~:[-~;~:*~D~] \"~:[-~;~:*~A~]\" \"~:[-~;~:*~A~]\"~%" (remote-addr*) (header-in* :x-forwarded-for) (authorization) (iso-time) (request-method*) (script-name*) (query-string*) (server-protocol*) return-code (content-length*) (referer) (user-agent)))) (defgeneric acceptor-log-message (acceptor log-level format-string &rest format-arguments) (:documentation "Function to call to log messages by the ACCEPTOR. It must accept a severity level for the message, which will be one of :ERROR, :INFO, or :WARNING, a format string and an arbitary number of formatting arguments.")) (defmethod acceptor-log-message ((acceptor acceptor) log-level format-string &rest format-arguments) "Default function to log server messages. Sends a formatted message to the destination denoted by (ACCEPTOR-MESSAGE-LOG-DESTINATION ACCEPTOR). FORMAT and ARGS are as in FORMAT. LOG-LEVEL is a keyword denoting the log level or NIL in which case it is ignored." (with-log-stream (stream (acceptor-message-log-destination acceptor) *message-log-lock*) (handler-case (format stream "[~A~@[ [~A]~]] ~?~%" (iso-time) log-level format-string format-arguments) (error (e) (ignore-errors (format *trace-output* "error ~A while writing to error log, error not logged~%" e)))))) (defun log-message* (log-level format-string &rest format-arguments) "Convenience function which calls the message logger of the current acceptor \(if there is one) with the same arguments it accepts. This is the function which Hunchentoot itself uses to log errors it catches during request processing." (apply 'acceptor-log-message *acceptor* log-level format-string format-arguments)) ;; usocket implementation #-:lispworks (defmethod start-listening ((acceptor acceptor)) (when (acceptor-listen-socket acceptor) (hunchentoot-error "acceptor ~A is already listening" acceptor)) (setf (acceptor-listen-socket acceptor) (usocket:socket-listen (or (acceptor-address acceptor) usocket:*wildcard-host*) (acceptor-port acceptor) :reuseaddress t :backlog (acceptor-listen-backlog acceptor) :element-type '(unsigned-byte 8))) (values)) #-:lispworks (defmethod accept-connections ((acceptor acceptor)) (usocket:with-server-socket (listener (acceptor-listen-socket acceptor)) (loop (when (acceptor-shutdown-p acceptor) (return)) (when (usocket:wait-for-input listener :ready-only t :timeout +new-connection-wait-time+) (when-let (client-connection (handler-case (usocket:socket-accept listener) ;; ignore condition (usocket:connection-aborted-error ()))) (set-timeouts client-connection (acceptor-read-timeout acceptor) (acceptor-write-timeout acceptor)) (handle-incoming-connection (acceptor-taskmaster acceptor) client-connection)))))) ;; LispWorks implementation #+:lispworks (defmethod start-listening ((acceptor acceptor)) (multiple-value-bind (listener-process startup-condition) (comm:start-up-server :service (acceptor-port acceptor) :address (acceptor-address acceptor) :process-name (format nil "Hunchentoot listener \(~A:~A)" (or (acceptor-address acceptor) "*") (acceptor-port acceptor)) ;; this function is called once on startup - we ;; use it to check for errors :announce (lambda (socket &optional condition) (declare (ignore socket)) (when condition (error condition))) ;; this function is called whenever a connection ;; is made :function (lambda (handle) (unless (acceptor-shutdown-p acceptor) (handle-incoming-connection (acceptor-taskmaster acceptor) handle))) ;; wait until the acceptor was successfully started ;; or an error condition is returned :wait t) (when startup-condition (error startup-condition)) (mp:process-stop listener-process) (setf (acceptor-process acceptor) listener-process) (values))) #+:lispworks (defmethod accept-connections ((acceptor acceptor)) (mp:process-unstop (acceptor-process acceptor)) nil) (defmethod acceptor-dispatch-request ((acceptor acceptor) request) "Detault implementation of the request dispatch method, generates an +http-not-found+ error." (let ((path (and (acceptor-document-root acceptor) (request-pathname request)))) (cond (path (handle-static-file (merge-pathnames (if (equal "/" (script-name request)) #p"index.html" path) (acceptor-document-root acceptor)))) (t (setf (return-code *reply*) +http-not-found+) (abort-request-handler))))) (defmethod handle-request ((*acceptor* acceptor) (*request* request)) "Standard method for request handling. Calls the request dispatcher of *ACCEPTOR* to determine how the request should be handled. Also sets up standard error handling which catches any errors within the handler." (handler-bind ((error (lambda (cond) ;; if the headers were already sent, the error ;; happened within the body and we have to close ;; the stream (when *headers-sent* (setq *finish-processing-socket* t)) (throw 'handler-done (values nil cond (get-backtrace)))))) (with-debugger (acceptor-dispatch-request *acceptor* *request*)))) (defgeneric acceptor-status-message (acceptor http-status-code &key &allow-other-keys) (:documentation "This function is called after the request's handler has been invoked to convert the HTTP-STATUS-CODE to a HTML message to be displayed to the user. If this function returns a string, that string is sent to the client instead of the content produced by the handler, if any. If an ERROR-TEMPLATE-DIRECTORY is set in the current acceptor and the directory contains a file corresponding to HTTP-STATUS-CODE named .html, that file is sent to the client after variable substitution. Variables are referenced by ${}. Additional keyword arguments may be provided which are made available to the templating logic as substitution variables. These variables can be interpolated into error message templates in, which contains the current URL relative to the server and without GET parameters. In addition to the variables corresponding to keyword arguments, the script-name, lisp-implementation-type, lisp-implementation-version and hunchentoot-version variables are available.")) (defun make-cooked-message (http-status-code &key error backtrace) (labels ((cooked-message (format &rest arguments) (setf (content-type*) "text/html; charset=iso-8859-1") (format nil "~D ~A

~:*~A

~?

~A

" http-status-code (reason-phrase http-status-code) format (mapcar (lambda (arg) (if (stringp arg) (escape-for-html arg) arg)) arguments) (address-string)))) (case http-status-code ((#.+http-moved-temporarily+ #.+http-moved-permanently+) (cooked-message "The document has moved here" (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.")) ((#.+http-internal-server-error+) (if *show-lisp-errors-p* (cooked-message "
~A~@[~%~%Backtrace:~%~%~A~]
" (escape-for-html (princ-to-string error)) (when *show-lisp-backtraces-p* (escape-for-html (princ-to-string backtrace)))) (cooked-message "An error has occurred"))) (t (when (<= 400 http-status-code) (cooked-message "An error has occurred")))))) (defmethod acceptor-status-message ((acceptor t) http-status-code &rest args &key &allow-other-keys) (apply 'make-cooked-message http-status-code args)) (defmethod acceptor-status-message :around ((acceptor acceptor) http-status-code &rest args &key &allow-other-keys) (handler-case (call-next-method) (error (e) (log-message* :error "error ~A during error processing, sending cooked message to client" e) (apply 'make-cooked-message http-status-code args)))) (defun string-as-keyword (string) "Intern STRING as keyword using the reader so that case conversion is done with the reader defaults." (let ((*package* (find-package :keyword))) (read-from-string string))) (defmethod acceptor-status-message ((acceptor acceptor) http-status-code &rest properties &key &allow-other-keys) "Default function to generate error message sent to the client." (labels ((substitute-request-context-variables (string) (let ((properties (append `(:script-name ,(script-name*) :lisp-implementation-type ,(lisp-implementation-type) :lisp-implementation-version ,(lisp-implementation-version) :hunchentoot-version ,*hunchentoot-version*) properties))) (unless *show-lisp-backtraces-p* (setf (getf properties :backtrace) nil)) (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-name (string-as-keyword (subseq target-string (aref reg-starts 0) (aref reg-ends 0))))) (escape-for-html (princ-to-string (getf properties variable-name variable-name)))))))) (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-status-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 (setf (content-type*) "text/html") (substitute-request-context-variables (file-contents file)))))))) (or (unless (< 300 http-status-code) (call-next-method)) ; don't ever try template for positive return codes (when *show-lisp-errors-p* (error-contents-from-template)) ; try template (call-next-method)))) ; fall back to cooked message (defgeneric acceptor-remove-session (acceptor session) (:documentation "This function is called whenever a session in ACCEPTOR is being destroyed because of a session timout or an explicit REMOVE-SESSION call.")) (defmethod acceptor-remove-session ((acceptor acceptor) (session t)) "Default implementation for the session removal hook function. This function is called whenever a session is destroyed." nil) (defgeneric acceptor-server-name (acceptor) (:documentation "Returns a string which can be used for 'Server' headers.") (:method ((acceptor acceptor)) (format nil "Hunchentoot ~A" *hunchentoot-version*))) hunchentoot-1.2.35/conditions.lisp0000644000004100000410000001275412656661410017252 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2008-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (define-condition hunchentoot-condition (condition) () (:documentation "Superclass for all conditions related to Hunchentoot.")) (define-condition hunchentoot-error (hunchentoot-condition error) () (:documentation "Superclass for all errors related to Hunchentoot.")) (define-condition hunchentoot-simple-error (hunchentoot-error simple-condition) () (:documentation "Like HUNCHENTOOT-ERROR but with formatting capabilities.")) (defun hunchentoot-error (format-control &rest format-arguments) "Signals an error of type HUNCHENTOOT-SIMPLE-ERROR with the provided format control and arguments." (error 'hunchentoot-simple-error :format-control format-control :format-arguments format-arguments)) (define-condition hunchentoot-warning (hunchentoot-condition warning) () (:documentation "Superclass for all warnings related to Hunchentoot.")) (define-condition hunchentoot-simple-warning (hunchentoot-warning simple-condition) () (:documentation "Like HUNCHENTOOT-WARNING but with formatting capabilities.")) (defun hunchentoot-warn (format-control &rest format-arguments) "Signals a warning of type HUNCHENTOOT-SIMPLE-WARNING with the provided format control and arguments." (warn 'hunchentoot-simple-warning :format-control format-control :format-arguments format-arguments)) (define-condition parameter-error (hunchentoot-simple-error) () (:documentation "Signalled if a function was called with incosistent or illegal parameters.")) (defun parameter-error (format-control &rest format-arguments) "Signals an error of type PARAMETER-ERROR with the provided format control and arguments." (error 'parameter-error :format-control format-control :format-arguments format-arguments)) (define-condition operation-not-implemented (hunchentoot-error) ((operation :initarg :operation :reader hunchentoot-operation-not-implemented-operation :documentation "The name of the unimplemented operation.")) (:report (lambda (condition stream) (format stream "The operation ~A is not yet implemented for the implementation ~A. Consider sending a patch..." (hunchentoot-operation-not-implemented-operation condition) (lisp-implementation-type)))) (:documentation "This warning is signalled when an operation \(like SETUID for example) is not implemented for a specific Lisp.")) (defun not-implemented (name) "Used to signal an error if an operation named NAME is not implemented." (error 'operation-not-implemented :operation name)) (define-condition bad-request (hunchentoot-error) ()) ;;; (defgeneric maybe-invoke-debugger (condition) (:documentation "This generic function is called whenever a condition CONDITION is signaled in Hunchentoot. You might want to specialize it on specific condition classes for debugging purposes.") (:method (condition) "The default method invokes the debugger with CONDITION if *CATCH-ERRORS-P* is NIL." (unless *catch-errors-p* (invoke-debugger condition)))) (defmacro with-debugger (&body body) "Executes BODY and invokes the debugger if an error is signaled and *CATCH-ERRORS-P* is NIL." `(handler-bind ((bad-request (lambda (c) (declare (ignore c)) (setf (return-code *reply*) +http-bad-request+) (abort-request-handler))) (error #'maybe-invoke-debugger)) ,@body)) (defmacro ignore-errors* (&body body) "Like IGNORE-ERRORS, but observes *CATCH-ERRORS-P*." `(ignore-errors (with-debugger ,@body))) (defmacro handler-case* (expression &rest clauses) "Like HANDLER-CASE, but observes *CATCH-ERRORS-P*." `(handler-case (with-debugger ,expression) ,@clauses)) (defun get-backtrace () "Returns a string with a backtrace of what the Lisp system thinks is the \"current\" error." (handler-case (with-output-to-string (s) (trivial-backtrace:print-backtrace-to-stream s)) (error (condition) (format nil "Could not generate backtrace: ~A." condition)))) hunchentoot-1.2.35/packages.lisp0000644000004100000410000002355412656661410016657 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :cl-user) (defpackage #:hunchentoot (:nicknames #:tbnl) (:use :cl :cl-ppcre :chunga :flexi-streams :url-rewrite) (:shadow #:defconstant #:url-encode) #+:lispworks (:import-from :lw #:with-unique-names #:when-let) (:export #:*acceptor* #:*catch-errors-p* #+:lispworks #:*cleanup-function* #+:lispworks #:*cleanup-interval* #:*content-types-for-url-rewrite* #:*default-connection-timeout* #:*default-content-type* #:*dispatch-table* #:*file-upload-hook* #:*handle-http-errors-p* #:*header-stream* #:*http-error-handler* #:*hunchentoot-default-external-format* #:*hunchentoot-version* #:*lisp-errors-log-level* #:*lisp-warnings-log-level* #:*log-lisp-backtraces-p* #:*log-lisp-errors-p* #:*log-lisp-warnings-p* #:*methods-for-post-parameters* #:*reply* #:*request* #:*rewrite-for-session-urls* #:*session* #:*session-gc-frequency* #:*session-max-time* #:*session-secret* #:*show-lisp-backtraces-p* #:*show-lisp-errors-p* #:*tmp-directory* #:*use-remote-addr-for-sessions* #:*use-user-agent-for-sessions* #:+http-accepted+ #:+http-authorization-required+ #:+http-bad-gateway+ #:+http-bad-request+ #:+http-conflict+ #:+http-continue+ #:+http-created+ #:+http-expectation-failed+ #:+http-failed-dependency+ #:+http-forbidden+ #:+http-gateway-time-out+ #:+http-gone+ #:+http-internal-server-error+ #:+http-length-required+ #:+http-method-not-allowed+ #:+http-moved-permanently+ #:+http-moved-temporarily+ #:+http-multi-status+ #:+http-multiple-choices+ #:+http-network-authentication-required+ #:+http-no-content+ #:+http-non-authoritative-information+ #:+http-not-acceptable+ #:+http-not-found+ #:+http-not-implemented+ #:+http-not-modified+ #:+http-ok+ #:+http-partial-content+ #:+http-payment-required+ #:+http-precondition-failed+ #:+http-precondition-required+ #:+http-proxy-authentication-required+ #:+http-request-entity-too-large+ #:+http-request-header-fields-too-large+ #:+http-request-time-out+ #:+http-request-uri-too-large+ #:+http-requested-range-not-satisfiable+ #:+http-reset-content+ #:+http-see-other+ #:+http-service-unavailable+ #:+http-switching-protocols+ #:+http-temporary-redirect+ #:+http-too-many-requests+ #:+http-unsupported-media-type+ #:+http-use-proxy+ #:+http-version-not-supported+ #:abort-request-handler #:accept-connections #:acceptor #:acceptor-access-log-destination #:acceptor-address #:acceptor-listen-backlog #:acceptor-dispatch-request #:acceptor-error-template-directory #:acceptor-input-chunking-p #:acceptor-log-access #:acceptor-log-message #:acceptor-message-log-destination #:acceptor-name #:acceptor-output-chunking-p #:acceptor-persistent-connections-p #:acceptor-port #:acceptor-read-timeout #:acceptor-remove-session #:acceptor-reply-class #:acceptor-request-class #:acceptor-ssl-p #-:hunchentoot-no-ssl #:acceptor-ssl-certificate-file #-:hunchentoot-no-ssl #:acceptor-ssl-privatekey-file #-:hunchentoot-no-ssl #:acceptor-ssl-privatekey-password #:acceptor-status-message #:acceptor-write-timeout #:acceptor-document-root #:acceptor-error-template-directory #:authorization #:aux-request-value #:client-as-string #:content-length #:content-length* #:content-type #:content-type* #:cookie-domain #:cookie-expires #:cookie-http-only #:cookie-in #:cookie-max-age #:cookie-name #:cookie-out #:cookie-path #:cookie-secure #:cookie-value #:cookies-in #:cookies-in* #:cookies-out #:cookies-out* #:create-folder-dispatcher-and-handler #:create-prefix-dispatcher #:create-regex-dispatcher #:create-request-handler-thread #:create-static-file-dispatcher-and-handler #:decrement-taskmaster-thread-count #:default-document-directory #:define-easy-handler #:delete-aux-request-value #:delete-session-value #:dispatch-easy-handlers #:easy-acceptor #-:hunchentoot-no-ssl #:easy-ssl-acceptor #:escape-for-html #:execute-acceptor #:get-parameter #:get-parameters #:get-parameters* #:handle-incoming-connection #:handle-if-modified-since #:handle-request #:handle-static-file #:header-in #:header-in* #:header-out #:headers-in #:headers-in* #:headers-out #:headers-out* #:host #:http-token-p #:hunchentoot-condition #:hunchentoot-error #:hunchentoot-warning #:increment-taskmaster-thread-count #:initialize-connection-stream #:log-message* #:maybe-invoke-debugger #:mime-type #:multi-threaded-taskmaster #:next-session-id #:no-cache #:one-thread-per-connection-taskmaster #:parameter #:parameter-error #:post-parameter #:post-parameters #:post-parameters* #:process-connection #:process-request #:query-string #:query-string* #:raw-post-data #:real-remote-addr #:reason-phrase #:recompute-request-parameters #:redirect #:referer #:regenerate-session-cookie-value #:remote-addr #:remote-addr* #:remote-port #:remote-port* #:local-addr #:local-addr* #:local-port #:local-port* #:remove-session #:reply #:reply-external-format #:reply-external-format* #:request #:request-acceptor #:request-method #:request-method* #:request-pathname #:request-uri #:request-uri* #:require-authorization #:reset-connection-stream #:reset-sessions #:reset-session-secret #:return-code #:return-code* #:rfc-1123-date #:script-name #:script-name* #:send-headers #:server-protocol #:server-protocol* #:session #:session-cookie-name #:session-cookie-value #:session-created #:session-db #:session-db-lock #:session-gc #:session-id #:session-max-time #:session-remote-addr #:session-start #:session-too-old-p #:session-user-agent #:session-value #:session-verify #:set-cookie #:set-cookie* #:shutdown #:single-threaded-taskmaster #-:hunchentoot-no-ssl #:ssl-acceptor #:ssl-p #:start #:start-listening #:start-session #:start-thread #:started-p #:stop #:taskmaster #:taskmaster-acceptor #:taskmaster-max-accept-count #:taskmaster-max-thread-count #:taskmaster-thread-count #:too-many-taskmaster-requests #:url-decode #:url-encode #:user-agent #:within-request-p #:detach-socket #:bad-request)) hunchentoot-1.2.35/session.lisp0000644000004100000410000004111612656661410016556 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defgeneric session-db-lock (acceptor &key whole-db-p) (:documentation "A function which returns a lock that will be used to prevent concurrent access to sessions. The first argument will be the acceptor that handles the current request, the second argument is true if the whole \(current) session database is modified. If it is NIL, only one existing session in the database is modified. This function can return NIL which means that sessions or session databases will be modified without a lock held \(for example for single-threaded environments). The default is to always return a global lock \(ignoring the ACCEPTOR argument) for Lisps that support threads and NIL otherwise.")) (defmethod session-db-lock ((acceptor t) &key (whole-db-p t)) (declare (ignore whole-db-p)) *global-session-db-lock*) (defmacro with-session-lock-held ((lock) &body body) "This is like WITH-LOCK-HELD except that it will accept NIL as a \"lock\" and just execute BODY in this case." (with-unique-names (thunk) (with-rebinding (lock) `(flet ((,thunk () ,@body)) (cond (,lock (with-lock-held (,lock) (,thunk))) (t (,thunk))))))) (defgeneric session-db (acceptor) (:documentation "Returns the current session database which is an alist where each car is a session's ID and the cdr is the corresponding SESSION object itself. The default is to use a global list for all acceptors.")) (defmethod session-db ((acceptor t)) *session-db*) (defgeneric (setf session-db) (new-value acceptor) (:documentation "Modifies the current session database. See SESSION-DB.")) (defmethod (setf session-db) (new-value (acceptor t)) (setq *session-db* new-value)) (defgeneric next-session-id (acceptor) (:documentation "Returns the next sequential session ID, an integer, which should be unique per session. The default method uses a simple global counter and isn't guarded by a lock. For a high-performance production environment you might consider using a more robust implementation.")) (let ((session-id-counter 0)) (defmethod next-session-id ((acceptor t)) (incf session-id-counter))) (defclass session () ((session-id :initform (next-session-id (request-acceptor *request*)) :reader session-id :type integer :documentation "The unique ID \(an INTEGER) of the session.") (session-string :reader session-string :documentation "The session string encodes enough data to safely retrieve this session. It is sent to the browser as a cookie value or as a GET parameter.") (user-agent :initform (user-agent *request*) :reader session-user-agent :documentation "The incoming 'User-Agent' header that was sent when this session was created.") (remote-addr :initform (real-remote-addr *request*) :reader session-remote-addr :documentation "The remote IP address of the client when this session was started as returned by REAL-REMOTE-ADDR.") (session-start :initform (get-universal-time) :reader session-start :documentation "The time this session was started.") (last-click :initform (get-universal-time) :reader session-last-click :documentation "The last time this session was used.") (session-data :initarg :session-data :initform nil :reader session-data :documentation "Data associated with this session - see SESSION-VALUE.") (max-time :initarg :max-time :initform *session-max-time* :accessor session-max-time :type fixnum :documentation "The time \(in seconds) after which this session expires if it's not used.")) (:documentation "SESSION objects are automatically maintained by Hunchentoot. They should not be created explicitly with MAKE-INSTANCE but implicitly with START-SESSION and they should be treated as opaque objects. You can ignore Hunchentoot's SESSION objects altogether and implement your own sessions if you provide corresponding methods for SESSION-COOKIE-VALUE and SESSION-VERIFY.")) (defun encode-session-string (id user-agent remote-addr start) "Creates a uniquely encoded session string based on the values ID, USER-AGENT, REMOTE-ADDR, and START" (unless (boundp '*session-secret*) (hunchentoot-warn "Session secret is unbound. Using Lisp's RANDOM function to initialize it.") (reset-session-secret)) ;; *SESSION-SECRET* is used twice due to known theoretical ;; vulnerabilities of MD5 encoding (md5-hex (concatenate 'string *session-secret* (md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A" *session-secret* id (and *use-user-agent-for-sessions* user-agent) (and *use-remote-addr-for-sessions* remote-addr) start))))) (defun stringify-session (session) "Creates a string representing the SESSION object SESSION. See ENCODE-SESSION-STRING." (encode-session-string (session-id session) (session-user-agent session) (session-remote-addr session) (session-start session))) (defmethod initialize-instance :after ((session session) &rest init-args) "Set SESSION-STRING slot after the session has been initialized." (declare (ignore init-args)) (setf (slot-value session 'session-string) (stringify-session session))) (defun session-gc () "Removes sessions from the current session database which are too old - see SESSION-TOO-OLD-P." (with-session-lock-held ((session-db-lock *acceptor*)) (setf (session-db *acceptor*) (loop for id-session-pair in (session-db *acceptor*) for (nil . session) = id-session-pair when (session-too-old-p session) do (acceptor-remove-session *acceptor* session) else collect id-session-pair))) (values)) (defun session-value (symbol &optional (session *session*)) "Returns the value associated with SYMBOL from the session object SESSION \(the default is the current session) if it exists." (when session (let ((found (assoc symbol (session-data session) :test #'eq))) (values (cdr found) found)))) (defsetf session-value (symbol &optional session) (new-value) "Sets the value associated with SYMBOL from the session object SESSION. If there is already a value associated with SYMBOL it will be replaced. Will automatically start a session if none was supplied and there's no session for the current request." (with-rebinding (symbol) (with-unique-names (place %session) `(let ((,%session (or ,session (start-session)))) (with-session-lock-held ((session-db-lock *acceptor* :whole-db-p nil)) (let* ((,place (assoc ,symbol (session-data ,%session) :test #'eq))) (cond (,place (setf (cdr ,place) ,new-value)) (t (push (cons ,symbol ,new-value) (slot-value ,%session 'session-data)) ,new-value)))))))) (defun delete-session-value (symbol &optional (session *session*)) "Removes the value associated with SYMBOL from SESSION if there is one." (when session (setf (slot-value session 'session-data) (delete symbol (session-data session) :key #'car :test #'eq))) (values)) (defgeneric session-cookie-value (session) (:documentation "Returns a string which can be used to safely restore the session SESSION if as session has already been established. This is used as the value stored in the session cookie or in the corresponding GET parameter and verified by SESSION-VERIFY. A default method is provided and there's no reason to change it unless you want to use your own session objects.")) (defmethod session-cookie-value ((session session)) (and session (format nil "~D:~A" (session-id session) (session-string session)))) (defgeneric session-cookie-name (acceptor) (:documentation "Returns the name \(a string) of the cookie \(or the GET parameter) which is used to store a session on the client side. The default is to use the string \"hunchentoot-session\", but you can specialize this function if you want another name.")) (defmethod session-cookie-name ((acceptor t)) "hunchentoot-session") (defgeneric session-created (acceptor new-session) (:documentation "This function is called whenever a new session has been created. There's a default method which might trigger a session GC based on the value of *SESSION-GC-FREQUENCY*. The return value is ignored.")) (let ((global-session-usage-counter 0)) (defmethod session-created ((acceptor t) (session t)) "Counts session usage globally and triggers session GC if necessary." (when (and *session-gc-frequency* (zerop (mod (incf global-session-usage-counter) *session-gc-frequency*))) (session-gc)))) (defun start-session () "Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this case the function will also send a session cookie to the browser." (let ((session (session *request*))) (when session (return-from start-session session)) (setf session (make-instance 'session) (session *request*) session) (with-session-lock-held ((session-db-lock *acceptor*)) (setf (session-db *acceptor*) (acons (session-id session) session (session-db *acceptor*)))) (set-cookie (session-cookie-name *acceptor*) :value (session-cookie-value session) :path "/" :http-only t) (session-created *acceptor* session) (setq *session* session))) (defun remove-session (session) "Completely removes the SESSION object SESSION from Hunchentoot's internal session database." (set-cookie (session-cookie-name *acceptor*) :value "deleted" :path "/" :expires 0) (with-session-lock-held ((session-db-lock *acceptor*)) (acceptor-remove-session *acceptor* session) (setf (session-db *acceptor*) (delete (session-id session) (session-db *acceptor*) :key #'car :test #'=))) (values)) (defun session-too-old-p (session) "Returns true if the SESSION object SESSION has not been active in the last \(SESSION-MAX-TIME SESSION) seconds." (< (+ (session-last-click session) (session-max-time session)) (get-universal-time))) (defun get-stored-session (id) "Returns the SESSION object corresponding to the number ID if the session has not expired. Will remove the session if it has expired but will not create a new one." (let ((session (cdr (assoc id (session-db *acceptor*) :test #'=)))) (when (and session (session-too-old-p session)) (when *reply* (log-message* :info "Session with ID ~A too old" id)) (remove-session session) (setq session nil)) session)) (defun regenerate-session-cookie-value (session) "Regenerates the cookie value. This should be used when a user logs in according to the application to prevent against session fixation attacks. The cookie value being dependent on ID, USER-AGENT, REMOTE-ADDR, START, and *SESSION-SECRET*, the only value we can change is START to regenerate a new value. Since we're generating a new cookie, it makes sense to have the session being restarted, in time. That said, because of this fact, calling this function twice in the same second will regenerate twice the same value." (setf (slot-value session 'session-start) (get-universal-time) (slot-value session 'session-string) (stringify-session session)) (set-cookie (session-cookie-name *acceptor*) :value (session-cookie-value session) :path "/" :http-only t)) (defgeneric session-verify (request) (:documentation "Tries to get a session identifier from the cookies \(or alternatively from the GET parameters) sent by the client (see SESSION-COOKIE-NAME and SESSION-COOKIE-VALUE). This identifier is then checked for validity against the REQUEST object REQUEST. On success the corresponding session object \(if not too old) is returned \(and updated). Otherwise NIL is returned. A default method is provided and you only need to write your own one if you want to maintain your own sessions.")) (defmethod session-verify ((request request)) (let ((session-identifier (or (when-let (session-cookie (cookie-in (session-cookie-name *acceptor*) request)) (url-decode session-cookie)) (get-parameter (session-cookie-name *acceptor*) request)))) (when (and (stringp session-identifier) (scan "^\\d+:.+" session-identifier)) (destructuring-bind (id-string session-string) (split ":" session-identifier :limit 2) (let* ((id (parse-integer id-string)) (session (get-stored-session id)) (user-agent (user-agent request)) (remote-addr (remote-addr request))) (cond ((and session (string= session-string (session-string session)) (string= session-string (encode-session-string id user-agent (real-remote-addr request) (session-start session)))) ;; the session key presented by the client is valid (setf (slot-value session 'last-click) (get-universal-time)) session) (session ;; the session ID pointed to an existing session, but the ;; session string did not match the expected session string (log-message* :warning "Fake session identifier '~A' (User-Agent: '~A', IP: '~A')" session-identifier user-agent remote-addr) ;; remove the session to make sure that it can't be used ;; again; the original legitimate user will be required to ;; log in again (remove-session session) nil) (t ;; no session was found under the ID given, presumably ;; because it has expired. (log-message* :info "No session for session identifier '~A' (User-Agent: '~A', IP: '~A')" session-identifier user-agent remote-addr) nil))))))) (defun reset-session-secret () "Sets *SESSION-SECRET* to a new random value. All old sessions will cease to be valid." (setq *session-secret* (create-random-string 10 36))) (defun reset-sessions (&optional (acceptor *acceptor*)) "Removes ALL stored sessions of ACCEPTOR." (with-session-lock-held ((session-db-lock acceptor)) (loop for (nil . session) in (session-db acceptor) do (acceptor-remove-session acceptor session)) (setq *session-db* nil)) (values)) hunchentoot-1.2.35/doc/0000755000004100000410000000000012656661410014744 5ustar www-datawww-datahunchentoot-1.2.35/doc/Makefile0000644000004100000410000000024712656661410016407 0ustar www-datawww-data all: xsltproc --stringparam library-version `perl -ne 'print "$$1\n" if (/:version "(.*)"/)' ../hunchentoot.asd` clixdoc.xsl index.xml > ../www/hunchentoot-doc.html hunchentoot-1.2.35/doc/clixdoc.xsl0000644000004100000410000004113512656661410017125 0ustar www-datawww-data <xsl:value-of select="clix:title"/>

[]
=>

[]
=>

=>

[]
(setf ( ) new-value) =>

[]
=>
(setf ( ) new-value)

=>
(setf ( ) new-value)

[]


[Constants]

[]

[]

 &

  1. #
    1. #
# - Generic function Method Macro Function Generic reader Specialized reader Reader Generic reader Specialized reader Reader Generic readers Specialized readers Readers Generic accessors Specialized accessors Accessors Generic writer Specialized writer Writer Generic accessor Specialized accessor Accessor Generic accessor Specialized accessor Accessor Special variable Standard class Condition type Symbol Constant Constant hunchentoot-1.2.35/doc/LICENSE.txt0000644000004100000410000000051012656661410016563 0ustar www-datawww-dataThe Hunchentoot logo (the file `hunchentoot.gif' in this directory) was created by Uwe von Loh and is available from his website at http://www.htg1.de/hunchentoot/hunchentoot.html It is licensed under a `Creative Commons Attribution-Share Alike 2.0 Germany License', see http://creativecommons.org/licenses/by-sa/2.0/de/ hunchentoot-1.2.35/doc/index.xml0000644000004100000410000047520312656661410016610 0ustar www-datawww-data Hunchentoot - The Common Lisp web server formerly known as TBNL A full-featured web server written in Common Lisp offering things like HTTP/1.1 chunking, persistent connections, and SSL. Includes a framework for building dynamic websites interactively.

Hunchentoot - The Common Lisp web server formerly known as TBNL

Hunchentoot is a web server written in Common Lisp and at the same time a toolkit for building dynamic websites. As a stand-alone web server, Hunchentoot is capable of HTTP/1.1 chunking (both directions), persistent connections (keep-alive), and SSL.

Hunchentoot provides facilities like automatic session handling (with and without cookies), logging, customizable error handling, and easy access to GET and POST parameters sent by the client. It does not include functionality to programmatically generate HTML output. For this task you can use any library you like, e.g. (shameless self-plug) CL-WHO or HTML-TEMPLATE.

Hunchentoot talks with its front-end or with the client over TCP/IP sockets and optionally uses multiprocessing to handle several requests at the same time. Therefore, it cannot be implemented completely in portable Common Lisp. It currently works with LispWorks and all Lisps which are supported by the compatibility layers usocket and Bordeaux Threads.

Hunchentoot comes with a BSD-style license so you can basically do with it whatever you want.

Hunchentoot is (or was) for example used by QuickHoney, City Farming, Heike Stephan.

Download shortcut: http://weitz.de/files/hunchentoot.tar.gz.

Hunchentoot depends on a couple of other Lisp libraries which you'll need to install first: Make sure to use the newest versions of all of these libraries (which might themselves depend on other libraries) - try the repository versions if you're in doubt. Note: You can compile Hunchentoot without SSL support - and thus without the need to have CL+SSL - if you add :HUNCHENTOOT-NO-SSL to *FEATURES* before you compile it.

Hunchentoot will only work with Lisps where the character codes of all Latin-1 characters coincide with their Unicode code points (which is the case for all current implementations I know).

Hunchentoot itself together with this documentation can be downloaded from http://weitz.de/files/hunchentoot.tar.gz. The current version is .

The preferred method to compile and load Hunchentoot is via ASDF. If you want to avoid downloading and installing all the dependencies manually, give Zach Beane's excellent Quicklisp system a try.

Hunchentoot and its dependencies can also be installed with clbuild. There's also a port for Gentoo Linux thanks to Matthew Kennedy.

The current development version of Hunchentoot can be found at https://github.com/edicl/hunchentoot. If you want to send patches, please fork the github repository and send pull requests.

Hunchentoot does not come with code to help with running it on a privileged port (i.e. port 80 or 443) on Unix-like operating systems. Modern Unix-like systems have specific, non-portable ways to allow non-root users to listen to privileged ports, so including such functionality in Hunchentoot was considered unnecessary. Please refer to online resources for help. At the time of this writing, the YAWS documentation has a comprehensive writeup on the topic. If you're feeling unsecure about exposing Hunchentoot to the wild, wild Internet or if your Lisp web application is part of a larger website, you can hide it behind a proxy server. One approach that I have used several times is to employ Apache's mod_proxy module with a configuration that looks like this: 
ProxyPass /hunchentoot http://127.0.0.1:3000/hunchentoot
ProxyPassReverse /hunchentoot http://127.0.0.1:3000/hunchentoot
This will tunnel all requests where the URI path begins with "/hunchentoot" to a (Hunchentoot) server listening on port 3000 on the same machine.

Of course, there are several other (more lightweight) web proxies that you could use instead of Apache.

The development version of Hunchentoot can be found on github. Please use the github issue tracking system to submit bug reports. Patches are welcome, please use GitHub pull requests. If you want to make a change, please read this first.

Starting your own web server is pretty easy. Do something like this: 
(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
That's it. Now you should be able to enter the address "http://127.0.0.1:4242/" in your browser and see something, albeit nothing very interesting for now.

By default, Hunchentoot serves the files from the www/ directory in its source tree. In the distribution, that directory contains a HTML version of the documentation as well as the error templates. The location of the document root directory can be specified when creating a new ACCEPTOR instance by the way of the ACCEPTOR-DOCUMENT-ROOT. Likewise, the location of the error template directory can be specified by the ACCEPTOR-ERROR-TEMPLATE-DIRECTORY. Both ACCEPTOR-DOCUMENT-ROOT and ACCEPTOR-ERROR-TEMPLATE-DIRECTORY can be specified using a logical pathname, which will be translated once when the ACCEPTOR is instantiated.

The EASY-ACCEPTOR class implements a framework for developing web applications. Handlers are defined using the DEFINE-EASY-HANDLER macro. Request dispatching is performed according to the list of dispatch functions in *DISPATCH-TABLE*. Each of the functions on that list is called to determine whether it wants to handle the request, provided as single argument. If a dispatcher function wants to handle the request, it returns another function to actually create the desired page.

DEFINE-EASY-HANDLER is accompanied by a set of dispatcher creation functions that can be used to create dispatchers for standard tasks. These are documented in the subchapter on easy handlers

Now be a bit more adventurous, try this 

(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
  (setf (hunchentoot:content-type*) "text/plain")
  (format nil "Hey~@[ ~A~]!" name))
and see what happens at "http://127.0.0.1:4242/yo" or "http://127.0.0.1:4242/yo?name=Dude" .

Hunchentoot comes with a little example website which you can use to see if it works and which should also demonstrate a couple of the things you can do with Hunchentoot. To start the example website, enter the following code into your listener: 

(asdf:oos 'asdf:load-op :hunchentoot-test)
Now go to "http://127.0.0.1:4242/hunchentoot/test" and play a bit.

Adam Petersen has written a book called "Lisp for the Web" which explains how Hunchentoot and some other libraries can be used to build web sites.

Here is some software which extends Hunchentoot or is based on it:

  • Weblocks by Slava Akhmechet is a "continuations-based web framework" which is based on Hunchentoot.
  • hunchentoot-cgi (by Cyrus Harmon) provides CGI handlers for Hunchentoot.
  • CL-WEBDAV is a WebDAV server based on Hunchentoot.
  • RESTAS is a web framework based on Hunchentoot.
If you want Hunchentoot to actually do something, you have to create and start an acceptor. You can also run several acceptors in one image, each one listening on a different different port. To create a Hunchentoot webserver, you make an instance of this class or one of its subclasses and use the generic function START to start it (and STOP to stop it). Use the :port initarg if you don't want to listen on the default http port 80. There are other initargs most of which you probably won't need very often. They are explained in detail in the docstrings of the slot definitions for this class.

Unless you are in a Lisp without MP capabilities, you can have several active instances of ACCEPTOR (listening on different ports) at the same time.

Create and START an instance of this class (instead of ACCEPTOR) if you want an https server. There are two required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for pathname designators denoting the certificate file and the key file in PEM format. On LispWorks, you can have both in one file in which case the second initarg is optional. You can also use the :SSL-PRIVATEKEY-PASSWORD initarg to provide a password (as a string) for the key file (or NIL, the default, for no password).

The default port for SSL-ACCEPTOR instances is 443 instead of 80

acceptor acceptor Starts acceptor so that it begins accepting connections. Returns the acceptor. acceptor &key soft acceptor Stops the acceptor so that it no longer accepts requests. If soft is true, and there are any requests in progress, wait until all requests are fully processed, but meanwhile do not accept new requests. Note that soft must not be set when calling stop from within a request handler, as that will deadlock. The current ACCEPTOR object in the context of a request. listen-backlog number-of-pending-connections Number of pending connections allowed in the listen socket before the kernel rejects further incoming connections. Non-LispWorks only. acceptor address acceptor port acceptor read-timeout ssl-acceptor ssl-certificate-file ssl-acceptor ssl-privatekey-file ssl-acceptor ssl-privatekey-password acceptor write-timeout These are readers for various slots of ACCEPTOR objects (and some of them obviously only make sense for SSL-ACCEPTOR objects). See the docstrings of these slots for more information and note that there are corresponding initargs for all of them. acceptor (or pathname null) acceptor (or pathname null) acceptor (or pathname null) acceptor input-chunking-p acceptor (or pathname null) acceptor name acceptor output-chunking-p acceptor persistent-connections-p acceptor reply-class acceptor request-class These are accessors for various slots of ACCEPTOR objects. See the docstrings of these slots for more information and note that there are corresponding initargs for all of them. acceptor generalized-boolean Returns a true value if acceptor uses SSL connections. The default is to unconditionally return NIL and subclasses of ACCEPTOR must specialize this method to signal that they're using secure connections - see the SSL-ACCEPTOR class. The default connection timeout used when an acceptor is reading from and writing to a socket stream. Note that some Lisps allow you to set different timeouts for reading and writing and you can specify both values via initargs when you create an acceptor. acceptor session | This function is called whenever a session in ACCEPTOR is being destroyed because of a session timout or an explicit REMOVE-SESSION call. If you want to modify what acceptors do, you should subclass ACCEPTOR (or SSL-ACCEPTOR) and specialize the generic functions that constitute their behaviour (see example below). The life of an acceptor looks like this: It is started with the function START which immediately calls START-LISTENING and then applies the function EXECUTE-ACCEPTOR to its taskmaster. This function will eventually call ACCEPT-CONNECTIONS which is responsible for setting things up to wait for clients to connect. For each incoming connection which comes in, HANDLE-INCOMING-CONNECTION is applied to the taskmaster which will either call PROCESS-CONNECTION directly, or will create a thread to call it. PROCESS-CONNECTION calls INITIALIZE-CONNECTION-STREAM before it does anything else, then it selects and calls a function which handles the request, and finally it sends the reply to the client before it calls RESET-CONNECTION-STREAM. If the connection is persistent, this procedure is repeated (except for the intialization step) in a loop until the connection is closed. The acceptor is stopped with STOP.

If you just want to use the standard acceptors that come with Hunchentoot, you don't need to know anything about the functions listed in this section.

acceptor | Sets up a listen socket for the given acceptor and enables it to listen to incoming connections. This function is called from the thread that starts the acceptor initially and may return errors resulting from the listening operation (like 'address in use' or similar). acceptor nil In a loop, accepts a connection and hands it over to the acceptor's taskmaster for processing using HANDLE-INCOMING-CONNECTION. On LispWorks, this function returns immediately, on other Lisps it returns only once the acceptor has been stopped. acceptor socket nil This function is called by the taskmaster when a new client connection has been established. Its arguments are the ACCEPTOR object and a LispWorks socket handle or a usocket socket stream object in socket. It reads the request headers, sets up the request and reply objects, and hands over to PROCESS-REQUEST which calls HANDLE-REQUEST to select and call a handler for the request and sends its reply to the client. This is done in a loop until the stream has to be closed or until a connection timeout occurs. It is probably not a good idea to re-implement this method until you really, really know what you're doing.

Handlers may call to the DETACH-SOCKET generic function to indicate that no further requests should be handled on the connection by Hunchentoot, and that responsibility for the socket is assumed by third-party software. This can be used by specialized handlers that wish to hand over connection polling or processing to functions outside of Hunchentoot, i.e. for connection multiplexing or implementing specialized client protocols. Hunchentoot will finish processing the request and the PROCESS-CONNECTION function will return without closing the connection. At that point, the acceptor may interact with the socket in whatever fashion required.

acceptor stream Indicate to Hunchentoot that it should stop serving requests on the current request's socket. Hunchentoot will finish processing the current request and then return from PROCESS-CONNECTION without closing the connection to the client. DETACH-SOCKET can only be called from within a request handler function. acceptor stream stream Can be used to modify the stream which is used to communicate between client and server before the request is read. The default method of ACCEPTOR does nothing, but see for example the method defined for SSL-ACCEPTOR. All methods of this generic function must return the stream to use. acceptor stream stream Resets the stream which is used to communicate between client and server after one request has been served so that it can be used to process the next request. This generic function is called after a request has been processed and must return the stream. acceptor &key return-code Function to call to log access to the acceptor. The return-code keyword argument contains additional information about the request to log. In addition, it can use the standard request and reply accessor functions that are available to handler functions to find out more information about the request. acceptor log-level format-string &rest format-arguments Function to call to log messages by the acceptor. It must accept a severity level for the message, which will be one of :ERROR, :INFO, or :WARNING, a format string and an arbitary number of formatting arguments. acceptor http-return-code &key &allow-other-keys This function is called when a request's handler has been called but failed to provide content to send back to the client. It converts the HTTP-STATUS-CODE to some request contents, typically a human readable description of the status code to be displayed to the user. If an ERROR-TEMPLATE-DIRECTORY is set in the current acceptor and the directory contains a file corresponding to HTTP-STATUS-CODE named <code>.html, that file is sent to the client after variable substitution. Variables are referenced by ${<variable-name>}. Additional keyword arguments may be provided which are made available to the templating logic as substitution variables. These variables can be interpolated into error message templates in, which contains the current URL relative to the server and without GET parameters. In addition to the variables corresponding to keyword arguments, the script-name, lisp-implementation-type, lisp-implementation-version and hunchentoot-version variables are available. This example shows how to subclass ACCEPTOR in order to provide Hunchentoot with basic virtual host support.  It assumes Hunchentoot is sitting behind an Internet-facing reverse-proxy web server that maps the host (or domain) part of incoming HTTP requests to unique localhost ports. 
(asdf:load-system "hunchentoot")
(asdf:load-system "drakma")

;;; Subclass ACCEPTOR
(defclass vhost (tbnl:acceptor)
  ;; slots
  ((dispatch-table
    :initform '()
    :accessor dispatch-table
    :documentation "List of dispatch functions"))
  ;; options
  (:default-initargs                    ; default-initargs must be used
   :address "127.0.0.1"))               ; because ACCEPTOR uses it

;;; Specialise ACCEPTOR-DISPATCH-REQUEST for VHOSTs
(defmethod tbnl:acceptor-dispatch-request ((vhost vhost) request)
  ;; try REQUEST on each dispatcher in turn
  (mapc (lambda (dispatcher)
	  (let ((handler (funcall dispatcher request)))
	    (when handler               ; Handler found. FUNCALL it and return result
	      (return-from tbnl:acceptor-dispatch-request (funcall handler)))))
	(dispatch-table vhost))
  (call-next-method))

;;; ======================================================================
;;; Now all we need to do is test it

;;; Instantiate VHOSTs
(defvar vhost1 (make-instance 'vhost :port 50001))
(defvar vhost2 (make-instance 'vhost :port 50002))

;;; Populate each dispatch table
(push
 (tbnl:create-prefix-dispatcher "/foo" 'foo1)
 (dispatch-table vhost1))
(push
 (tbnl:create-prefix-dispatcher "/foo" 'foo2)
 (dispatch-table vhost2))

;;; Define handlers
(defun foo1 () "Hello")
(defun foo2 () "Goodbye")

;;; Start VHOSTs
(tbnl:start vhost1)
(tbnl:start vhost2)

;;; Make some requests
(drakma:http-request "http://127.0.0.1:50001/foo")
;;; =|
;;; 127.0.0.1 - [2012-06-08 14:30:39] "GET /foo HTTP/1.1" 200 5 "-" "Drakma/1.2.6 (SBCL 1.0.56; Linux; 2.6.32-5-686; http://weitz.de/drakma/)"
;;; =>
;;; "Hello"
;;; 200
;;; ((:CONTENT-LENGTH . "5") (:DATE . "Fri, 08 Jun 2012 14:30:39 GMT")
;;;  (:SERVER . "Hunchentoot 1.2.3") (:CONNECTION . "Close")
;;;  (:CONTENT-TYPE . "text/html; charset=utf-8"))
;;; #<PURI:URI http://127.0.0.1:50001/foo>
;;; #<FLEXI-STREAMS:FLEXI-IO-STREAM {CA90059}>
;;; T
;;; "OK"
(drakma:http-request "http://127.0.0.1:50002/foo")
;;; =|
;;; 127.0.0.1 - [2012-06-08 14:30:47] "GET /foo HTTP/1.1" 200 7 "-" "Drakma/1.2.6 (SBCL 1.0.56; Linux; 2.6.32-5-686; http://weitz.de/drakma/)"
;;; =>
;;; "Goodbye"
;;; 200
;;; ((:CONTENT-LENGTH . "7") (:DATE . "Fri, 08 Jun 2012 14:30:47 GMT")
;;;  (:SERVER . "Hunchentoot 1.2.3") (:CONNECTION . "Close")
;;;  (:CONTENT-TYPE . "text/html; charset=utf-8"))
;;; #<PURI:URI http://127.0.0.1:50002/foo>
;;; #<FLEXI-STREAMS:FLEXI-IO-STREAM {CAE8059}>
;;; T
;;; "OK"
How to make each VHOST write to separate access log streams (or files) is left as an exercise to the reader. As a "normal" Hunchentoot user, you can completely ignore taskmasters and skip this section. But if you're still reading, here are the dirty details: Each acceptor has a taskmaster associated with it at creation time. It is the taskmaster's job to distribute the work of accepting and handling incoming connections. The acceptor calls the taskmaster if appropriate and the taskmaster calls back into the acceptor. This is done using the generic functions described in this and the previous section. Hunchentoot comes with two standard taskmaster implementations - one (which is the default used on multi-threaded Lisps) which starts a new thread for each incoming connection and one which handles all requests sequentially. It should for example be relatively straightforward to create a taskmaster which allocates threads from a fixed pool instead of creating a new one for each connection.

You can control the resources consumed by a threaded taskmaster via two initargs. :max-thread-count lets you set the maximum number of request threads that can be processes simultaneously. If this is nil, the is no thread limit imposed. :max-accept-count lets you set the maximum number of requests that can be outstanding (i.e. being processed or queued for processing). If :max-thread-count is supplied and :max-accept-count is NIL, then a +HTTP-SERVICE-UNAVAILABLE+ error will be generated if there are more than the max-thread-count threads processing requests. If both :max-thread-count and :max-accept-count are supplied, then max-thread-count must be less than max-accept-count; if more than max-thread-count requests are being processed, then requests up to max-accept-count will be queued until a thread becomes available. If more than max-accept-count requests are outstanding, then a +HTTP-SERVICE-UNAVAILABLE+ error will be generated. In a load-balanced environment with multiple Hunchentoot servers, it's reasonable to provide :max-thread-count but leave :max-accept-count null. This will immediately result in +HTTP-SERVICE-UNAVAILABLE+ when one server is out of resources, so the load balancer can try to find another server. In an environment with a single Hunchentoot server, it's reasonable to provide both :max-thread-count and a somewhat larger value for :max-accept-count. This will cause a server that's almost out of resources to wait a bit; if the server is completely out of resources, then the reply will be +HTTP-SERVICE-UNAVAILABLE+. The default for these values is 100 and 120, respectively.

If you want to implement your own taskmasters, you should subclass TASKMASTER or one of its subclasses, SINGLE-THREADED-TASKMASTER or ONE-THREAD-PER-CONNECTION-TASKMASTER, and specialize the generic functions in this section.

An instance of this class is responsible for distributing the work of handling requests for its acceptor. This is an "abstract" class in the sense that usually only instances of subclasses of TASKMASTER will be used. A taskmaster that starts one thread for listening to incoming requests and one thread for each incoming connection.

This is the default taskmaster implementation for multi-threaded Lisp implementations.

A taskmaster that runs synchronously in the thread where the START function was invoked (or in the case of LispWorks in the thread started by COMM:START-UP-SERVER). This is the simplest possible taskmaster implementation in that its methods do nothing but calling their acceptor "sister" methods - EXECUTE-ACCEPTOR calls ACCEPT-CONNECTIONS, HANDLE-INCOMING-CONNECTION calls PROCESS-CONNECTION. This is an abstract class for taskmasters that use multiple threads; it is not a concrete class and you should not instantiate it with MAKE-INSTANCE. Instead, you should instantiate its subclass ONE-THREAD-PER-CONNECTION-TASKMASTER described above. MULTI-THREADED-TASKMASTER is intended to be inherited from by extensions to Hunchentoot, such as quux-hunchentoot's THREAD-POOLING-TASKMASTER, though at the moment, doing so only inherits one slot and one method, on EXECUTE-ACCEPTOR, to have it start a new thread for the acceptor, then saved in said slot. taskmaster result This is a callback called by the acceptor once it has performed all initial processing to start listening for incoming connections (see START-LISTENING). It usually calls the ACCEPT-CONNECTIONS method of the acceptor, but depending on the taskmaster instance the method might be called from a new thread. taskmaster socket result This function is called by the acceptor to start processing of requests on a new incoming connection. socket is the usocket instance that represents the new connection (or a socket handle on LispWorks). The taskmaster starts processing requests on the incoming connection by calling the PROCESS-CONNECTION method of the acceptor instance. The socket argument is passed to PROCESS-CONNECTION as an argument. If the taskmaster is a multi-threaded taskmaster, HANDLE-INCOMING-THREAD will call CREATE-REQUEST-HANDLER-THREAD, which will call PROCESS-CONNECTION in a new thread. HANDLE-INCOMING-THREAD might issue a +HTTP-SERVICE-UNAVAILABLE+ error if there are too many request threads or it might block waiting for a request thread to finish. taskmaster thunk &key thread This function is a callback that starts a new thread that will call the given thunk in the context of the proper taskmaster, with appropriate context-dependent keyword arguments. ONE-THREAD-PER-CONNECTION-TASKMASTER uses it in EXECUTE-ACCEPTOR and CREATE-REQUEST-HANDLER-THREAD, but specialized taskmasters may define more functions that use it. By default, it just creates a thread calling the thunk with a specified name keyword argument. Specialized taskmasters may wrap special bindings and condition handlers around the thunk call, register the thread in a management table, etc. taskmaster socket thread This function is called by HANDLE-INCOMING-THREAD to create a new thread which calls PROCESS-CONNECTION. If you specialize this function, you must be careful to have the thread call DECREMENT-TASKMASTER-REQUEST-COUNT before it exits. A typical method will look like this: 
(defmethod create-request-handler-thread ((taskmaster monitor-taskmaster) socket)
  (bt:make-thread
   (lambda ()
     (with-monitor-error-handlers
         (unwind-protect
              (with-monitor-variable-bindings
                  (process-connection (taskmaster-acceptor taskmaster) socket))
           (decrement-taskmaster-request-count taskmaster))))))
 taskmaster taskmaster Shuts down the taskmaster, i.e. frees all resources that were set up by it. For example, a multi-threaded taskmaster might terminate all threads that are currently associated with it. This function is called by the acceptor's STOP method. taskmaster acceptor This is an accessor for the slot of a TASKMASTER object that links back to the acceptor it is associated with. The main job of HANDLE-REQUEST is to select and call a function which handles the request, i.e. which looks at the data the client has sent and prepares an appropriate reply to send back. This is by default implemented as follows:

The ACCEPTOR class defines a ACCEPTOR-DISPATCH-REQUEST generic function which is used to actually dispatch the request. This function is called by the default method of HANDLE-REQUEST. Each ACCEPTOR-DISPATCH-REQUEST method looks at the request object and depending on its contents decides to either handle the request or call the next method.

In order to dispatch a request, Hunchentoot calls the ACCEPTOR-DISPATCH-REQUEST generic functions. The method for ACCEPTOR tries to serve a static file relative to it's ACCEPTOR-DOCUMENT-ROOT. Application specific acceptor subclasses will typically perform URL parsing and dispatching according to the policy that is required.

The default method of HANDLE-REQUEST sets up standard logging and error handling before it calls the acceptor's request dispatcher.

Request handlers do their work by modifying the reply object if necessary and by eventually returning the response body in the form of a string or a binary sequence. As an alternative, they can also call SEND-HEADERS and write directly to a stream.

The EASY-ACCEPTOR class defines a method for ACCEPTOR-DISPATCH-REQUEST that walks through the list *DISPATCH-TABLE* which consists of dispatch functions. Each of these functions accepts the request object as its only argument and either returns a request handler to handle the request or NIL which means that the next dispatcher in the list will be tried. If all dispatch functions return NIL, the next ACCEPTOR-DISPATCH-REQUEST will be called.

All functions and variables in this section are related to the easy request dispatch mechanism and are meaningless if you're using your own request dispatcher.

This class defines no additional slots with respect to ACCEPTOR. It only serves as an additional type for dispatching calls to ACCEPTOR-DISPATCH-REQUEST. In order to use the easy handler framework, acceptors of this class or one of its subclasses must be used. This class mixes the SSL-ACCEPTOR and the EASY-ACCEPTOR classes. It is used when both ssl and the easy handler framework are required. A global list of dispatch functions. The initial value is a list consisting of the symbol DISPATCH-EASY-HANDLERS. prefix handler dispatch-fn A convenience function which will return a dispatcher that returns handler whenever the path part of the request URI starts with the string prefix. regex handler dispatch-fn A convenience function which will return a dispatcher that returns handler whenever the path part of the request URI matches the CL-PPCRE regular expression regex (which can be a string, an s-expression, or a scanner). uri-prefix base-path optional content-type dispatch-fn Creates and returns a dispatch function which will dispatch to a handler function which emits the file relative to base-path that is denoted by the URI of the request relative to uri-prefix. uri-prefix must be a string ending with a slash, base-path must be a pathname designator for an existing directory. Uses HANDLE-STATIC-FILE internally.

If content-type is not NIL, it will be used as a the content type for all files in the folder. Otherwise (which is the default) the content type of each file will be determined as usual.

uri path optional content-type result Creates and returns a request dispatch function which will dispatch to a handler function which emits the file denoted by the pathname designator PATH with content type CONTENT-TYPE if the SCRIPT-NAME of the request matches the string URI. If CONTENT-TYPE is NIL, tries to determine the content type via the file's suffix. description lambda-list [[declaration* | documentation]] form* Defines a handler as if by DEFUN and optionally registers it with a URI so that it will be found by DISPATCH-EASY-HANDLERS.

description is either a symbol name or a list matching the destructuring lambda list 

(name &key uri acceptor-names default-parameter-type default-request-type).
lambda-list is a list the elements of which are either a symbol var or a list matching the destructuring lambda list 
(var &key real-name parameter-type init-form request-type).
The resulting handler will be a Lisp function with the name name and keyword parameters named by the var symbols. Each var will be bound to the value of the GET or POST parameter called real-name (a string) before the body of the function is executed. If real-name is not provided, it will be computed by downcasing the symbol name of var.

If uri (which is evaluated) is provided, then it must be a string or a function designator for a unary function. In this case, the handler will be returned by DISPATCH-EASY-HANDLERS, if uri is a string and the script name of the current request is uri, or if uri designates a function and applying this function to the current REQUEST object returns a true value.

acceptor-names (which is evaluated) can be a list of symbols which means that the handler will only be returned by DISPATCH-EASY-HANDLERS in acceptors which have one of these names (see ACCEPTOR-NAME). acceptor-names can also be the symbol T which means that the handler will be returned by DISPATCH-EASY-HANDLERS in every acceptor.

Whether the GET or POST parameter (or both) will be taken into consideration, depends on request-type which can be :GET, :POST, :BOTH, or NIL. In the last case, the value of default-request-type (the default of which is :BOTH) will be used.

The value of var will usually be a string (unless it resulted from a file upload in which case it won't be converted at all), but if parameter-type (which is evaluated) is provided, the string will be converted to another Lisp type by the following rules:

If the corresponding GET or POST parameter wasn't provided by the client, var's value will be NIL. If parameter-type is 'STRING, var's value remains as is. If parameter-type is 'INTEGER and the parameter string consists solely of decimal digits, var's value will be the corresponding integer, otherwise NIL. If parameter-type is 'KEYWORD, var's value will be the keyword obtained by interning the upcased parameter string into the keyword package. If parameter-type is 'CHARACTER and the parameter string is of length one, var's value will be the single character of this string, otherwise NIL. If parameter-type is 'BOOLEAN, var's value will always be T (unless it is NIL by the first rule above, of course). If parameter-type is any other atom, it is supposed to be a function designator for a unary function which will be called to convert the string to something else.

Those were the rules for simple parameter types, but parameter-type can also be a list starting with one of the symbols LIST, ARRAY, or HASH-TABLE. The second value of the list must always be a simple parameter type as in the last paragraph - we'll call it the inner type below.

In the case of 'LIST, all GET/POST parameters called real-name will be collected, converted to the inner type as by the rules above, and assembled into a list which will be the value of var.

In the case of 'ARRAY, all GET/POST parameters which have a name like the result of 

(format nil "~A[~A]" real-name n)
where n is a non-negative integer, will be assembled into an array where the nth element will be set accordingly, after conversion to the inner type. The array, which will become the value of var, will be big enough to hold all matching parameters, but not bigger. Array elements not set as described above will be NIL. Note that VAR will always be bound to an array, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found.

The full form of a 'HASH-TABLE parameter type is 

(hash-table inner-type key-type test-function)
but key-type and test-function can be left out in which case they default to 'STRING and 'EQUAL, respectively. For this parameter type, all GET/POST parameters which have a name like the result of 
(format nil "~A{~A}" real-name key)
(where key is a string that doesn't contain curly brackets) will become the values (after conversion to inner-type) of a hash table with test function test-function where key (after conversion to key-type) will be the corresponding key. Note that var will always be bound to a hash table, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found.

To make matters even more complicated, the three compound parameter types also have an abbreviated form - just one of the symbols LIST, ARRAY, or HASH-TABLE. In this case, the inner type will default to 'STRING.

If parameter-type is not provided or NIL, default-parameter-type (the default of which is 'STRING) will be used instead.

If the result of the computations above would be that var would be bound to NIL, then init-form (if provided) will be evaluated instead, and var will be bound to the result of this evaluation.

Handlers built with this macro are constructed in such a way that the resulting Lisp function is useful even outside of Hunchentoot. Specifically, all the parameter computations above will only happen if *REQUEST* is bound, i.e. if we're within a Hunchentoot request. Otherwise, var will always be bound to the result of evaluating init-form unless a corresponding keyword argument is provided.

The example code that comes with Hunchentoot contains an example which demonstrates some of the features of DEFINE-EASY-HANDLER.

request result This is a dispatcher which returns the appropriate handler defined with DEFINE-EASY-HANDLER, if there is one. For each incoming request, the acceptor (in PROCESS-CONNECTION) creates a REQUEST object and makes it available to handlers via the special variable *REQUEST*. This object contains all relevant information about the request and this section collects the functions which can be used to query such an object. In all function where request is an optional or keyword parameter, the default is *REQUEST*.

If you need more fine-grained control over the behaviour of request objects, you can subclass REQUEST and initialize the REQUEST-CLASS slot of the ACCEPTOR class accordingly. The acceptor will generate request objects of the class named by this slot.

Objects of this class hold all the information about an incoming request. They are created automatically by acceptors and can be accessed by the corresponding handler. You should not mess with the slots of these objects directly, but you can subclass REQUEST in order to implement your own behaviour. See the REQUEST-CLASS slot of the ACCEPTOR class. The current REQUEST object while in the context of a request. optional request string{, list} Returns the 'X-Forwarded-For' incoming http header as the second value in the form of a list of IP addresses and the first element of this list as the first value if this header exists. Otherwise returns the value of REMOTE-ADDR as the only value. name optional request string Returns the GET or the POST parameter with name name (a string) - or NIL if there is none. If both a GET and a POST parameter with the same name exist the GET parameter is returned. Search is case-sensitive. See also GET-PARAMETER and POST-PARAMETER. name optional request string Returns the value of the GET parameter (as provided via the request URI) named by the string name as a string (or NIL if there ain't no GET parameter with this name). Note that only the first value will be returned if the client provided more than one GET parameter with the name name. See also GET-PARAMETERS*. name optional request string Returns the value of the POST parameter (as provided in the request's body) named by the string name. Note that only the first value will be returned if the client provided more than one POST parameter with the name name. This value will usually be a string (or NIL if there ain't no POST parameter with this name). If, however, the browser sent a file through a multipart/form-data form, the value of this function is a three-element list 
(path file-name content-type)
where path is a pathname denoting the place were the uploaded file was stored, file-name (a string) is the file name sent by the browser, and content-type (also a string) is the content type sent by the browser. The file denoted by path will be deleted after the request has been handled - you have to move or copy it somewhere else if you want to keep it.

POST parameters will only be computed if the content type of the request body was multipart/form-data or application/x-www-form-urlencoded. Although this function is called POST-PARAMETER, you can instruct Hunchentoot to compute these parameters for other request methods by setting *METHODS-FOR-POST-PARAMETERS*.

See also POST-PARAMETERS and *TMP-DIRECTORY*.

optional request alist Returns an alist of all GET parameters (as provided via the request URI). The car of each element of this list is the parameter's name while the cdr is its value (as a string). The elements of this list are in the same order as they were within the request URI. See also GET-PARAMETER. optional request alist Returns an alist of all POST parameters (as provided via the request's body). The car of each element of this list is the parameter's name while the cdr is its value. The elements of this list are in the same order as they were within the request's body.

See also POST-PARAMETER.

A list of the request method types (as keywords) for which Hunchentoot will try to compute post-parameters. name optional request string Returns the cookie with the name name (a string) as sent by the browser - or NIL if there is none. optional request alist Returns an alist of all cookies associated with the REQUEST object request. optional request host Returns the 'Host' incoming http header value. optional request string Returns the query string of the REQUEST object request. That's the part behind the question mark (i.e. the GET parameters). optional request result Returns the 'Referer' (sic!) http header. optional request keyword Returns the request method as a Lisp keyword. optional request uri Returns the request URI. optional request keyword Returns the request protocol as a Lisp keyword. optional request result Returns the 'User-Agent' http header. name optional request header Returns the incoming header with name name. name can be a keyword (recommended) or a string. optional request alist Returns an alist of the incoming headers associated with the REQUEST object request. optional request address Returns the address the current request originated from. optional request port Returns the port the current request originated from. optional request address The IP address of the local system that the client connected to. optional request port The TCP port number of the local system that the client connected to. optional request script-name Returns the file name of the REQUEST object request. That's the requested URI without the query string (i.e the GET parameters). symbol optional request value, present-p This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL. symbol optional request | Removes the value associated with symbol from the REQUEST object request. optional request result Returns as two values the user and password (if any) as encoded in the 'AUTHORIZATION' header. Returns NIL if there is no such header. The external format used to compute the REQUEST object. If this is not NIL, it should be a unary function which will be called with a pathname for each file which is uploaded to Hunchentoot. The pathname denotes the temporary file to which the uploaded file is written. The hook is called directly before the file is created. At this point, *REQUEST* is already bound to the current REQUEST object, but obviously you can't access the post parameters yet. key request external-format force-text force-binary want-stream raw-body-or-stream Returns the content sent by the client in the request body if there was any (unless the content type was multipart/form-data in which case NIL is returned). By default, the result is a string if the type of the Content-Type media type is "text", and a vector of octets otherwise. In the case of a string, the external format to be used to decode the content will be determined from the charset parameter sent by the client (or otherwise *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* will be used).

You can also provide an external format explicitly (through external-format) in which case the result will unconditionally be a string. Likewise, you can provide a true value for force-text which will force Hunchentoot to act as if the type of the media type had been "text" (with external-format taking precedence if provided). Or you can provide a true value for force-binary which means that you want a vector of octets at any rate. (If both force-text and force-binary are true, an error will be signaled.)

If, however, you provide a true value for want-stream, the other parameters are ignored and you'll get the content (flexi) stream to read from it yourself. It is then your responsibility to read the correct amount of data, because otherwise you won't be able to return a response to the client. The stream will have its octet position set to 0. If the client provided a Content-Length header, the stream will also have a corresponding bound, so no matter whether the client used chunked encoding or not, you can always read until EOF.

If the content type of the request was multipart/form-data or application/x-www-form-urlencoded, the content has been read by Hunchentoot already and you can't read from the stream anymore.

You can call RAW-POST-DATA more than once per request, but you can't mix calls which have different values for want-stream.

Note that this function is slightly misnamed because a client can send content even if the request method is not POST.

key request external-format | Recomputes the GET and POST parameters for the REQUEST object request. This only makes sense if you're switching external formats during the request. request nil This function is called by PROCESS-CONNECTION after the incoming headers have been read. It calls HANDLE-REQUEST (and is more or less just a thin wrapper around it) to select and call a handler and send the output of this handler to the client. Note that PROCESS-CONNECTION is called once per connection and loops in case of a persistent connection while PROCESS-REQUEST is called anew for each request.

The return value of this function is ignored.

Like PROCESS-CONNECTION, this is another function the behaviour of which you should only modify if you really, really know what you're doing.

acceptor request content This function is called by PROCESS-REQUEST once the request has been read and a REQUEST object has been created. Its job is to actually handle the request, i.e. to return something to the client.

The default method calls the acceptor's request dispatcher, but you can of course implement a different behaviour. The default method also sets up standard error handling for the handler.

Might be a good place to bind or rebind special variables which can then be accessed by your handlers.

acceptor request content This function is called to actually dispatch the request once the standard logging and error handling has been set up. ACCEPTOR subclasses implement methods for this function in order to perform their own request routing. If a method does not want to handle the request, it is supposed to invoke CALL-NEXT-METHOD so that the next ACCEPTOR in the inheritance chain gets a chance to handle the request. request cookies request get-parameters name request result request headers request post-parameters request query-string request address request port request address request port request acceptor request method request uri request protocol request result These are various generic readers which are used to read information about a REQUEST object. If you are writing a handler, you should not use these readers but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic readers are only exported for users who want to create their own subclasses of REQUEST. For each incoming request, the acceptor (in PROCESS-CONNECTION) creates a REPLY object and makes it available to handlers via the special variable *REPLY*. This object contains all relevant information (except for the content body) about the reply that will be sent to the client and this section collects the functions which can be used to query and modify such an object. In all function where reply is an optional or keyword parameter, the default is *REPLY*.

If you need more fine-grained control over the behaviour of reply objects, you can subclass REPLY and initialize the REPLY-CLASS slot of the ACCEPTOR class accordingly. The acceptor will generate reply objects of the class named by this slot.

Objects of this class hold all the information about an outgoing reply. They are created automatically by Hunchentoot and can be accessed and modified by the corresponding handler.

You should not mess with the slots of these objects directly, but you can subclass REPLY in order to implement your own behaviour. See the :reply-class initarg of the ACCEPTOR class.

The current REPLY object in the context of a request. name optional reply string HEADER-OUT returns the outgoing http header named by the keyword name if there is one, otherwise NIL. SETF of HEADER-OUT changes the current value of the header named name. If no header named name exists, it is created. For backwards compatibility, name can also be a string in which case the association between a header and its name is case-insensitive.

Note that the header 'Set-Cookie' cannot be queried by HEADER-OUT and must not be set by SETF of HEADER-OUT. See also HEADERS-OUT*, CONTENT-TYPE*, CONTENT-LENGTH*, COOKIES-OUT*, and COOKIE-OUT.

optional reply alist Returns an alist of the outgoing headers associated with the REPLY object reply. See also HEADER-OUT. optional reply content-length The outgoing 'Content-Length' http header of reply. optional reply content-type The outgoing 'Content-Type' http header of reply. name optional reply result Returns the current value of the outgoing cookie named name. Search is case-sensitive. optional reply alist Returns or sets an alist of the outgoing cookies associated with the REPLY object reply. optional reply return-code Gets or sets the http return code of reply. The return code of each REPLY object is initially set to +HTTP-OK+. stream Sends the initial status line and all headers as determined by the REPLY object *REPLY*. Returns a binary stream to which the body of the reply can be written. Once this function has been called, further changes to *REPLY* don't have any effect. Also, automatic handling of errors (i.e. sending the corresponding status code to the browser, etc.) is turned off for this request and functions like REDIRECT or to ABORT-REQUEST-HANDLER won't have the desired effect once the headers are sent.

If your handlers return the full body as a string or as an array of octets, you should not call this function. If a handler calls SEND-HEADERS , its return value is ignored.

optional reply external-format Gets or sets the external format of reply which is used for character output. The default content-type header which is returned to the client. The values of these constants are 100, 101, 200, 201, 202, 203, 204, 205, 206, 207, 300, 301, 302, 303, 304, 305, 307, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 424, 500, 501, 502, 503, 504, and 505. See RETURN-CODE. reply content-length reply content-type reply headers-out These are various generic readers which are used to read information about a REPLY object. If you are writing a handler, you should not use these readers but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic readers are only exported for users who want to create their own subclasses of REPLY. reply result reply result reply result These are various generic accessors which are used to query and modify a REPLY objects. If you are writing a handler, you should not use these accessors but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic accessors are only exported for users who want to create their own subclasses of REPLY. Hunchentoot supports sessions: Once a request handler has called START-SESSION, Hunchentoot uses either cookies or (if the client doesn't send the cookies back) rewrites URLs to keep track of this client, i.e. to provide a kind of 'state' for the stateless http protocol. The session associated with the client is a CLOS object which can be used to store arbitrary data between requests.

Hunchentoot makes some reasonable effort to prevent eavesdroppers from hijacking sessions (see below), but this should not be considered really secure. Don't store sensitive data in sessions and rely solely on the session mechanism as a safeguard against malicious users who want to get at this data!

For each request there's one SESSION object which is accessible to the handler via the special variable *SESSION*. This object holds all the information available about the session and can be accessed with the functions described in this chapter. Note that the internal structure of SESSION objects should be considered opaque and may change in future releases of Hunchentoot.

Sessions are automatically verified for validity and age when the REQUEST object is instantiated, i.e. if *SESSION* is not NIL then this session is valid (as far as Hunchentoot is concerned) and not too old. Old sessions are automatically removed.

Hunchentoot also provides a SESSION-REGENERATE-COOKIE-VALUE function that creates a new cookie value. This helps to prevent against session fixation attacks, and should be used when a user logs in according to the application.

SESSION objects are automatically maintained by Hunchentoot. They should not be created explicitly with MAKE-INSTANCE but implicitly with START-SESSION and they should be treated as opaque objects.

You can ignore Hunchentoot's SESSION objects and implement your own sessions if you provide corresponding methods for SESSION-COOKIE-VALUE and SESSION-VERIFY.

session Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this case the function will also send a session cookie to the browser. symbol optional session value, present-p This accessor can be used to associate arbitrary data with the the symbol symbol in the SESSION object session. present-p is true if such data was found, otherwise NIL. The default value for session is *SESSION*.

If SETF of SESSION-VALUE is called with session being NIL then a session is automatically instantiated with START-SESSION.

symbol optional session | Removes the value associated with symbol from session if there is one. The current session while in the context of a request, or NIL. session | Completely removes the SESSION object session from Hunchentoot's internal session database. optional acceptor | Removes all stored sessions of acceptor. The default for acceptor is *ACCEPTOR*. session cookie Regenerates the session cookie value. This should be used when a user logs in according to the application to prevent against session fixation attacks. The cookie value being dependent on ID, USER-AGENT, REMOTE-ADDR, START, and *SESSION-SECRET*, the only value we can change is START to regenerate a new value. Since we're generating a new cookie, it makes sense to have the session being restarted, in time. That said, because of this fact, calling this function twice in the same second will regenerate twice the same value. Whether HTML pages should possibly be rewritten for cookie-less session-management. The content types for which url-rewriting is OK. See *REWRITE-FOR-SESSION-URLS*. Whether the client's remote IP (as returned by REAL-REMOTE-ADDR) should be encoded into the session string. If this value is true, a session will cease to be accessible if the client's remote IP changes.

This might for example be an issue if the client uses a proxy server which doesn't send correct 'X-Forwarded-For' headers.

session remote-addr The remote IP address of the client when this session was started (as returned by REAL-REMOTE-ADDR). Whether the 'User-Agent' header should be encoded into the session string. If this value is true, a session will cease to be accessible if the client sends a different 'User-Agent' header. session user-agent The incoming 'User-Agent' header that was sent when this session was created. session max-time Gets or sets the time (in seconds) after which session expires if it's not used. The default time (in seconds) after which a session times out. A session GC (see function SESSION-GC) will happen every *SESSION-GC-FREQUENCY* requests (counting only requests which create a new session) if this variable is not NIL. See SESSION-CREATED. | Removes sessions from the current session database which are too old - see SESSION-TOO-OLD-P. session generalized-boolean Returns true if the SESSION object session has not been active in the last (session-max-time session) seconds. session session-id The unique ID (an INTEGER) of the session. session universal-time The time this session was started. For everyday session usage, you will probably just use START-SESSION, SESSION-VALUE, and maybe DELETE-SESSION-VALUE and *SESSION*. However, there are two ways to customize the way Hunchentoot maintains sessions.

One way is to mostly leave the session mechanism intact but to tweak it a bit:

  • The publicly visible part of a session is encoded using a secret which you can set yourself.
  • And it is stored using a cookie (or GET parameter) name that you can override.
  • Each session receives a new ID when it is created and you can implement a more robust way to do that.
  • You can arrange to be called whenever a session is created to trigger some action. You might also do this to invent your own session garbage collection.
  • By default, all sessions are stored in a global alist in memory. You can't change the alist part, but you can distribute your sessions over different "databases".
  • By default, every operation which modifies sessions or one of the session databases is guarded by a global lock, but you can arrange to provide different locks for this.

The other way to customize Hunchentoot's sessions is to completely replace them. This is actually pretty easy: Create your own class to store state (which doesn't have to and probably shouldn't inherit from SESSION) and implement methods for SESSION-VERIFY and SESSION-COOKIE-VALUE - that's it. Hunchentoot will continue to use cookies and/or to rewrite URLs to keep track of session state and it will store "the current session" (whatever that is in your implementation) in *SESSION*. Everything else (like persisting sessions, GC, getting and setting values) you'll have to take care of yourself and the other session functions (like START-SESSION or SESSION-VALUE) won't work anymore. (Almost) total freedom, but a lot of responsibility as well... :)

A random ASCII string that's used to encode the public session data. This variable is initially unbound and will be set (using RESET-SESSION-SECRET) the first time a session is created, if necessary. You can prevent this from happening if you set the value yourself before starting acceptors. secret Sets *SESSION-SECRET* to a new random value. All old sessions will cease to be valid. acceptor name Returns the name (a string) of the cookie (or the GET parameter) which is used to store a session on the client side. The default is to use the string "hunchentoot-session", but you can specialize this function if you want another name. acceptor new-session result This function is called whenever a new session has been created. There's a default method which might trigger a session GC based on the value of *SESSION-GC-FREQUENCY*.

The return value is ignored.

acceptor id Returns the next sequential session ID, an integer, which should be unique per session. The default method uses a simple global counter and isn't guarded by a lock. For a high-performance production environment you might consider using a more robust implementation. acceptor database Returns the current session database which is an alist where each car is a session's ID and the cdr is the corresponding SESSION object itself. The default is to use a global list for all acceptors. acceptor key whole-db-p lock A function which returns a lock that will be used to prevent concurrent access to sessions. The first argument will be the acceptor that handles the current request, the second argument is true if the whole (current) session database is modified. If it is NIL, only one existing session in the database is modified.

This function can return NIL which means that sessions or session databases will be modified without a lock held (for example for single-threaded environments). The default is to always return a global lock (ignoring the acceptor argument) for Lisps that support threads and NIL otherwise.

request session-or-nil Tries to get a session identifier from the cookies (or alternatively from the GET parameters) sent by the client (see SESSION-COOKIE-NAME and SESSION-COOKIE-VALUE). This identifier is then checked for validity against the REQUEST object request. On success the corresponding session object (if not too old) is returned (and updated). Otherwise NIL is returned.

A default method is provided and you only need to write your own one if you want to maintain your own sessions.

session string Returns a string which can be used to safely restore the session session if as session has already been established. This is used as the value stored in the session cookie or in the corresponding GET parameter and verified by SESSION-VERIFY.

A default method is provided and there's no reason to change it unless you want to use your own session objects.

Outgoing cookies are stored in the request's REPLY object (see COOKIE-OUT and COOKIES-OUT*). They are CLOS objects defined like this: 
(defclass cookie ()
  ((name :initarg :name
         :reader cookie-name
         :type string
         :documentation "The name of the cookie - a string.")
   (value :initarg :value
          :accessor cookie-value
          :initform ""
          :documentation "The value of the cookie. Will be URL-encoded when sent to the browser.")
   (expires :initarg :expires
            :initform nil
            :accessor cookie-expires
            :documentation "The time (a universal time) when the cookie expires (or NIL).")
   (max-age :initarg :max-age
            :initform nil
            :accessor cookie-max-age
            :documentation "The time delta (in seconds) after which the cookie expires (or NIL).")
   (path :initarg :path
         :initform nil
         :accessor cookie-path
         :documentation "The path this cookie is valid for (or NIL).")
   (domain :initarg :domain
           :initform nil
           :accessor cookie-domain
           :documentation "The domain this cookie is valid for (or NIL).")
   (secure :initarg :secure
           :initform nil
           :accessor cookie-secure
           :documentation "A generalized boolean denoting whether this is a secure cookie.")
   (http-only :initarg :http-only
              :initform nil
              :accessor cookie-http-only
              :documentation "A generalized boolean denoting whether this is a HttpOnly cookie.")))
The reader COOKIE-NAME and the accessors COOKIE-VALUE, COOKIE-EXPIRES, COOKIE-MAX-AGE, COOKIE-PATH, COOKIE-DOMAIN, COOKIE-SECURE, and COOKIE-HTTP-ONLY are all exported from the HUNCHENTOOT package. For now, the class name itself is not exported. name key value expires path domain secure http-only reply cookie Creates a COOKIE object from the parameters provided to this function and adds it to the outgoing cookies of the REPLY object reply. If a cookie with the same name (case-sensitive) already exists, it is replaced. The default for reply is *REPLY*. The default for value is the empty string. cookie optional reply cookie Adds the COOKIE object cookie to the outgoing cookies of the REPLY object reply. If a cookie with the same name (case-sensitive) already exists, it is replaced. The default for reply is *REPLY*. Hunchentoot can log accesses and diagnostic messages to two separate destinations, which can be either files in the file system or streams. Logging can also be disabled by setting the ACCESS-LOG-DESTINATION and MESSAGE-LOG-DESTINATION slots in the ACCEPTOR to NIL. The two slots can be initialized by providing the :ACCESS-LOG-DESTINATION and :MESSAGE-LOG-DESTINATION initialization arguments when creating the acceptor or set by setting the slots through its ACCEPTOR-MESSAGE-LOG-DESTINATION and ACCEPTOR-ACCESS-LOG-DESTINATION accessors.

When the path for the message or accept log is set to a variable holding an output stream, hunchentoots writes corresponding log entries to that stream. By default, Hunchentoot logs to *STANDARD-ERROR*.

Access logging is done in a format similar to what the Apache web server can write so that logfile analysis using standard tools is possible. Errors during request processing are logged to a separate file.

The standard logging mechanism is deliberately simple and slow. The log files are opened for each log entry and closed again after writing, and access to them is protected by a global lock. Derived acceptor classes can implement methods for the ACCEPTOR-LOG-MESSAGE and ACCEPTOR-LOG-ACCESS generic functions in order to log differently (e.g. to a central logging server or in a different file format.

Errors happening within a handler which are not caught by the handler itself are handled by Hunchentoot by logging them to the established ACCEPTOR-MESSAGE-LOG-DESTINATION.

log-level format-string rest format-arguments result Convenience function which calls the message logger of the current acceptor (if there is one) with the same arguments it accepts. Returns NIL if there is no message logger or whatever the message logger returns.

This is the function which Hunchentoot itself uses to log errors it catches during request processing.

Whether Lisp errors in request handlers should be logged. Whether Lisp backtraces should be logged. Only has an effect if *LOG-LISP-ERRORS-P* is true as well. Whether Lisp warnings in request handlers should be logged. Log level for Lisp errors. Should be one of :ERROR (the default), :WARNING, or :INFO. Log level for Lisp warnings. Should be one of :ERROR, :WARNING (the default), or :INFO.

This section describes how Hunchentoot deals with exceptional situations. See also the secion about logging.

When an error occurs while processing a request, Hunchentoot's default behavior is to catch the error, log it and optionally display it to the client in the HTML response. This behavior can be customized through the values of a number of special variables, which are documented below.

If the value of this variable is NIL (the default is T), then errors which happen while a request is handled aren't caught as usual, but instead your Lisp's debugger is invoked. This variable should obviously always be set to a true value in a production environment. See MAYBE-INVOKE-DEBUGGER if you want to fine-tune this behaviour. Whether Lisp errors should be shown in HTML output. Note that this only affects canned responses generated by Lisp. If an error template is present for the "internal server error" status code, this special variable is not used (see acceptor-status-message). Whether Lisp backtraces should be shown in HTML output if *SHOW-LISP-ERRORS-P* is true and an error occurs. condition | This generic function is called whenever a condition condition is signaled in Hunchentoot. You might want to specialize it on specific condition classes for debugging purposes. The default method invokes the debugger with condition if *CATCH-ERRORS-P* is NIL. Superclass for all conditions related to Hunchentoot. Superclass for all errors related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. Signalled if a function was called with incosistent or illegal parameters. A subclass of HUNCHENTOOT-ERROR. Superclass for all warnings related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION. Various functions and variables which didn't fit into one of the other categories. optional result result This function can be called by a request handler at any time to immediately abort handling the request. This works as if the handler had returned result. See the source code of REDIRECT for an example. time optional request | This function is designed to be used inside a handler. If the client has sent an 'If-Modified-Since' header (see RFC 2616, section 14.25) and the time specified matches the universal time time then the header +HTTP-NOT-MODIFIED+ with no content is immediately returned to the client.

Note that for this function to be useful you should usually send 'Last-Modified' headers back to the client. See the code of CREATE-STATIC-FILE-DISPATCHER-AND-HANDLER for an example.

path optional content-type nil Sends the file denoted by the pathname designator path with content type content-type to the client. Sets the necessary handlers. In particular the function employs HANDLE-IF-MODIFIED-SINCE.

If content-type is NIL the function tries to determine the correct content type from the file's suffix or falls back to "application/octet-stream" as a last resort.

Note that this function calls SEND-HEADERS internally, so after you've called it, the headers are sent and the return value of your handler is ignored.

target key host port protocol add-session-id code | Sends back appropriate headers to redirect the client to target (a string).

If target is a full URL starting with a scheme, host, port, and protocol are ignored. Otherwise, target should denote the path part of a URL, protocol must be one of the keywords :HTTP or :HTTPS, and the URL to redirect to will be constructed from host, port, protocol, and target.

code must be a 3xx HTTP redirection status code to send to the client. It defaults to 302 ("Found"). If host is not provided, the current host (see HOST) will be used. If protocol is the keyword :HTTPS, the client will be redirected to a https URL, if it's :HTTP it'll be sent to a http URL. If both host and protocol aren't provided, then the value of protocol will match the current request.

optional realm | Sends back appropriate headers to require basic HTTP authentication (see RFC 2617) for the realm realm. The default value for realm is "Hunchentoot". | Adds appropriate headers to completely prevent caching on most browsers. optional acceptor generalized-boolean Whether the current connection to the client is secure. See ACCEPTOR-SSL-P. return-code string Returns a reason phrase for the HTTP return code return-code (which should be an integer) or NIL for return codes Hunchentoot doesn't know. optional time string Generates a time string according to RFC 1123. Default is current time. This can be used to send a 'Last-Modified' header - see HANDLE-IF-MODIFIED-SINCE. string optional external-format string URL-encodes a string using the external format external-format. The default for external-format is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*. string optional external-format string Decodes a URL-encoded string which is assumed to be encoded using the external format external-format, i.e. this is the inverse of URL-ENCODE. It is assumed that you'll rarely need this function, if ever. But just in case - here it is. The default for external-format is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*. string result Escapes the characters #\<, #\>, #\', #\", and #\& for HTML output. object generalized-boolean This function tests whether object is a non-empty string which is a token according to RFC 2068 (i.e. whether it may be used for, say, cookie names). pathspec result Given a pathname designator pathspec returns the MIME type (as a string) corresponding to the suffix of the file denoted by pathspec (or NIL). generalized-boolean Returns true if in the context of a request. Otherwise, NIL. This should be a pathname denoting a directory where temporary files can be stored. It is used for file uploads. If this variable is not NIL, it should be bound to a stream to which incoming and outgoing headers will be written for debugging purposes. A designator for a function without arguments which is called on a regular basis if *CLEANUP-INTERVAL* is not NIL. The initial value is the name of a function which invokes a garbage collection on 32-bit versions of LispWorks.

This variable is only available on LispWorks.

Should be NIL or a positive integer. The system calls *CLEANUP-FUNCTION* whenever *CLEANUP-INTERVAL* new worker threads (counted globally across all acceptors) have been created unless the value is NIL. The initial value is 100.

This variable is only available on LispWorks.

Hunchentoot comes with a test script which verifies that the example web server responds as expected. This test script uses the Drakma HTTP client library and thus shares a significant amount of its base code with Hunchentoot itself. Still, running the test script is a useful confidence test, and it is also possible to run the script across machines in order to verify a new Hunchentoot (or, for that matter Drakma) port.

To run the confidence test, start the example web server. Then, in your Lisp listener, type 

(hunchentoot-test:test-hunchentoot "http://localhost:4242")
You will see some diagnostic output and a summary line that reports whether any tests have failed. (You can also use the example certificate and key files in the test directory and start and test an https server instead.)

base-url key | Runs the built-in confidence test. base-url is the base URL to use for testing, it should not have a trailing slash. The keyword arguments accepted are for future extension and should not currently be used.

The script expects the Hunchentoot example test server to be running at the given base-url and retrieves various pages from that server, expecting certain responses.

By default, Hunchentoot intercepts all errors that occur while executing request handlers, logs them to the log file and displays a static error page to the user. While developing applications, you may want to change that behavior so that the debugger is invoked when an error occurs. You can set the *CATCH-ERRORS-P* to NIL to make that happen. Alternatively, you may want to have Hunchentoot display detailed error information in the error response page. You can set the *SHOW-LISP-ERRORS-P* to a true value to make that happen. If you don't want to see Lisp backtraces in these error pages, you can set *SHOW-LISP-BACKTRACES-P* to NIL. Hunchentoot's predecessor TBNL (which is short for "To Be Named Later") grew over the years as a toolkit that I used for various commercial and private projects. In August 2003, Daniel Barlow started a review of web APIs on the lispweb mailing list and I described the API of my hitherto-unreleased bunch of code (and christened it "TBNL").

It turned out that Jeff Caldwell had worked on something similar so he emailed me and proposed to join our efforts. As I had no immediate plans to release my code (which was poorly organized, undocumented, and mostly CMUCL-specific), I gave it to Jeff and he worked towards a release. He added docstrings, refactored, added some stuff, and based it on KMRCL to make it portable across several Lisp implementations.

Unfortunately, Jeff is at least as busy as I am so he didn't find the time to finish a full release. But in spring 2004 I needed a documented version of the code for a client of mine who thought it would be good if the toolkit were publicly available under an open source license. So I took Jeff's code, refactored again (to sync with the changes I had done in the meantime), and added documentation. This resulted in TBNL 0.1.0 (which initially required mod_lisp as its front-end).

In March 2005, Bob Hutchinson sent patches which enabled TBNL to use other front-ends than mod_lisp. This made me aware that TBNL was already almost a full web server, so eventually I wrote Hunchentoot which was a full web server, implemented as a wrapper around TBNL. Hunchentoot 0.1.0 was released at the end of 2005 and was originally LispWorks-only.

Hunchentoot 0.4.0, released in October 2006, was the first release which also worked with other Common Lisp implementations. It is a major rewrite and also incorporates most of TBNL and replaces it completely.

Hunchentoot 1.0.0, released in February 2009, is again a major rewrite and should be considered work in progress. It moved to using the usocket and Bordeaux Threads libraries for non-LispWorks Lisps, thereby removing most of the platform dependent code. Threading behaviour was made controllable through the introduction of taskmasters. mod_lisp support and several other things were removed in this release to simplify the code base (and partly due to the lack of interest). Several architectural changes (lots of them not backwards-compatible) were made to ease customization of Hunchentoot's behaviour. A significant part of the 1.0.0 redesign was done by Hans Hübner.

Here are all exported symbols of the HUNCHENTOOT package in alphabetical order linked to their corresponding documentation entries: Thanks to Jeff Caldwell - TBNL would not have been released without his efforts. Thanks to Stefan Scholl and Travis Cross for various additions and fixes to TBNL, to Michael Weber for initial file upload code, and to Janis Dzerins for his RFC 2388 code. Thanks to Bob Hutchison for his code for multiple front-ends (which made me realize that TBNL was already pretty close to a "real" web server) and the initial UTF-8 example. Thanks to Hans Hübner for a lot of architectural and implementation enhancements for the 1.0.0 release and also for transferring the documentation to sane XHTML. Thanks to John Foderaro's AllegroServe for inspiration. Thanks to Uwe von Loh for the Hunchentoot logo.

Hunchentoot originally used code from ACL-COMPAT, specifically the chunking code from Jochen Schmidt. (This has been replaced by Chunga.) When I ported Hunchentoot to other Lisps than LispWorks, I stole code from ACL-COMPAT, KMRCL, and trivial-sockets for implementation-dependent stuff like sockets and MP. (This has been replaced by Bordeaux Threads and usocket.)

Parts of this documentation were prepared with DOCUMENTATION-TEMPLATE, no animals were harmed.

BACK TO MY HOMEPAGE

hunchentoot-1.2.35/make-docstrings.lisp0000644000004100000410000002076512656661410020174 0ustar www-datawww-data;; -*- Lisp -*- (defpackage :make-docstrings (:use :cl) (:export #:parse-doc)) (in-package :make-docstrings) (defclass formatting-stream (trivial-gray-streams:fundamental-character-input-stream) ((understream :initarg :understream :reader understream) (width :initarg :width :initform (error "missing :width argument to formatting-stream creation") :reader width) (column :initform 0 :accessor column) (word-wrap-p :initform t :accessor word-wrap-p) (word-buffer :initform (make-array 1000 :element-type 'character :adjustable t :fill-pointer 0) :reader word-buffer))) (defun write-char% (char stream) (incf (column stream)) (write-char char (understream stream))) (defun print-newline (stream) (write-char #\Newline (understream stream)) (setf (column stream) 0)) (defun buffer-not-empty-p (stream) (plusp (length (word-buffer stream)))) (defun maybe-flush-word (stream) (when (buffer-not-empty-p stream) (cond ((< (width stream) (+ (column stream) (length (word-buffer stream)))) (print-newline stream)) ((plusp (column stream)) (write-char% #\Space stream))) (loop for char across (word-buffer stream) do (write-char% char stream)) (setf (fill-pointer (word-buffer stream)) 0))) (defmethod trivial-gray-streams:stream-write-char ((stream formatting-stream) char) (if (word-wrap-p stream) (cond ((eql #\Space char) (maybe-flush-word stream)) ((eql #\Newline char) (maybe-flush-word stream) (print-newline stream)) (t (vector-push-extend char (word-buffer stream)))) (write-char char (understream stream)))) (defmethod trivial-gray-streams:stream-line-column (stream) (+ (column stream) (length (word-buffer stream)))) (defmethod trivial-gray-streams:stream-write-string ((stream formatting-stream) string &optional start end) (loop for i from (or start 0) below (or end (length string)) do (write-char (char string i) stream))) (defmethod trivial-gray-streams:stream-terpri ((stream formatting-stream)) (write-char #\Newline stream)) (defmethod close ((stream formatting-stream) &key abort) (unless abort (maybe-flush-word stream))) (defmethod (setf word-wrap-p) :before (new-value (stream formatting-stream)) (maybe-flush-word stream) (when (buffer-not-empty-p stream) (print-newline stream))) (defun test-wrap-stream (text) (with-output-to-string (s) (with-open-stream (s (make-instance 'formatting-stream :understream s :width 20)) (write-string text s) (setf (word-wrap-p s) nil) (format s "~&OFF~%") (write-string text s) (format s "~&ON~%") (setf (word-wrap-p s) t) (write-string text s)))) (defmacro replace-regexp (place regex replacement) `(setf ,place (cl-ppcre:regex-replace-all ,regex ,place ,replacement))) (defun collapse-whitespace (string) (replace-regexp string "[ \\t]*\\n[ \\t]*" #.(make-string 1 :initial-element #\Newline)) (replace-regexp string "(?, #\\', #\\\", and #\\& for HTML output." (with-output-to-string (out) (with-input-from-string (in string) (loop for char = (read-char in nil nil) while char do (case char ((#\<) (write-string "<" out)) ((#\>) (write-string ">" out)) ((#\") (write-string """ out)) ((#\') (write-string "'" out)) ((#\&) (write-string "&" out)) (otherwise (write-char char out))))))) (defun http-token-p (token) "This function tests whether OBJECT is a non-empty string which is a TOKEN according to RFC 2068 \(i.e. whether it may be used for, say, cookie names)." (and (stringp token) (plusp (length token)) (every (lambda (char) (and ;; CHAR is US-ASCII but not control character or ESC (< 31 (char-code char) 127) ;; CHAR is not 'tspecial' (not (find char "()<>@,;:\\\"/[]?={} " :test #'char=)))) token))) (defun rfc-1123-date (&optional (time (get-universal-time))) "Generates a time string according to RFC 1123. Default is current time. This can be used to send a 'Last-Modified' header - see HANDLE-IF-MODIFIED-SINCE." (multiple-value-bind (second minute hour date month year day-of-week) (decode-universal-time time 0) (format nil "~A, ~2,'0d ~A ~4d ~2,'0d:~2,'0d:~2,'0d GMT" (svref +day-names+ day-of-week) date (svref +month-names+ (1- month)) year hour minute second))) (defun iso-time (&optional (time (get-universal-time))) "Returns the universal time TIME as a string in full ISO format." (multiple-value-bind (second minute hour date month year) (decode-universal-time time) (format nil "~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d" year month date hour minute second))) (let ((counter 0)) (declare (ignorable counter)) (defun make-tmp-file-name (&optional (prefix "hunchentoot")) "Generates a unique name for a temporary file. This function is called from the RFC2388 library when a file is uploaded." (let ((tmp-file-name #+:allegro (pathname (system:make-temp-file-name prefix *tmp-directory*)) #-:allegro (loop for pathname = (make-pathname :name (format nil "~A-~A" prefix (incf counter)) :type nil :defaults *tmp-directory*) unless (probe-file pathname) return pathname))) (push tmp-file-name *tmp-files*) ;; maybe call hook for file uploads (when *file-upload-hook* (funcall *file-upload-hook* tmp-file-name)) tmp-file-name))) (defun quote-string (string) "Quotes string according to RFC 2616's definition of `quoted-string'." (with-output-to-string (out) (with-input-from-string (in string) (loop for char = (read-char in nil nil) while char unless (or (char< char #\Space) (char= char #\Rubout)) do (case char ((#\\) (write-string "\\\\" out)) ((#\") (write-string "\\\"" out)) (otherwise (write-char char out))))))) (defmacro upgrade-vector (vector new-type &key converter) "Returns a vector with the same length and the same elements as VECTOR \(a variable holding a vector) but having element type NEW-TYPE. If CONVERTER is not NIL, it should designate a function which will be applied to each element of VECTOR before the result is stored in the new vector. The resulting vector will have a fill pointer set to its end. The macro also uses SETQ to store the new vector in VECTOR." `(setq ,vector (loop with length = (length ,vector) with new-vector = (make-array length :element-type ,new-type :fill-pointer length) for i below length do (setf (aref new-vector i) ,(if converter `(funcall ,converter (aref ,vector i)) `(aref ,vector i))) finally (return new-vector)))) (defun ensure-parse-integer (string &key (start 0) end (radix 10)) (let ((end (or end (length string)))) (if (or (>= start (length string)) (> end (length string))) (error 'bad-request) (multiple-value-bind (integer stopped) (parse-integer string :start start :end end :radix radix :junk-allowed t) (if (/= stopped end) (error 'bad-request) integer))))) (defun url-decode (string &optional (external-format *hunchentoot-default-external-format*)) "Decodes a URL-encoded string which is assumed to be encoded using the external format EXTERNAL-FORMAT, i.e. this is the inverse of URL-ENCODE. It is assumed that you'll rarely need this function, if ever. But just in case - here it is. The default for EXTERNAL-FORMAT is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*." (when (zerop (length string)) (return-from url-decode "")) (let ((vector (make-array (length string) :element-type 'octet :fill-pointer 0)) (i 0) unicodep) (loop (unless (< i (length string)) (return)) (let ((char (aref string i))) (labels ((decode-hex (length) (ensure-parse-integer string :start i :end (incf i length) :radix 16)) (push-integer (integer) (vector-push integer vector)) (peek () (if (array-in-bounds-p string i) (aref string i) (error 'bad-request))) (advance () (setq char (peek)) (incf i))) (cond ((char= #\% char) (advance) (cond ((char= #\u (peek)) (unless unicodep (setq unicodep t) (upgrade-vector vector '(integer 0 65535))) (advance) (push-integer (decode-hex 4))) (t (push-integer (decode-hex 2))))) (t (push-integer (char-code (case char ((#\+) #\Space) (otherwise char)))) (advance)))))) (cond (unicodep (upgrade-vector vector 'character :converter #'code-char)) (t (octets-to-string vector :external-format external-format))))) (defun form-url-encoded-list-to-alist (form-url-encoded-list &optional (external-format *hunchentoot-default-external-format*)) "Converts a list FORM-URL-ENCODED-LIST of name/value pairs into an alist. Both names and values are url-decoded while doing this." (mapcar #'(lambda (entry) (destructuring-bind (name &optional value) (split "=" entry :limit 2) (cons (string-trim " " (url-decode name external-format)) (url-decode (or value "") external-format)))) form-url-encoded-list)) (defun cookies-to-alist (cookies) "Converts a list of cookies of the form \"key=value\" to an alist. No character set processing is done." (mapcar #'(lambda (entry) (destructuring-bind (name &optional value) (split "=" entry :limit 2) (cons (string-trim " " name) (or value "")))) cookies)) (defun url-encode (string &optional (external-format *hunchentoot-default-external-format*)) "URL-encodes a string using the external format EXTERNAL-FORMAT. The default for EXTERNAL-FORMAT is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*." (with-output-to-string (s) (loop for c across string for index from 0 do (cond ((or (char<= #\0 c #\9) (char<= #\a c #\z) (char<= #\A c #\Z) ;; note that there's no comma in there - because of cookies (find c "$-_.!*'()" :test #'char=)) (write-char c s)) (t (loop for octet across (string-to-octets string :start index :end (1+ index) :external-format external-format) do (format s "%~2,'0x" octet))))))) (defun parse-content-type (content-type-header) "Reads and parses a `Content-Type' header and returns it as three values - the type, the subtype, and the requests' character set as specified in the 'charset' parameter in the header, if there is one and if the content type is \"text\". CONTENT-TYPE-HEADER is supposed to be the corresponding header value as a string." (with-input-from-sequence (stream (map 'list 'char-code content-type-header)) (with-character-stream-semantics (let* ((*current-error-message* (format nil "Corrupted Content-Type header ~S:" content-type-header)) (type (read-token stream)) (subtype (if (eql #\/ (read-char* stream nil)) (read-token stream) (return-from parse-content-type ;; try to return something meaningful (values "application" "octet-stream" nil)))) (parameters (read-name-value-pairs stream)) (charset (cdr (assoc "charset" parameters :test #'string=))) (charset (when (string-equal type "text") charset))) (values type subtype charset))))) (defun keep-alive-p (request) "Returns a true value unless the incoming request's headers or the server's PERSISTENT-CONNECTIONS-P setting obviate a keep-alive reply. The second return value denotes whether the client has explicitly asked for a persistent connection." (let ((connection-values ;; the header might consist of different values separated by commas (when-let (connection-header (header-in :connection request)) (split "\\s*,\\s*" connection-header)))) (flet ((connection-value-p (value) "Checks whether the string VALUE is one of the values of the `Connection' header." (member value connection-values :test #'string-equal))) (let ((keep-alive-requested-p (connection-value-p "keep-alive"))) (values (and (acceptor-persistent-connections-p *acceptor*) (or (and (eq (server-protocol request) :http/1.1) (not (connection-value-p "close"))) (and (eq (server-protocol request) :http/1.0) keep-alive-requested-p))) keep-alive-requested-p))))) (defun address-string () "Returns a string with information about Hunchentoot suitable for inclusion in HTML output." (flet ((escape-for-html (arg) (if arg (escape-for-html arg) arg))) (format nil "
Hunchentoot ~A (~A ~A)~@[ at ~A~:[ (port ~D)~;~]~]
" *hunchentoot-version* +implementation-link+ (escape-for-html (lisp-implementation-type)) (escape-for-html (lisp-implementation-version)) (escape-for-html (or (host *request*) (acceptor-address *acceptor*))) (scan ":\\d+$" (or (host *request*) "")) (acceptor-port *acceptor*)))) (defun input-chunking-p () "Whether input chunking is currently switched on for *HUNCHENTOOT-STREAM* - note that this will return NIL if the stream not a chunked stream." (chunked-stream-input-chunking-p *hunchentoot-stream*)) (defun ssl-p (&optional (acceptor *acceptor*)) "Whether the current connection to the client is secure. See ACCEPTOR-SSL-P." (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 ,@body) #-:lispworks `(usocket:with-mapped-conditions () ,@body)) (defmacro with-conditions-caught-and-logged (() &body body) "Run BODY with conditions caught and logged by the *ACCEPTOR*. Errors are stopped right away so no other part of the software is impacted by them." `(block nil (handler-bind ((error ;; abort if there's an error which isn't caught inside (lambda (cond) (log-message* *lisp-errors-log-level* "Error while processing connection: ~A" cond) (return))) (warning ;; log all warnings which aren't caught inside (lambda (cond) (when *log-lisp-warnings-p* (log-message* *lisp-warnings-log-level* "Warning while processing connection: ~A" cond))))) ,@body))) hunchentoot-1.2.35/headers.lisp0000644000004100000410000003311512656661410016506 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defgeneric write-header-line (key value stream) (:documentation "Accepts a string KEY and a Lisp object VALUE and writes them directly to the client as an HTTP header line.") (:method (key (string string) stream) (write-string key stream) (write-char #\: stream) (write-char #\Space stream) (let ((start 0)) (loop (let ((end (or (position #\Newline string :start start) (length string)))) ;; skip empty lines, as they confuse certain HTTP clients (unless (eql start end) (unless (zerop start) (write-char #\Tab stream)) (write-string string stream :start start :end end) (write-char #\Return stream) (write-char #\Linefeed stream)) (setf start (1+ end)) (when (<= (length string) start) (return)))))) (:method (key (number number) stream) (write-header-line key (write-to-string number :escape nil :readably nil :base 10) stream)) (:method (key value stream) (write-header-line key (princ-to-string value) stream))) (defun maybe-add-charset-to-content-type-header (content-type external-format) "Given the contents of a CONTENT-TYPE header, add a charset= attribute describing the given EXTERNAL-FORMAT if no charset= attribute is already present and the content type is a text content type. Returns the augmented content type." (if (and (cl-ppcre:scan "(?i)^text" content-type) (not (cl-ppcre:scan "(?i);\\s*charset=" content-type))) (format nil "~A; charset=~(~A~)" content-type (flex:external-format-name external-format)) content-type)) (defun start-output (return-code &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. Called by PROCESS-REQUEST and/or SEND-HEADERS. The RETURN-CODE argument represents the integer return code of the request. The corresponding reason phrase is determined by calling the REASON-PHRASE function. The CONTENT provided represents the body data to send to the client, if any. If it is not specified, no body is written to the client. The handler function is expected to directly write to the stream in this case. Returns the stream that is connected to the client." (let* ((chunkedp (and (acceptor-output-chunking-p *acceptor*) (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)))) (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*) (when keep-alive-p (setq keep-alive-p ;; use keep-alive if there's a way for the client to ;; determine when all content is sent (or if there ;; is no content) (or chunkedp head-request-p (eql (return-code*) +http-not-modified+) (content-length*) content))) ;; now set headers for keep-alive and chunking (when chunkedp (setf (header-out :transfer-encoding) "chunked")) (cond (keep-alive-p (setf *finish-processing-socket* nil) (when (and (acceptor-read-timeout *acceptor*) (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 ;; client has explicitly asked for one (unless (header-out :connection) ; allowing for handler overriding (setf (header-out :connection) "Keep-Alive")) (setf (header-out :keep-alive) (format nil "timeout=~D" (acceptor-read-timeout *acceptor*))))) ((not (header-out-set-p :connection)) (setf (header-out :connection) "Close")))) (unless (and (header-out-set-p :server) (null (header-out :server))) (setf (header-out :server) (or (header-out :server) (acceptor-server-name *acceptor*)))) (setf (header-out :date) (rfc-1123-date)) (when (and (stringp content) (not content-modified-p) (starts-with-one-of-p (or (content-type*) "") *content-types-for-url-rewrite*)) ;; if the Content-Type header starts with one of the strings ;; in *CONTENT-TYPES-FOR-URL-REWRITE* then maybe rewrite the ;; content (setq content (maybe-rewrite-urls-for-session content))) (when (stringp content) ;; if the content is a string, convert it to the proper external format (setf content (string-to-octets content :external-format (reply-external-format*)) (content-type*) (maybe-add-charset-to-content-type-header (content-type*) (reply-external-format*)))) (when content ;; whenever we know what we're going to send out as content, set ;; 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) (send-response *acceptor* *hunchentoot-stream* return-code :headers (headers-out*) :cookies (cookies-out*) :content (unless head-request-p content)) ;; when processing a HEAD request, exit to return from PROCESS-REQUEST (when head-request-p (throw 'request-processed nil)) (when chunkedp ;; turn chunking on after the headers have been sent (unless (typep *hunchentoot-stream* 'chunked-stream) (setq *hunchentoot-stream* (make-chunked-stream *hunchentoot-stream*))) (setf (chunked-stream-output-chunking-p *hunchentoot-stream*) t)) *hunchentoot-stream*)) (defun send-response (acceptor stream status-code &key headers cookies content) "Send a HTTP response to the STREAM and log the event in ACCEPTOR. STATUS-CODE is the HTTP status code used in the response. HEADERS and COOKIES are used to create the response header. If CONTENT is provided, it is sent as the response body. If *HEADER-STREAM* is not NIL, the response headers are written to that stream when they are written to the client. STREAM is returned." (when content (setf (content-length*) (length content))) (when (content-length*) (if (assoc :content-length headers) (setf (cdr (assoc :content-length headers)) (content-length*)) (push (cons :content-length (content-length*)) headers))) ;; access log message (acceptor-log-access acceptor :return-code status-code) ;; Read post data to clear stream - Force binary mode to avoid OCTETS-TO-STRING overhead. (raw-post-data :force-binary t) (let* ((client-header-stream (flex:make-flexi-stream stream :external-format +latin-1+)) (header-stream (if *header-stream* (make-broadcast-stream *header-stream* client-header-stream) client-header-stream))) ;; start with status line (format header-stream "HTTP/1.1 ~D ~A~C~C" status-code (reason-phrase status-code) #\Return #\Linefeed) ;; write all headers from the REPLY object (loop for (key . value) in headers when value do (write-header-line (as-capitalized-string key) value header-stream)) ;; now the cookies (loop for (nil . cookie) in cookies do (write-header-line "Set-Cookie" (stringify-cookie cookie) header-stream)) (format header-stream "~C~C" #\Return #\Linefeed)) ;; now optional content (when content (write-sequence content stream) (finish-output stream)) stream) (defun send-headers () "Sends the initial status line and all headers as determined by the REPLY object *REPLY*. Returns a binary stream to which the body of the reply can be written. Once this function has been called, further changes to *REPLY* don't have any effect. Also, automatic handling of errors \(i.e. sending the corresponding status code to the browser, etc.) is turned off for this request. If your handlers return the full body as a string or as an array of octets you should NOT call this function. This function does not return control to the caller during HEAD request processing." (start-output (return-code*))) (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. 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 to close the connection instead, a timeout indicates that the connection timeout established by Hunchentoot has expired and we do not want to wait for another request any longer." (handler-case (let ((*current-error-message* "While reading initial request line:")) (with-mapped-conditions () (read-line* stream))) ((or end-of-file #-:lispworks usocket:timeout-error) ()))) (defun send-bad-request-response (stream &optional additional-info) "Send a ``Bad Request'' response to the client." (write-sequence (flex:string-to-octets (format nil "HTTP/1.0 ~D ~A~C~CConnection: close~C~C~C~CYour request could not be interpreted by this HTTP server~C~C~@[~A~]~C~C" +http-bad-request+ (reason-phrase +http-bad-request+) #\Return #\Linefeed #\Return #\Linefeed #\Return #\Linefeed #\Return #\Linefeed additional-info #\Return #\Linefeed)) stream)) (defun printable-ascii-char-p (char) (<= 32 (char-code char) 126)) (defun get-request-data (stream) "Reads incoming headers from the client via STREAM. Returns as multiple values the headers as an alist, the method, the URI, and the protocol of the request." (with-character-stream-semantics (let ((first-line (read-initial-request-line stream))) (when first-line (unless (every #'printable-ascii-char-p first-line) (send-bad-request-response stream "Non-ASCII character in request line") (return-from get-request-data nil)) (destructuring-bind (&optional method url-string protocol) (split "\\s+" first-line :limit 3) (unless url-string (send-bad-request-response stream) (return-from get-request-data nil)) (when *header-stream* (format *header-stream* "~A~%" first-line)) (let ((headers (and protocol (read-http-headers stream *header-stream*)))) (unless protocol (setq protocol "HTTP/0.9")) ;; maybe handle 'Expect: 100-continue' header (when-let (expectations (cdr (assoc* :expect headers))) (when (member "100-continue" (split "\\s*,\\s*" expectations) :test #'equalp) ;; according to 14.20 in the RFC - we should actually ;; check if we have to respond with 417 here (let ((continue-line (format nil "HTTP/1.1 ~D ~A" +http-continue+ (reason-phrase +http-continue+)))) (write-sequence (map 'list #'char-code continue-line) stream) (write-sequence +crlf+ stream) (write-sequence +crlf+ stream) (force-output stream) (when *header-stream* (format *header-stream* "~A~%" continue-line))))) (values headers (as-keyword method) url-string (as-keyword (trim-whitespace protocol))))))))) hunchentoot-1.2.35/log.lisp0000644000004100000410000000643112656661410015655 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defmacro with-log-stream ((stream-var destination lock) &body body) "Helper macro to write log entries. STREAM-VAR is a symbol that will be bound to the logging stream during the execution of BODY. DESTINATION is the logging destination, which can be either a pathname designator of the log file, a symbol designating an open stream or NIL if no logging should be done. LOCK refers to the lock that should be held during the logging operation. If DESTINATION is a pathname, a flexi stream with UTF-8 encoding will be created and bound to STREAM-VAR. If an error occurs while writing to the log file, that error will be logged to *ERROR-OUTPUT*. Note that logging to a file involves opening and closing the log file for every logging operation, which is overall costly. Web servers with high throughput demands should make use of a specialized logging function rather than relying on Hunchentoot's default logging facility." (with-unique-names (binary-stream) (with-rebinding (destination) (let ((body body)) `(when ,destination (with-lock-held (,lock) (etypecase ,destination ((or string pathname) (with-open-file (,binary-stream ,destination :direction :output :element-type 'octet :if-does-not-exist :create :if-exists :append #+:openmcl :sharing #+:openmcl :lock) (let ((,stream-var (make-flexi-stream ,binary-stream :external-format +utf-8+))) ,@body))) (stream (let ((,stream-var ,destination)) (prog1 (progn ,@body) (finish-output ,destination))))))))))) hunchentoot-1.2.35/easy-handlers.lisp0000644000004100000410000004027312656661410017635 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :hunchentoot) (defvar *dispatch-table* (list 'dispatch-easy-handlers) "A global list of dispatch functions.") (defvar *easy-handler-alist* nil "An alist of \(URI acceptor-names function) lists defined by DEFINE-EASY-HANDLER.") (defun compute-real-name (symbol) "Computes the `real' paramater name \(a string) from the Lisp symbol SYMBOL. Used in cases where no parameter name is provided." ;; we just downcase the symbol's name (string-downcase symbol)) (defun convert-parameter (argument type) "Converts the string ARGUMENT to TYPE where TYPE is one of the symbols STRING, CHARACTERS, INTEGER, KEYWORD, or BOOLEAN - or otherwise a function designator for a function of one argument. ARGUMENT can also be NIL in which case this function also returns NIL unconditionally." (when (listp argument) ;; this if for the case that ARGUMENT is NIL or the result of a ;; file upload (return-from convert-parameter argument)) (case type (string argument) (character (and (= (length argument) 1) (char argument 0))) (integer (ignore-errors* (parse-integer argument :junk-allowed t))) (keyword (as-keyword argument :destructivep nil)) (boolean t) (otherwise (funcall type argument)))) (defun compute-simple-parameter (parameter-name type parameter-reader) "Retrieves the parameter named PARAMETER-NAME using the reader PARAMETER-READER and converts it to TYPE." (convert-parameter (funcall parameter-reader parameter-name) type)) (defun compute-list-parameter (parameter-name type parameters) "Retrieves all parameters from PARAMETERS which are named PARAMETER-NAME, converts them to TYPE, and returns a list of them." (loop for (name . value) in parameters when (string= name parameter-name) collect (convert-parameter value type))) (defun compute-array-parameter (parameter-name type parameters) "Retrieves all parameters from PARAMETERS which are named like \"PARAMETER-NAME[N]\" \(where N is a non-negative integer), converts them to TYPE, and returns an array where the Nth element is the corresponding value." ;; see #+:sbcl (declare (sb-ext:muffle-conditions warning)) (let* ((index-value-list (loop for (full-name . value) in parameters for index = (register-groups-bind (name index-string) ("^(.*)\\[(\\d+)\\]$" full-name) (when (string= name parameter-name) (parse-integer index-string))) when index collect (cons index (convert-parameter value type)))) (array (make-array (1+ (reduce #'max index-value-list :key #'car :initial-value -1)) :initial-element nil))) (loop for (index . value) in index-value-list do (setf (aref array index) value)) array)) (defun compute-hash-table-parameter (parameter-name type parameters key-type test-function) "Retrieves all parameters from PARAMETERS which are named like \"PARAMETER-NAME{FOO}\" \(where FOO is any sequence of characters not containing curly brackets), converts them to TYPE, and returns a hash table with test function TEST-FUNCTION where the corresponding value is associated with the key FOO \(converted to KEY-TYPE)." (let ((hash-table (make-hash-table :test test-function))) (loop for (full-name . value) in parameters for key = (register-groups-bind (name key-string) ("^(.*){([^{}]+)}$" full-name) (when (string= name parameter-name) (convert-parameter key-string key-type))) when key do (setf (gethash key hash-table) (convert-parameter value type))) hash-table)) (defun compute-parameter (parameter-name parameter-type request-type) "Computes and returns the parameter\(s) called PARAMETER-NAME and converts it/them according to the value of PARAMETER-TYPE. REQUEST-TYPE is one of :GET, :POST, or :BOTH." (when (member parameter-type '(list array hash-table)) (setq parameter-type (list parameter-type 'string))) (let ((parameter-reader (ecase request-type (:get #'get-parameter) (:post #'post-parameter) (:both #'parameter))) (parameters (and (listp parameter-type) (case request-type (:get (get-parameters*)) (:post (post-parameters*)) (:both (append (get-parameters*) (post-parameters*))))))) (cond ((atom parameter-type) (compute-simple-parameter parameter-name parameter-type parameter-reader)) ((and (null (cddr parameter-type)) (eq (first parameter-type) 'list)) (compute-list-parameter parameter-name (second parameter-type) parameters)) ((and (null (cddr parameter-type)) (eq (first parameter-type) 'array)) (compute-array-parameter parameter-name (second parameter-type) parameters)) ((and (null (cddddr parameter-type)) (eq (first parameter-type) 'hash-table)) (compute-hash-table-parameter parameter-name (second parameter-type) parameters (or (third parameter-type) 'string) (or (fourth parameter-type) 'equal))) (t (parameter-error "Don't know what to do with parameter type ~S." parameter-type))))) (defun make-defun-parameter (description default-parameter-type default-request-type) "Creates a keyword parameter to be used by DEFINE-EASY-HANDLER. DESCRIPTION is one of the elements of DEFINE-EASY-HANDLER's LAMBDA-LIST and DEFAULT-PARAMETER-TYPE and DEFAULT-REQUEST-TYPE are the global default values." (when (atom description) (setq description (list description))) (destructuring-bind (parameter-name &key (real-name (compute-real-name parameter-name)) parameter-type init-form request-type) description `(,parameter-name (or (and (boundp '*request*) (compute-parameter ,real-name ,(or parameter-type default-parameter-type) ,(or request-type default-request-type))) ,init-form)))) (defmacro define-easy-handler (description lambda-list &body body) "Defines a handler with the body BODY and optionally registers it with a URI so that it will be found by DISPATCH-EASY-HANDLERS. DESCRIPTION is either a symbol NAME or a list matching the destructuring lambda list (name &key uri acceptor-names default-parameter-type default-request-type). LAMBDA-LIST is a list the elements of which are either a symbol VAR or a list matching the destructuring lambda list (var &key real-name parameter-type init-form request-type). The resulting handler will be a Lisp function with the name NAME and keyword parameters named by the VAR symbols. Each VAR will be bound to the value of the GET or POST parameter called REAL-NAME \(a string) before BODY is executed. If REAL-NAME is not provided, it will be computed by downcasing the symbol name of VAR. If URI \(which is evaluated) is provided, then it must be a string or a function designator for a function of one argument. In this case, the handler will be returned by DISPATCH-EASY-HANDLERS, if URI is a string and the script name of a request is URI, or if URI designates a function and applying this function to the current request object returns a true value. ACCEPTOR-NAMES \(which is evaluated) can be a list of symbols which means that the handler will be returned by DISPATCH-EASY-HANDLERS in acceptors which have one of these names \(see ACCEPTOR-NAME). ACCEPTOR-NAMES can also be the symbol T which means that the handler will be returned by DISPATCH-EASY-HANDLERS in every acceptor. Whether the GET or POST parameter \(or both) will be taken into consideration, depends on REQUEST-TYPE which can be :GET, :POST, :BOTH, or NIL. In the last case, the value of DEFAULT-REQUEST-TYPE \(the default of which is :BOTH) will be used. The value of VAR will usually be a string \(unless it resulted from a file upload in which case it won't be converted at all), but if PARAMETER-TYPE \(which is evaluated) is provided, the string will be converted to another Lisp type by the following rules: If the corresponding GET or POST parameter wasn't provided by the client, VAR's value will be NIL. If PARAMETER-TYPE is 'STRING, VAR's value remains as is. If PARAMETER-TYPE is 'INTEGER and the parameter string consists solely of decimal digits, VAR's value will be the corresponding integer, otherwise NIL. If PARAMETER-TYPE is 'KEYWORD, VAR's value will be the keyword obtained by interning the upcased parameter string into the keyword package. If PARAMETER-TYPE is 'CHARACTER and the parameter string is of length one, VAR's value will be the single character of this string, otherwise NIL. If PARAMETER-TYPE is 'BOOLEAN, VAR's value will always be T \(unless it is NIL by the first rule above, of course). If PARAMETER-TYPE is any other atom, it is supposed to be a function designator for a unary function which will be called to convert the string to something else. Those were the rules for `simple' types, but PARAMETER-TYPE can also be a list starting with one of the symbols LIST, ARRAY, or HASH-TABLE. The second value of the list must always be a simple parameter type as in the last paragraph - we'll call it the `inner type' below. In the case of 'LIST, all GET/POST parameters called REAL-NAME will be collected, converted to the inner type, and assembled into a list which will be the value of VAR. In the case of 'ARRAY, all GET/POST parameters which have a name like the result of (format nil \"~A[~A]\" real-name n) where N is a non-negative integer, will be assembled into an array where the Nth element will be set accordingly, after conversion to the inner type. The array, which will become the value of VAR, will be big enough to hold all matching parameters, but not bigger. Array elements not set as described above will be NIL. Note that VAR will always be bound to an array, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found. The full form of a 'HASH-TABLE parameter type is (hash-table inner-type key-type test-function), but KEY-TYPE and TEST-FUNCTION can be left out in which case they default to 'STRING and 'EQUAL, respectively. For this parameter type, all GET/POST parameters which have a name like the result of (format nil \"~A{~A}\" real-name key) \(where KEY is a string that doesn't contain curly brackets) will become the values \(after conversion to INNER-TYPE) of a hash table with test function TEST-FUNCTION where KEY \(after conversion to KEY-TYPE) will be the corresponding key. Note that VAR will always be bound to a hash table, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found. To make matters even more complicated, the three compound parameter types also have an abbreviated form - just one of the symbols LIST, ARRAY, or HASH-TABLE. In this case, the inner type will default to 'STRING. If PARAMETER-TYPE is not provided or NIL, DEFAULT-PARAMETER-TYPE \(the default of which is 'STRING) will be used instead. If the result of the computations above would be that VAR would be bound to NIL, then INIT-FORM \(if provided) will be evaluated instead, and VAR will be bound to the result of this evaluation. Handlers built with this macro are constructed in such a way that the resulting Lisp function is useful even outside of Hunchentoot. Specifically, all the parameter computations above will only happen if *REQUEST* is bound, i.e. if we're within a Hunchentoot request. Otherwise, VAR will always be bound to the result of evaluating INIT-FORM unless a corresponding keyword argument is provided." (when (atom description) (setq description (list description))) (destructuring-bind (name &key uri (acceptor-names t) (default-parameter-type ''string) (default-request-type :both)) description `(progn ,@(when uri (list (with-rebinding (uri) `(progn (setq *easy-handler-alist* (delete-if (lambda (list) (and (or (equal ,uri (first list)) (eq ',name (third list))) (or (eq ,acceptor-names t) (intersection ,acceptor-names (second list))))) *easy-handler-alist*)) (push (list ,uri ,acceptor-names ',name) *easy-handler-alist*))))) (defun ,name (&key ,@(loop for part in lambda-list collect (make-defun-parameter part default-parameter-type default-request-type))) ,@body)))) ;; help the LispWorks IDE to find these definitions #+:lispworks (dspec:define-form-parser define-easy-handler (description) `(,define-easy-handler ,(if (atom description) description (first description)))) #+:lispworks (dspec:define-dspec-alias define-easy-handler (name) `(defun ,name)) (defun dispatch-easy-handlers (request) "This is a dispatcher which returns the appropriate handler defined with DEFINE-EASY-HANDLER, if there is one." (loop for (uri acceptor-names easy-handler) in *easy-handler-alist* when (and (or (eq acceptor-names t) (find (acceptor-name *acceptor*) acceptor-names :test #'eq)) (cond ((stringp uri) (string= (script-name request) uri)) (t (funcall uri request)))) do (return easy-handler))) (defclass easy-acceptor (acceptor) () (:documentation "This is the acceptor of the ``easy'' Hunchentoot framework.")) (defmethod acceptor-dispatch-request ((acceptor easy-acceptor) request) "The easy request dispatcher 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." (loop for dispatcher in *dispatch-table* for action = (funcall dispatcher request) when action return (funcall action) finally (call-next-method))) #-:hunchentoot-no-ssl (defclass easy-ssl-acceptor (easy-acceptor ssl-acceptor) () (:documentation "This is an acceptor that mixes the ``easy'' Hunchentoot with SSL connections.")) hunchentoot-1.2.35/www/0000755000004100000410000000000012656661410015023 5ustar www-datawww-datahunchentoot-1.2.35/www/index.html0000644000004100000410000000061112656661410017016 0ustar www-datawww-data Welcome to Hunchentoot!

Welcome

When you're reading this message, Hunchentoot has been properly installed.

Please read the documentation.

hunchentoot-1.2.35/www/favicon.ico0000644000004100000410000000257612656661410017156 0ustar www-datawww-datah( ~ûÿߟÁÁÇÇŸãññ?ø?ü?üüüÿøÿàÿáÿhunchentoot-1.2.35/www/errors/0000755000004100000410000000000012656661410016337 5ustar www-datawww-datahunchentoot-1.2.35/www/errors/500.html0000644000004100000410000000103312656661410017526 0ustar www-datawww-data Internal Server Error

Internal Server Error

An error occurred while processing your ${script-name} request.

Error Message

${error}

Backtrace

${backtrace}
Hunchentoot ${hunchentoot-version} running on ${lisp-implementation-type} ${lisp-implementation-version}
hunchentoot-1.2.35/www/errors/404.html0000644000004100000410000000030012656661410017525 0ustar www-datawww-data Not found Resource ${script-name} not found. hunchentoot-1.2.35/www/hunchentoot-doc.html0000644000004100000410000072035012656661410021021 0ustar www-datawww-data Hunchentoot - The Common Lisp web server formerly known as TBNL

Hunchentoot - The Common Lisp web server formerly known as TBNL

Abstract

Hunchentoot is a web server written in Common Lisp and at the same time a toolkit for building dynamic websites. As a stand-alone web server, Hunchentoot is capable of HTTP/1.1 chunking (both directions), persistent connections (keep-alive), and SSL.

Hunchentoot provides facilities like automatic session handling (with and without cookies), logging, customizable error handling, and easy access to GET and POST parameters sent by the client. It does not include functionality to programmatically generate HTML output. For this task you can use any library you like, e.g. (shameless self-plug) CL-WHO or HTML-TEMPLATE.

Hunchentoot talks with its front-end or with the client over TCP/IP sockets and optionally uses multiprocessing to handle several requests at the same time. Therefore, it cannot be implemented completely in portable Common Lisp. It currently works with LispWorks and all Lisps which are supported by the compatibility layers usocket and Bordeaux Threads.

Hunchentoot comes with a BSD-style license so you can basically do with it whatever you want.

Hunchentoot is (or was) for example used by QuickHoney, City Farming, Heike Stephan.

Download shortcut: http://weitz.de/files/hunchentoot.tar.gz.

Contents

  1. Abstract
  2. Contents
  3. Download and installation
    1. Running Hunchentoot on port 80
    2. Hunchentoot behind a proxy
  4. Support
  5. Your own webserver (the easy teen-age New York version)
  6. Third party documentation and add-ons
  7. Function and variable reference
    1. Acceptors
    2. Customizing acceptor behaviour
    3. An example of how to subclass ACCEPTOR
    4. Taskmasters
    5. Request dispatch and handling
    6. Using the easy-handler framework
    7. Request objects
    8. Reply objects
    9. Sessions
    10. Customizing session behaviour
    11. Cookies
    12. Logging
    13. Conditions and error handling
    14. Miscellaneous
  8. Testing
  9. Debugging
  10. History
  11. Symbol index
  12. Acknowledgements

Download and installation

Hunchentoot depends on a couple of other Lisp libraries which you'll need to install first: Make sure to use the newest versions of all of these libraries (which might themselves depend on other libraries) - try the repository versions if you're in doubt. Note: You can compile Hunchentoot without SSL support - and thus without the need to have CL+SSL - if you add :HUNCHENTOOT-NO-SSL to *FEATURES* before you compile it.

Hunchentoot will only work with Lisps where the character codes of all Latin-1 characters coincide with their Unicode code points (which is the case for all current implementations I know).

Hunchentoot itself together with this documentation can be downloaded from http://weitz.de/files/hunchentoot.tar.gz. The current version is 1.2.35.

The preferred method to compile and load Hunchentoot is via ASDF. If you want to avoid downloading and installing all the dependencies manually, give Zach Beane's excellent Quicklisp system a try.

Hunchentoot and its dependencies can also be installed with clbuild. There's also a port for Gentoo Linux thanks to Matthew Kennedy.

The current development version of Hunchentoot can be found at https://github.com/edicl/hunchentoot. If you want to send patches, please fork the github repository and send pull requests.

Running Hunchentoot on port 80

Hunchentoot does not come with code to help with running it on a privileged port (i.e. port 80 or 443) on Unix-like operating systems. Modern Unix-like systems have specific, non-portable ways to allow non-root users to listen to privileged ports, so including such functionality in Hunchentoot was considered unnecessary. Please refer to online resources for help. At the time of this writing, the YAWS documentation has a comprehensive writeup on the topic.

Hunchentoot behind a proxy

If you're feeling unsecure about exposing Hunchentoot to the wild, wild Internet or if your Lisp web application is part of a larger website, you can hide it behind a proxy server. One approach that I have used several times is to employ Apache's mod_proxy module with a configuration that looks like this: 
ProxyPass /hunchentoot http://127.0.0.1:3000/hunchentoot
ProxyPassReverse /hunchentoot http://127.0.0.1:3000/hunchentoot
This will tunnel all requests where the URI path begins with "/hunchentoot" to a (Hunchentoot) server listening on port 3000 on the same machine.

Of course, there are several other (more lightweight) web proxies that you could use instead of Apache.

Support

The development version of Hunchentoot can be found on github. Please use the github issue tracking system to submit bug reports. Patches are welcome, please use GitHub pull requests. If you want to make a change, please read this first.

Your own webserver (the easy teen-age New York version)

Starting your own web server is pretty easy. Do something like this: 
(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
That's it. Now you should be able to enter the address "http://127.0.0.1:4242/" in your browser and see something, albeit nothing very interesting for now.

By default, Hunchentoot serves the files from the www/ directory in its source tree. In the distribution, that directory contains a HTML version of the documentation as well as the error templates. The location of the document root directory can be specified when creating a new ACCEPTOR instance by the way of the ACCEPTOR-DOCUMENT-ROOT. Likewise, the location of the error template directory can be specified by the ACCEPTOR-ERROR-TEMPLATE-DIRECTORY. Both ACCEPTOR-DOCUMENT-ROOT and ACCEPTOR-ERROR-TEMPLATE-DIRECTORY can be specified using a logical pathname, which will be translated once when the ACCEPTOR is instantiated.

The EASY-ACCEPTOR class implements a framework for developing web applications. Handlers are defined using the DEFINE-EASY-HANDLER macro. Request dispatching is performed according to the list of dispatch functions in *DISPATCH-TABLE*. Each of the functions on that list is called to determine whether it wants to handle the request, provided as single argument. If a dispatcher function wants to handle the request, it returns another function to actually create the desired page.

DEFINE-EASY-HANDLER is accompanied by a set of dispatcher creation functions that can be used to create dispatchers for standard tasks. These are documented in the subchapter on easy handlers

Now be a bit more adventurous, try this 

(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
  (setf (hunchentoot:content-type*) "text/plain")
  (format nil "Hey~@[ ~A~]!" name))
and see what happens at "http://127.0.0.1:4242/yo" or "http://127.0.0.1:4242/yo?name=Dude" .

Hunchentoot comes with a little example website which you can use to see if it works and which should also demonstrate a couple of the things you can do with Hunchentoot. To start the example website, enter the following code into your listener: 

(asdf:oos 'asdf:load-op :hunchentoot-test)
Now go to "http://127.0.0.1:4242/hunchentoot/test" and play a bit.

Third party documentation and add-ons

Adam Petersen has written a book called "Lisp for the Web" which explains how Hunchentoot and some other libraries can be used to build web sites.

Here is some software which extends Hunchentoot or is based on it:

  • Weblocks by Slava Akhmechet is a "continuations-based web framework" which is based on Hunchentoot.
  • hunchentoot-cgi (by Cyrus Harmon) provides CGI handlers for Hunchentoot.
  • CL-WEBDAV is a WebDAV server based on Hunchentoot.
  • RESTAS is a web framework based on Hunchentoot.

Function and variable reference

Acceptors

If you want Hunchentoot to actually do something, you have to create and start an acceptor. You can also run several acceptors in one image, each one listening on a different different port.

[Standard class]
acceptor

To create a Hunchentoot webserver, you make an instance of this class or one of its subclasses and use the generic function START to start it (and STOP to stop it). Use the :port initarg if you don't want to listen on the default http port 80. There are other initargs most of which you probably won't need very often. They are explained in detail in the docstrings of the slot definitions for this class.

Unless you are in a Lisp without MP capabilities, you can have several active instances of ACCEPTOR (listening on different ports) at the same time.

[Standard class]
ssl-acceptor

Create and START an instance of this class (instead of ACCEPTOR) if you want an https server. There are two required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for pathname designators denoting the certificate file and the key file in PEM format. On LispWorks, you can have both in one file in which case the second initarg is optional. You can also use the :SSL-PRIVATEKEY-PASSWORD initarg to provide a password (as a string) for the key file (or NIL, the default, for no password).

The default port for SSL-ACCEPTOR instances is 443 instead of 80

[Generic function]
start acceptor => acceptor

Starts acceptor so that it begins accepting connections. Returns the acceptor.

[Generic function]
stop acceptor &key soft => acceptor

Stops the acceptor so that it no longer accepts requests. If soft is true, and there are any requests in progress, wait until all requests are fully processed, but meanwhile do not accept new requests. Note that soft must not be set when calling stop from within a request handler, as that will deadlock.

[Special variable]
*acceptor*

The current ACCEPTOR object in the context of a request.

[Generic function]
acceptor-listen-backlog listen-backlog => number-of-pending-connections

Number of pending connections allowed in the listen socket before the kernel rejects further incoming connections. Non-LispWorks only.

[Generic readers]
acceptor-address acceptor => address
acceptor-port acceptor => port
acceptor-read-timeout acceptor => read-timeout
acceptor-ssl-certificate-file ssl-acceptor => ssl-certificate-file
acceptor-ssl-privatekey-file ssl-acceptor => ssl-privatekey-file
acceptor-ssl-privatekey-password ssl-acceptor => ssl-privatekey-password
acceptor-write-timeout acceptor => write-timeout

These are readers for various slots of ACCEPTOR objects (and some of them obviously only make sense for SSL-ACCEPTOR objects). See the docstrings of these slots for more information and note that there are corresponding initargs for all of them.

[Generic accessors]
acceptor-access-log-destination acceptor => (or pathname null)
(setf (acceptor-access-log-destination acceptor ) new-value)
acceptor-document-root acceptor => (or pathname null)
(setf (acceptor-document-root acceptor ) new-value)
acceptor-error-template-directory acceptor => (or pathname null)
(setf (acceptor-error-template-directory acceptor ) new-value)
acceptor-input-chunking-p acceptor => input-chunking-p
(setf (acceptor-input-chunking-p acceptor ) new-value)
acceptor-message-log-destination acceptor => (or pathname null)
(setf (acceptor-message-log-destination acceptor ) new-value)
acceptor-name acceptor => name
(setf (acceptor-name acceptor ) new-value)
acceptor-output-chunking-p acceptor => output-chunking-p
(setf (acceptor-output-chunking-p acceptor ) new-value)
acceptor-persistent-connections-p acceptor => persistent-connections-p
(setf (acceptor-persistent-connections-p acceptor ) new-value)
acceptor-reply-class acceptor => reply-class
(setf (acceptor-reply-class acceptor ) new-value)
acceptor-request-class acceptor => request-class
(setf (acceptor-request-class acceptor ) new-value)

These are accessors for various slots of ACCEPTOR objects. See the docstrings of these slots for more information and note that there are corresponding initargs for all of them.

[Generic function]
acceptor-ssl-p acceptor => generalized-boolean

Returns a true value if acceptor uses SSL connections. The default is to unconditionally return NIL and subclasses of ACCEPTOR must specialize this method to signal that they're using secure connections - see the SSL-ACCEPTOR class.

[Special variable]
*default-connection-timeout*

The default connection timeout used when an acceptor is reading from and writing to a socket stream. Note that some Lisps allow you to set different timeouts for reading and writing and you can specify both values via initargs when you create an acceptor.

[Generic function]
acceptor-remove-session acceptor session => |

This function is called whenever a session in ACCEPTOR is being destroyed because of a session timout or an explicit REMOVE-SESSION call.

Customizing acceptor behaviour

If you want to modify what acceptors do, you should subclass ACCEPTOR (or SSL-ACCEPTOR) and specialize the generic functions that constitute their behaviour (see example below). The life of an acceptor looks like this: It is started with the function START which immediately calls START-LISTENING and then applies the function EXECUTE-ACCEPTOR to its taskmaster. This function will eventually call ACCEPT-CONNECTIONS which is responsible for setting things up to wait for clients to connect. For each incoming connection which comes in, HANDLE-INCOMING-CONNECTION is applied to the taskmaster which will either call PROCESS-CONNECTION directly, or will create a thread to call it. PROCESS-CONNECTION calls INITIALIZE-CONNECTION-STREAM before it does anything else, then it selects and calls a function which handles the request, and finally it sends the reply to the client before it calls RESET-CONNECTION-STREAM. If the connection is persistent, this procedure is repeated (except for the intialization step) in a loop until the connection is closed. The acceptor is stopped with STOP.

If you just want to use the standard acceptors that come with Hunchentoot, you don't need to know anything about the functions listed in this section.

[Generic function]
start-listening acceptor => |

Sets up a listen socket for the given acceptor and enables it to listen to incoming connections. This function is called from the thread that starts the acceptor initially and may return errors resulting from the listening operation (like 'address in use' or similar).

[Generic function]
accept-connections acceptor => nil

In a loop, accepts a connection and hands it over to the acceptor's taskmaster for processing using HANDLE-INCOMING-CONNECTION. On LispWorks, this function returns immediately, on other Lisps it returns only once the acceptor has been stopped.

[Generic function]
process-connection acceptor socket => nil

This function is called by the taskmaster when a new client connection has been established. Its arguments are the ACCEPTOR object and a LispWorks socket handle or a usocket socket stream object in socket. It reads the request headers, sets up the request and reply objects, and hands over to PROCESS-REQUEST which calls HANDLE-REQUEST to select and call a handler for the request and sends its reply to the client. This is done in a loop until the stream has to be closed or until a connection timeout occurs. It is probably not a good idea to re-implement this method until you really, really know what you're doing.

Handlers may call to the DETACH-SOCKET generic function to indicate that no further requests should be handled on the connection by Hunchentoot, and that responsibility for the socket is assumed by third-party software. This can be used by specialized handlers that wish to hand over connection polling or processing to functions outside of Hunchentoot, i.e. for connection multiplexing or implementing specialized client protocols. Hunchentoot will finish processing the request and the PROCESS-CONNECTION function will return without closing the connection. At that point, the acceptor may interact with the socket in whatever fashion required.

[Generic function]
detach-socket acceptor => stream

Indicate to Hunchentoot that it should stop serving requests on the current request's socket. Hunchentoot will finish processing the current request and then return from PROCESS-CONNECTION without closing the connection to the client. DETACH-SOCKET can only be called from within a request handler function.

[Generic function]
initialize-connection-stream acceptor stream => stream

Can be used to modify the stream which is used to communicate between client and server before the request is read. The default method of ACCEPTOR does nothing, but see for example the method defined for SSL-ACCEPTOR. All methods of this generic function must return the stream to use.

[Generic function]
reset-connection-stream acceptor stream => stream

Resets the stream which is used to communicate between client and server after one request has been served so that it can be used to process the next request. This generic function is called after a request has been processed and must return the stream.

[Generic function]
acceptor-log-access acceptor &key return-code

Function to call to log access to the acceptor. The return-code keyword argument contains additional information about the request to log. In addition, it can use the standard request and reply accessor functions that are available to handler functions to find out more information about the request.

[Generic function]
acceptor-log-message acceptor log-level format-string &rest format-arguments

Function to call to log messages by the acceptor. It must accept a severity level for the message, which will be one of :ERROR, :INFO, or :WARNING, a format string and an arbitary number of formatting arguments.

[Generic function]
acceptor-status-message acceptor http-return-code &key &allow-other-keys

This function is called when a request's handler has been called but failed to provide content to send back to the client. It converts the HTTP-STATUS-CODE to some request contents, typically a human readable description of the status code to be displayed to the user. If an ERROR-TEMPLATE-DIRECTORY is set in the current acceptor and the directory contains a file corresponding to HTTP-STATUS-CODE named <code>.html, that file is sent to the client after variable substitution. Variables are referenced by ${<variable-name>}. Additional keyword arguments may be provided which are made available to the templating logic as substitution variables. These variables can be interpolated into error message templates in, which contains the current URL relative to the server and without GET parameters. In addition to the variables corresponding to keyword arguments, the script-name, lisp-implementation-type, lisp-implementation-version and hunchentoot-version variables are available.

An example of how to subclass ACCEPTOR

This example shows how to subclass ACCEPTOR in order to provide Hunchentoot with basic virtual host support.  It assumes Hunchentoot is sitting behind an Internet-facing reverse-proxy web server that maps the host (or domain) part of incoming HTTP requests to unique localhost ports. 
(asdf:load-system "hunchentoot")
(asdf:load-system "drakma")

;;; Subclass ACCEPTOR
(defclass vhost (tbnl:acceptor)
  ;; slots
  ((dispatch-table
    :initform '()
    :accessor dispatch-table
    :documentation "List of dispatch functions"))
  ;; options
  (:default-initargs                    ; default-initargs must be used
   :address "127.0.0.1"))               ; because ACCEPTOR uses it

;;; Specialise ACCEPTOR-DISPATCH-REQUEST for VHOSTs
(defmethod tbnl:acceptor-dispatch-request ((vhost vhost) request)
  ;; try REQUEST on each dispatcher in turn
  (mapc (lambda (dispatcher)
	  (let ((handler (funcall dispatcher request)))
	    (when handler               ; Handler found. FUNCALL it and return result
	      (return-from tbnl:acceptor-dispatch-request (funcall handler)))))
	(dispatch-table vhost))
  (call-next-method))

;;; ======================================================================
;;; Now all we need to do is test it

;;; Instantiate VHOSTs
(defvar vhost1 (make-instance 'vhost :port 50001))
(defvar vhost2 (make-instance 'vhost :port 50002))

;;; Populate each dispatch table
(push
 (tbnl:create-prefix-dispatcher "/foo" 'foo1)
 (dispatch-table vhost1))
(push
 (tbnl:create-prefix-dispatcher "/foo" 'foo2)
 (dispatch-table vhost2))

;;; Define handlers
(defun foo1 () "Hello")
(defun foo2 () "Goodbye")

;;; Start VHOSTs
(tbnl:start vhost1)
(tbnl:start vhost2)

;;; Make some requests
(drakma:http-request "http://127.0.0.1:50001/foo")
;;; =|
;;; 127.0.0.1 - [2012-06-08 14:30:39] "GET /foo HTTP/1.1" 200 5 "-" "Drakma/1.2.6 (SBCL 1.0.56; Linux; 2.6.32-5-686; http://weitz.de/drakma/)"
;;; =>
;;; "Hello"
;;; 200
;;; ((:CONTENT-LENGTH . "5") (:DATE . "Fri, 08 Jun 2012 14:30:39 GMT")
;;;  (:SERVER . "Hunchentoot 1.2.3") (:CONNECTION . "Close")
;;;  (:CONTENT-TYPE . "text/html; charset=utf-8"))
;;; #<PURI:URI http://127.0.0.1:50001/foo>
;;; #<FLEXI-STREAMS:FLEXI-IO-STREAM {CA90059}>
;;; T
;;; "OK"
(drakma:http-request "http://127.0.0.1:50002/foo")
;;; =|
;;; 127.0.0.1 - [2012-06-08 14:30:47] "GET /foo HTTP/1.1" 200 7 "-" "Drakma/1.2.6 (SBCL 1.0.56; Linux; 2.6.32-5-686; http://weitz.de/drakma/)"
;;; =>
;;; "Goodbye"
;;; 200
;;; ((:CONTENT-LENGTH . "7") (:DATE . "Fri, 08 Jun 2012 14:30:47 GMT")
;;;  (:SERVER . "Hunchentoot 1.2.3") (:CONNECTION . "Close")
;;;  (:CONTENT-TYPE . "text/html; charset=utf-8"))
;;; #<PURI:URI http://127.0.0.1:50002/foo>
;;; #<FLEXI-STREAMS:FLEXI-IO-STREAM {CAE8059}>
;;; T
;;; "OK"
How to make each VHOST write to separate access log streams (or files) is left as an exercise to the reader.

Taskmasters

As a "normal" Hunchentoot user, you can completely ignore taskmasters and skip this section. But if you're still reading, here are the dirty details: Each acceptor has a taskmaster associated with it at creation time. It is the taskmaster's job to distribute the work of accepting and handling incoming connections. The acceptor calls the taskmaster if appropriate and the taskmaster calls back into the acceptor. This is done using the generic functions described in this and the previous section. Hunchentoot comes with two standard taskmaster implementations - one (which is the default used on multi-threaded Lisps) which starts a new thread for each incoming connection and one which handles all requests sequentially. It should for example be relatively straightforward to create a taskmaster which allocates threads from a fixed pool instead of creating a new one for each connection.

You can control the resources consumed by a threaded taskmaster via two initargs. :max-thread-count lets you set the maximum number of request threads that can be processes simultaneously. If this is nil, the is no thread limit imposed. :max-accept-count lets you set the maximum number of requests that can be outstanding (i.e. being processed or queued for processing). If :max-thread-count is supplied and :max-accept-count is NIL, then a +HTTP-SERVICE-UNAVAILABLE+ error will be generated if there are more than the max-thread-count threads processing requests. If both :max-thread-count and :max-accept-count are supplied, then max-thread-count must be less than max-accept-count; if more than max-thread-count requests are being processed, then requests up to max-accept-count will be queued until a thread becomes available. If more than max-accept-count requests are outstanding, then a +HTTP-SERVICE-UNAVAILABLE+ error will be generated. In a load-balanced environment with multiple Hunchentoot servers, it's reasonable to provide :max-thread-count but leave :max-accept-count null. This will immediately result in +HTTP-SERVICE-UNAVAILABLE+ when one server is out of resources, so the load balancer can try to find another server. In an environment with a single Hunchentoot server, it's reasonable to provide both :max-thread-count and a somewhat larger value for :max-accept-count. This will cause a server that's almost out of resources to wait a bit; if the server is completely out of resources, then the reply will be +HTTP-SERVICE-UNAVAILABLE+. The default for these values is 100 and 120, respectively.

If you want to implement your own taskmasters, you should subclass TASKMASTER or one of its subclasses, SINGLE-THREADED-TASKMASTER or ONE-THREAD-PER-CONNECTION-TASKMASTER, and specialize the generic functions in this section.

[Standard class]
taskmaster

An instance of this class is responsible for distributing the work of handling requests for its acceptor. This is an "abstract" class in the sense that usually only instances of subclasses of TASKMASTER will be used.

[Standard class]
one-thread-per-connection-taskmaster

A taskmaster that starts one thread for listening to incoming requests and one thread for each incoming connection.

This is the default taskmaster implementation for multi-threaded Lisp implementations.

[Standard class]
single-threaded-taskmaster

A taskmaster that runs synchronously in the thread where the START function was invoked (or in the case of LispWorks in the thread started by COMM:START-UP-SERVER). This is the simplest possible taskmaster implementation in that its methods do nothing but calling their acceptor "sister" methods - EXECUTE-ACCEPTOR calls ACCEPT-CONNECTIONS, HANDLE-INCOMING-CONNECTION calls PROCESS-CONNECTION.

[Standard class]
multi-threaded-taskmaster

This is an abstract class for taskmasters that use multiple threads; it is not a concrete class and you should not instantiate it with MAKE-INSTANCE. Instead, you should instantiate its subclass ONE-THREAD-PER-CONNECTION-TASKMASTER described above. MULTI-THREADED-TASKMASTER is intended to be inherited from by extensions to Hunchentoot, such as quux-hunchentoot's THREAD-POOLING-TASKMASTER, though at the moment, doing so only inherits one slot and one method, on EXECUTE-ACCEPTOR, to have it start a new thread for the acceptor, then saved in said slot.

[Generic function]
execute-acceptor taskmaster => result

This is a callback called by the acceptor once it has performed all initial processing to start listening for incoming connections (see START-LISTENING). It usually calls the ACCEPT-CONNECTIONS method of the acceptor, but depending on the taskmaster instance the method might be called from a new thread.

[Generic function]
handle-incoming-connection taskmaster socket => result

This function is called by the acceptor to start processing of requests on a new incoming connection. socket is the usocket instance that represents the new connection (or a socket handle on LispWorks). The taskmaster starts processing requests on the incoming connection by calling the PROCESS-CONNECTION method of the acceptor instance. The socket argument is passed to PROCESS-CONNECTION as an argument. If the taskmaster is a multi-threaded taskmaster, HANDLE-INCOMING-THREAD will call CREATE-REQUEST-HANDLER-THREAD, which will call PROCESS-CONNECTION in a new thread. HANDLE-INCOMING-THREAD might issue a +HTTP-SERVICE-UNAVAILABLE+ error if there are too many request threads or it might block waiting for a request thread to finish.

[Generic function]
start-thread taskmaster thunk &key => thread

This function is a callback that starts a new thread that will call the given thunk in the context of the proper taskmaster, with appropriate context-dependent keyword arguments. ONE-THREAD-PER-CONNECTION-TASKMASTER uses it in EXECUTE-ACCEPTOR and CREATE-REQUEST-HANDLER-THREAD, but specialized taskmasters may define more functions that use it. By default, it just creates a thread calling the thunk with a specified name keyword argument. Specialized taskmasters may wrap special bindings and condition handlers around the thunk call, register the thread in a management table, etc.

[Generic function]
create-request-handler-thread taskmaster socket => thread

This function is called by HANDLE-INCOMING-THREAD to create a new thread which calls PROCESS-CONNECTION. If you specialize this function, you must be careful to have the thread call DECREMENT-TASKMASTER-REQUEST-COUNT before it exits. A typical method will look like this: 
(defmethod create-request-handler-thread ((taskmaster monitor-taskmaster) socket)
  (bt:make-thread
   (lambda ()
     (with-monitor-error-handlers
         (unwind-protect
              (with-monitor-variable-bindings
                  (process-connection (taskmaster-acceptor taskmaster) socket))
           (decrement-taskmaster-request-count taskmaster))))))

[Generic function]
shutdown taskmaster => taskmaster

Shuts down the taskmaster, i.e. frees all resources that were set up by it. For example, a multi-threaded taskmaster might terminate all threads that are currently associated with it. This function is called by the acceptor's STOP method.

[Generic accessor]
taskmaster-acceptor taskmaster => acceptor
(setf (taskmaster-acceptor taskmaster ) new-value)

This is an accessor for the slot of a TASKMASTER object that links back to the acceptor it is associated with.

Request dispatch and handling

The main job of HANDLE-REQUEST is to select and call a function which handles the request, i.e. which looks at the data the client has sent and prepares an appropriate reply to send back. This is by default implemented as follows:

The ACCEPTOR class defines a ACCEPTOR-DISPATCH-REQUEST generic function which is used to actually dispatch the request. This function is called by the default method of HANDLE-REQUEST. Each ACCEPTOR-DISPATCH-REQUEST method looks at the request object and depending on its contents decides to either handle the request or call the next method.

In order to dispatch a request, Hunchentoot calls the ACCEPTOR-DISPATCH-REQUEST generic functions. The method for ACCEPTOR tries to serve a static file relative to it's ACCEPTOR-DOCUMENT-ROOT. Application specific acceptor subclasses will typically perform URL parsing and dispatching according to the policy that is required.

The default method of HANDLE-REQUEST sets up standard logging and error handling before it calls the acceptor's request dispatcher.

Request handlers do their work by modifying the reply object if necessary and by eventually returning the response body in the form of a string or a binary sequence. As an alternative, they can also call SEND-HEADERS and write directly to a stream.

Using the easy-handler framework

The EASY-ACCEPTOR class defines a method for ACCEPTOR-DISPATCH-REQUEST that walks through the list *DISPATCH-TABLE* which consists of dispatch functions. Each of these functions accepts the request object as its only argument and either returns a request handler to handle the request or NIL which means that the next dispatcher in the list will be tried. If all dispatch functions return NIL, the next ACCEPTOR-DISPATCH-REQUEST will be called.

All functions and variables in this section are related to the easy request dispatch mechanism and are meaningless if you're using your own request dispatcher.

[Standard class]
easy-acceptor

This class defines no additional slots with respect to ACCEPTOR. It only serves as an additional type for dispatching calls to ACCEPTOR-DISPATCH-REQUEST. In order to use the easy handler framework, acceptors of this class or one of its subclasses must be used.

[Standard class]
easy-ssl-acceptor

This class mixes the SSL-ACCEPTOR and the EASY-ACCEPTOR classes. It is used when both ssl and the easy handler framework are required.

[Special variable]
*dispatch-table*

A global list of dispatch functions. The initial value is a list consisting of the symbol DISPATCH-EASY-HANDLERS.

[Function]
create-prefix-dispatcher prefix handler => dispatch-fn

A convenience function which will return a dispatcher that returns handler whenever the path part of the request URI starts with the string prefix.

[Function]
create-regex-dispatcher regex handler => dispatch-fn

A convenience function which will return a dispatcher that returns handler whenever the path part of the request URI matches the CL-PPCRE regular expression regex (which can be a string, an s-expression, or a scanner).

[Function]
create-folder-dispatcher-and-handler uri-prefix base-path &optional content-type => dispatch-fn

Creates and returns a dispatch function which will dispatch to a handler function which emits the file relative to base-path that is denoted by the URI of the request relative to uri-prefix. uri-prefix must be a string ending with a slash, base-path must be a pathname designator for an existing directory. Uses HANDLE-STATIC-FILE internally.

If content-type is not NIL, it will be used as a the content type for all files in the folder. Otherwise (which is the default) the content type of each file will be determined as usual.

[Function]
create-static-file-dispatcher-and-handler uri path &optional content-type => result

Creates and returns a request dispatch function which will dispatch to a handler function which emits the file denoted by the pathname designator PATH with content type CONTENT-TYPE if the SCRIPT-NAME of the request matches the string URI. If CONTENT-TYPE is NIL, tries to determine the content type via the file's suffix.

[Macro]
define-easy-handler description lambda-list [[declaration* | documentation]] form*

Defines a handler as if by DEFUN and optionally registers it with a URI so that it will be found by DISPATCH-EASY-HANDLERS.

description is either a symbol name or a list matching the destructuring lambda list 

(name &key uri acceptor-names default-parameter-type default-request-type).
lambda-list is a list the elements of which are either a symbol var or a list matching the destructuring lambda list 
(var &key real-name parameter-type init-form request-type).
The resulting handler will be a Lisp function with the name name and keyword parameters named by the var symbols. Each var will be bound to the value of the GET or POST parameter called real-name (a string) before the body of the function is executed. If real-name is not provided, it will be computed by downcasing the symbol name of var.

If uri (which is evaluated) is provided, then it must be a string or a function designator for a unary function. In this case, the handler will be returned by DISPATCH-EASY-HANDLERS, if uri is a string and the script name of the current request is uri, or if uri designates a function and applying this function to the current REQUEST object returns a true value.

acceptor-names (which is evaluated) can be a list of symbols which means that the handler will only be returned by DISPATCH-EASY-HANDLERS in acceptors which have one of these names (see ACCEPTOR-NAME). acceptor-names can also be the symbol T which means that the handler will be returned by DISPATCH-EASY-HANDLERS in every acceptor.

Whether the GET or POST parameter (or both) will be taken into consideration, depends on request-type which can be :GET, :POST, :BOTH, or NIL. In the last case, the value of default-request-type (the default of which is :BOTH) will be used.

The value of var will usually be a string (unless it resulted from a file upload in which case it won't be converted at all), but if parameter-type (which is evaluated) is provided, the string will be converted to another Lisp type by the following rules:

If the corresponding GET or POST parameter wasn't provided by the client, var's value will be NIL. If parameter-type is 'STRING, var's value remains as is. If parameter-type is 'INTEGER and the parameter string consists solely of decimal digits, var's value will be the corresponding integer, otherwise NIL. If parameter-type is 'KEYWORD, var's value will be the keyword obtained by interning the upcased parameter string into the keyword package. If parameter-type is 'CHARACTER and the parameter string is of length one, var's value will be the single character of this string, otherwise NIL. If parameter-type is 'BOOLEAN, var's value will always be T (unless it is NIL by the first rule above, of course). If parameter-type is any other atom, it is supposed to be a function designator for a unary function which will be called to convert the string to something else.

Those were the rules for simple parameter types, but parameter-type can also be a list starting with one of the symbols LIST, ARRAY, or HASH-TABLE. The second value of the list must always be a simple parameter type as in the last paragraph - we'll call it the inner type below.

In the case of 'LIST, all GET/POST parameters called real-name will be collected, converted to the inner type as by the rules above, and assembled into a list which will be the value of var.

In the case of 'ARRAY, all GET/POST parameters which have a name like the result of 

(format nil "~A[~A]" real-name n)
where n is a non-negative integer, will be assembled into an array where the nth element will be set accordingly, after conversion to the inner type. The array, which will become the value of var, will be big enough to hold all matching parameters, but not bigger. Array elements not set as described above will be NIL. Note that VAR will always be bound to an array, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found.

The full form of a 'HASH-TABLE parameter type is 

(hash-table inner-type key-type test-function)
but key-type and test-function can be left out in which case they default to 'STRING and 'EQUAL, respectively. For this parameter type, all GET/POST parameters which have a name like the result of 
(format nil "~A{~A}" real-name key)
(where key is a string that doesn't contain curly brackets) will become the values (after conversion to inner-type) of a hash table with test function test-function where key (after conversion to key-type) will be the corresponding key. Note that var will always be bound to a hash table, which may be empty, so it will never be NIL, even if no appropriate GET/POST parameters are found.

To make matters even more complicated, the three compound parameter types also have an abbreviated form - just one of the symbols LIST, ARRAY, or HASH-TABLE. In this case, the inner type will default to 'STRING.

If parameter-type is not provided or NIL, default-parameter-type (the default of which is 'STRING) will be used instead.

If the result of the computations above would be that var would be bound to NIL, then init-form (if provided) will be evaluated instead, and var will be bound to the result of this evaluation.

Handlers built with this macro are constructed in such a way that the resulting Lisp function is useful even outside of Hunchentoot. Specifically, all the parameter computations above will only happen if *REQUEST* is bound, i.e. if we're within a Hunchentoot request. Otherwise, var will always be bound to the result of evaluating init-form unless a corresponding keyword argument is provided.

The example code that comes with Hunchentoot contains an example which demonstrates some of the features of DEFINE-EASY-HANDLER.

[Function]
dispatch-easy-handlers request => result

This is a dispatcher which returns the appropriate handler defined with DEFINE-EASY-HANDLER, if there is one.

Request objects

For each incoming request, the acceptor (in PROCESS-CONNECTION) creates a REQUEST object and makes it available to handlers via the special variable *REQUEST*. This object contains all relevant information about the request and this section collects the functions which can be used to query such an object. In all function where request is an optional or keyword parameter, the default is *REQUEST*.

If you need more fine-grained control over the behaviour of request objects, you can subclass REQUEST and initialize the REQUEST-CLASS slot of the ACCEPTOR class accordingly. The acceptor will generate request objects of the class named by this slot.

[Standard class]
request

Objects of this class hold all the information about an incoming request. They are created automatically by acceptors and can be accessed by the corresponding handler. You should not mess with the slots of these objects directly, but you can subclass REQUEST in order to implement your own behaviour. See the REQUEST-CLASS slot of the ACCEPTOR class.

[Special variable]
*request*

The current REQUEST object while in the context of a request.

[Function]
real-remote-addr &optional request => string{, list}

Returns the 'X-Forwarded-For' incoming http header as the second value in the form of a list of IP addresses and the first element of this list as the first value if this header exists. Otherwise returns the value of REMOTE-ADDR as the only value.

[Function]
parameter name &optional request => string

Returns the GET or the POST parameter with name name (a string) - or NIL if there is none. If both a GET and a POST parameter with the same name exist the GET parameter is returned. Search is case-sensitive. See also GET-PARAMETER and POST-PARAMETER.

[Function]
get-parameter name &optional request => string

Returns the value of the GET parameter (as provided via the request URI) named by the string name as a string (or NIL if there ain't no GET parameter with this name). Note that only the first value will be returned if the client provided more than one GET parameter with the name name. See also GET-PARAMETERS*.

[Function]
post-parameter name &optional request => string

Returns the value of the POST parameter (as provided in the request's body) named by the string name. Note that only the first value will be returned if the client provided more than one POST parameter with the name name. This value will usually be a string (or NIL if there ain't no POST parameter with this name). If, however, the browser sent a file through a multipart/form-data form, the value of this function is a three-element list 
(path file-name content-type)
where path is a pathname denoting the place were the uploaded file was stored, file-name (a string) is the file name sent by the browser, and content-type (also a string) is the content type sent by the browser. The file denoted by path will be deleted after the request has been handled - you have to move or copy it somewhere else if you want to keep it.

POST parameters will only be computed if the content type of the request body was multipart/form-data or application/x-www-form-urlencoded. Although this function is called POST-PARAMETER, you can instruct Hunchentoot to compute these parameters for other request methods by setting *METHODS-FOR-POST-PARAMETERS*.

See also POST-PARAMETERS and *TMP-DIRECTORY*.

[Function]
get-parameters* &optional request => alist

Returns an alist of all GET parameters (as provided via the request URI). The car of each element of this list is the parameter's name while the cdr is its value (as a string). The elements of this list are in the same order as they were within the request URI. See also GET-PARAMETER.

[Function]
post-parameters* &optional request => alist

Returns an alist of all POST parameters (as provided via the request's body). The car of each element of this list is the parameter's name while the cdr is its value. The elements of this list are in the same order as they were within the request's body.

See also POST-PARAMETER.

[Special variable]
*methods-for-post-parameters*

A list of the request method types (as keywords) for which Hunchentoot will try to compute post-parameters.

[Function]
cookie-in name &optional request => string

Returns the cookie with the name name (a string) as sent by the browser - or NIL if there is none.

[Function]
cookies-in* &optional request => alist

Returns an alist of all cookies associated with the REQUEST object request.

[Function]
host &optional request => host

Returns the 'Host' incoming http header value.

[Function]
query-string* &optional request => string

Returns the query string of the REQUEST object request. That's the part behind the question mark (i.e. the GET parameters).

[Function]
referer &optional request => result

Returns the 'Referer' (sic!) http header.

[Function]
request-method* &optional request => keyword

Returns the request method as a Lisp keyword.

[Function]
request-uri* &optional request => uri

Returns the request URI.

[Function]
server-protocol* &optional request => keyword

Returns the request protocol as a Lisp keyword.

[Function]
user-agent &optional request => result

Returns the 'User-Agent' http header.

[Function]
header-in* name &optional request => header

Returns the incoming header with name name. name can be a keyword (recommended) or a string.

[Function]
headers-in* &optional request => alist

Returns an alist of the incoming headers associated with the REQUEST object request.

[Function]
remote-addr* &optional request => address

Returns the address the current request originated from.

[Function]
remote-port* &optional request => port

Returns the port the current request originated from.

[Function]
local-addr* &optional request => address

The IP address of the local system that the client connected to.

[Function]
local-port* &optional request => port

The TCP port number of the local system that the client connected to.

[Function]
script-name* &optional request => script-name

Returns the file name of the REQUEST object request. That's the requested URI without the query string (i.e the GET parameters).

[Accessor]
aux-request-value symbol &optional request => value, present-p
(setf (aux-request-value symbol &optional request ) new-value)

This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL.

[Function]
delete-aux-request-value symbol &optional request => |

Removes the value associated with symbol from the REQUEST object request.

[Function]
authorization &optional request => result

Returns as two values the user and password (if any) as encoded in the 'AUTHORIZATION' header. Returns NIL if there is no such header.

[Special variable]
*hunchentoot-default-external-format*

The external format used to compute the REQUEST object.

[Special variable]
*file-upload-hook*

If this is not NIL, it should be a unary function which will be called with a pathname for each file which is uploaded to Hunchentoot. The pathname denotes the temporary file to which the uploaded file is written. The hook is called directly before the file is created. At this point, *REQUEST* is already bound to the current REQUEST object, but obviously you can't access the post parameters yet.

[Function]
raw-post-data &key request external-format force-text force-binary want-stream => raw-body-or-stream

Returns the content sent by the client in the request body if there was any (unless the content type was multipart/form-data in which case NIL is returned). By default, the result is a string if the type of the Content-Type media type is "text", and a vector of octets otherwise. In the case of a string, the external format to be used to decode the content will be determined from the charset parameter sent by the client (or otherwise *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* will be used).

You can also provide an external format explicitly (through external-format) in which case the result will unconditionally be a string. Likewise, you can provide a true value for force-text which will force Hunchentoot to act as if the type of the media type had been "text" (with external-format taking precedence if provided). Or you can provide a true value for force-binary which means that you want a vector of octets at any rate. (If both force-text and force-binary are true, an error will be signaled.)

If, however, you provide a true value for want-stream, the other parameters are ignored and you'll get the content (flexi) stream to read from it yourself. It is then your responsibility to read the correct amount of data, because otherwise you won't be able to return a response to the client. The stream will have its octet position set to 0. If the client provided a Content-Length header, the stream will also have a corresponding bound, so no matter whether the client used chunked encoding or not, you can always read until EOF.

If the content type of the request was multipart/form-data or application/x-www-form-urlencoded, the content has been read by Hunchentoot already and you can't read from the stream anymore.

You can call RAW-POST-DATA more than once per request, but you can't mix calls which have different values for want-stream.

Note that this function is slightly misnamed because a client can send content even if the request method is not POST.

[Function]
recompute-request-parameters &key request external-format => |

Recomputes the GET and POST parameters for the REQUEST object request. This only makes sense if you're switching external formats during the request.

[Generic function]
process-request request => nil

This function is called by PROCESS-CONNECTION after the incoming headers have been read. It calls HANDLE-REQUEST (and is more or less just a thin wrapper around it) to select and call a handler and send the output of this handler to the client. Note that PROCESS-CONNECTION is called once per connection and loops in case of a persistent connection while PROCESS-REQUEST is called anew for each request.

The return value of this function is ignored.

Like PROCESS-CONNECTION, this is another function the behaviour of which you should only modify if you really, really know what you're doing.

[Generic function]
handle-request acceptor request => content

This function is called by PROCESS-REQUEST once the request has been read and a REQUEST object has been created. Its job is to actually handle the request, i.e. to return something to the client.

The default method calls the acceptor's request dispatcher, but you can of course implement a different behaviour. The default method also sets up standard error handling for the handler.

Might be a good place to bind or rebind special variables which can then be accessed by your handlers.

[Generic function]
acceptor-dispatch-request acceptor request => content

This function is called to actually dispatch the request once the standard logging and error handling has been set up. ACCEPTOR subclasses implement methods for this function in order to perform their own request routing. If a method does not want to handle the request, it is supposed to invoke CALL-NEXT-METHOD so that the next ACCEPTOR in the inheritance chain gets a chance to handle the request.

[Generic readers]
cookies-in request => cookies
get-parameters request => get-parameters
header-in name request => result
headers-in request => headers
post-parameters request => post-parameters
query-string request => query-string
remote-addr request => address
remote-port request => port
local-addr request => address
local-port request => port
request-acceptor request => acceptor
request-method request => method
request-uri request => uri
server-protocol request => protocol
script-name request => result

These are various generic readers which are used to read information about a REQUEST object. If you are writing a handler, you should not use these readers but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic readers are only exported for users who want to create their own subclasses of REQUEST.

Reply objects

For each incoming request, the acceptor (in PROCESS-CONNECTION) creates a REPLY object and makes it available to handlers via the special variable *REPLY*. This object contains all relevant information (except for the content body) about the reply that will be sent to the client and this section collects the functions which can be used to query and modify such an object. In all function where reply is an optional or keyword parameter, the default is *REPLY*.

If you need more fine-grained control over the behaviour of reply objects, you can subclass REPLY and initialize the REPLY-CLASS slot of the ACCEPTOR class accordingly. The acceptor will generate reply objects of the class named by this slot.

[Standard class]
reply

Objects of this class hold all the information about an outgoing reply. They are created automatically by Hunchentoot and can be accessed and modified by the corresponding handler.

You should not mess with the slots of these objects directly, but you can subclass REPLY in order to implement your own behaviour. See the :reply-class initarg of the ACCEPTOR class.

[Special variable]
*reply*

The current REPLY object in the context of a request.

[Accessor]
header-out name &optional reply => string
(setf (header-out name &optional reply ) new-value)

HEADER-OUT returns the outgoing http header named by the keyword name if there is one, otherwise NIL. SETF of HEADER-OUT changes the current value of the header named name. If no header named name exists, it is created. For backwards compatibility, name can also be a string in which case the association between a header and its name is case-insensitive.

Note that the header 'Set-Cookie' cannot be queried by HEADER-OUT and must not be set by SETF of HEADER-OUT. See also HEADERS-OUT*, CONTENT-TYPE*, CONTENT-LENGTH*, COOKIES-OUT*, and COOKIE-OUT.

[Function]
headers-out* &optional reply => alist

Returns an alist of the outgoing headers associated with the REPLY object reply. See also HEADER-OUT.

[Accessor]
content-length* &optional reply => content-length
(setf (content-length* &optional reply ) new-value)

The outgoing 'Content-Length' http header of reply.

[Accessor]
content-type* &optional reply => content-type
(setf (content-type* &optional reply ) new-value)

The outgoing 'Content-Type' http header of reply.

[Function]
cookie-out name &optional reply => result

Returns the current value of the outgoing cookie named name. Search is case-sensitive.

[Accessor]
cookies-out* &optional reply => alist
(setf (cookies-out* &optional reply ) new-value)

Returns or sets an alist of the outgoing cookies associated with the REPLY object reply.

[Accessor]
return-code* &optional reply => return-code
(setf (return-code* &optional reply ) new-value)

Gets or sets the http return code of reply. The return code of each REPLY object is initially set to +HTTP-OK+.

[Function]
send-headers => stream

Sends the initial status line and all headers as determined by the REPLY object *REPLY*. Returns a binary stream to which the body of the reply can be written. Once this function has been called, further changes to *REPLY* don't have any effect. Also, automatic handling of errors (i.e. sending the corresponding status code to the browser, etc.) is turned off for this request and functions like REDIRECT or to ABORT-REQUEST-HANDLER won't have the desired effect once the headers are sent.

If your handlers return the full body as a string or as an array of octets, you should not call this function. If a handler calls SEND-HEADERS , its return value is ignored.

[Accessor]
reply-external-format* &optional reply => external-format
(setf (reply-external-format* &optional reply ) new-value)

Gets or sets the external format of reply which is used for character output.

[Special variable]
*default-content-type*

The default content-type header which is returned to the client.

[Constants]
+http-continue+
+http-switching-protocols+
+http-ok+
+http-created+
+http-accepted+
+http-non-authoritative-information+
+http-no-content+
+http-reset-content+
+http-partial-content+
+http-multi-status+
+http-multiple-choices+
+http-moved-permanently+
+http-moved-temporarily+
+http-see-other+
+http-not-modified+
+http-use-proxy+
+http-temporary-redirect+
+http-bad-request+
+http-authorization-required+
+http-payment-required+
+http-forbidden+
+http-not-found+
+http-method-not-allowed+
+http-not-acceptable+
+http-proxy-authentication-required+
+http-request-time-out+
+http-conflict+
+http-gone+
+http-length-required+
+http-precondition-failed+
+http-request-entity-too-large+
+http-request-uri-too-large+
+http-unsupported-media-type+
+http-requested-range-not-satisfiable+
+http-expectation-failed+
+http-failed-dependency+
+http-internal-server-error+
+http-not-implemented+
+http-bad-gateway+
+http-service-unavailable+
+http-gateway-time-out+
+http-version-not-supported+

The values of these constants are 100, 101, 200, 201, 202, 203, 204, 205, 206, 207, 300, 301, 302, 303, 304, 305, 307, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 424, 500, 501, 502, 503, 504, and 505. See RETURN-CODE.

[Generic readers]
content-length reply => content-length
content-type reply => content-type
headers-out reply => headers-out

These are various generic readers which are used to read information about a REPLY object. If you are writing a handler, you should not use these readers but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic readers are only exported for users who want to create their own subclasses of REPLY.

[Generic accessors]
cookies-out reply => result
(setf (cookies-out reply ) new-value)
return-code reply => result
(setf (return-code reply ) new-value)
reply-external-format reply => result
(setf (reply-external-format reply ) new-value)

These are various generic accessors which are used to query and modify a REPLY objects. If you are writing a handler, you should not use these accessors but instead utilize the corresponding functions with an asterisk at the end of their name, also listed in this section. These generic accessors are only exported for users who want to create their own subclasses of REPLY.

Sessions

Hunchentoot supports sessions: Once a request handler has called START-SESSION, Hunchentoot uses either cookies or (if the client doesn't send the cookies back) rewrites URLs to keep track of this client, i.e. to provide a kind of 'state' for the stateless http protocol. The session associated with the client is a CLOS object which can be used to store arbitrary data between requests.

Hunchentoot makes some reasonable effort to prevent eavesdroppers from hijacking sessions (see below), but this should not be considered really secure. Don't store sensitive data in sessions and rely solely on the session mechanism as a safeguard against malicious users who want to get at this data!

For each request there's one SESSION object which is accessible to the handler via the special variable *SESSION*. This object holds all the information available about the session and can be accessed with the functions described in this chapter. Note that the internal structure of SESSION objects should be considered opaque and may change in future releases of Hunchentoot.

Sessions are automatically verified for validity and age when the REQUEST object is instantiated, i.e. if *SESSION* is not NIL then this session is valid (as far as Hunchentoot is concerned) and not too old. Old sessions are automatically removed.

Hunchentoot also provides a SESSION-REGENERATE-COOKIE-VALUE function that creates a new cookie value. This helps to prevent against session fixation attacks, and should be used when a user logs in according to the application.

[Standard class]
session

SESSION objects are automatically maintained by Hunchentoot. They should not be created explicitly with MAKE-INSTANCE but implicitly with START-SESSION and they should be treated as opaque objects.

You can ignore Hunchentoot's SESSION objects and implement your own sessions if you provide corresponding methods for SESSION-COOKIE-VALUE and SESSION-VERIFY.

[Function]
start-session => session

Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this case the function will also send a session cookie to the browser.

[Accessor]
session-value symbol &optional session => value, present-p
(setf (session-value symbol &optional session ) new-value)

This accessor can be used to associate arbitrary data with the the symbol symbol in the SESSION object session. present-p is true if such data was found, otherwise NIL. The default value for session is *SESSION*.

If SETF of SESSION-VALUE is called with session being NIL then a session is automatically instantiated with START-SESSION.

[Function]
delete-session-value symbol &optional session => |

Removes the value associated with symbol from session if there is one.

[Special variable]
*session*

The current session while in the context of a request, or NIL.

[Function]
remove-session session => |

Completely removes the SESSION object session from Hunchentoot's internal session database.

[Function]
reset-sessions &optional acceptor => |

Removes all stored sessions of acceptor. The default for acceptor is *ACCEPTOR*.

[Function]
regenerate-session-cookie-value session => cookie

Regenerates the session cookie value. This should be used when a user logs in according to the application to prevent against session fixation attacks. The cookie value being dependent on ID, USER-AGENT, REMOTE-ADDR, START, and *SESSION-SECRET*, the only value we can change is START to regenerate a new value. Since we're generating a new cookie, it makes sense to have the session being restarted, in time. That said, because of this fact, calling this function twice in the same second will regenerate twice the same value.

[Special variable]
*rewrite-for-session-urls*

Whether HTML pages should possibly be rewritten for cookie-less session-management.

[Special variable]
*content-types-for-url-rewrite*

The content types for which url-rewriting is OK. See *REWRITE-FOR-SESSION-URLS*.

[Special variable]
*use-remote-addr-for-sessions*

Whether the client's remote IP (as returned by REAL-REMOTE-ADDR) should be encoded into the session string. If this value is true, a session will cease to be accessible if the client's remote IP changes.

This might for example be an issue if the client uses a proxy server which doesn't send correct 'X-Forwarded-For' headers.

[Generic function]
session-remote-addr session => remote-addr

The remote IP address of the client when this session was started (as returned by REAL-REMOTE-ADDR).

[Special variable]
*use-user-agent-for-sessions*

Whether the 'User-Agent' header should be encoded into the session string. If this value is true, a session will cease to be accessible if the client sends a different 'User-Agent' header.

[Generic function]
session-user-agent session => user-agent

The incoming 'User-Agent' header that was sent when this session was created.

[Generic accessor]
session-max-time session => max-time
(setf (session-max-time session ) new-value)

Gets or sets the time (in seconds) after which session expires if it's not used.

[Special variable]
*session-max-time*

The default time (in seconds) after which a session times out.

[Special variable]
*session-gc-frequency*

A session GC (see function SESSION-GC) will happen every *SESSION-GC-FREQUENCY* requests (counting only requests which create a new session) if this variable is not NIL. See SESSION-CREATED.

[Function]
session-gc => |

Removes sessions from the current session database which are too old - see SESSION-TOO-OLD-P.

[Function]
session-too-old-p session => generalized-boolean

Returns true if the SESSION object session has not been active in the last (session-max-time session) seconds.

[Generic function]
session-id session => session-id

The unique ID (an INTEGER) of the session.

[Generic function]
session-start session => universal-time

The time this session was started.

Customizing session behaviour

For everyday session usage, you will probably just use START-SESSION, SESSION-VALUE, and maybe DELETE-SESSION-VALUE and *SESSION*. However, there are two ways to customize the way Hunchentoot maintains sessions.

One way is to mostly leave the session mechanism intact but to tweak it a bit:

  • The publicly visible part of a session is encoded using a secret which you can set yourself.
  • And it is stored using a cookie (or GET parameter) name that you can override.
  • Each session receives a new ID when it is created and you can implement a more robust way to do that.
  • You can arrange to be called whenever a session is created to trigger some action. You might also do this to invent your own session garbage collection.
  • By default, all sessions are stored in a global alist in memory. You can't change the alist part, but you can distribute your sessions over different "databases".
  • By default, every operation which modifies sessions or one of the session databases is guarded by a global lock, but you can arrange to provide different locks for this.

The other way to customize Hunchentoot's sessions is to completely replace them. This is actually pretty easy: Create your own class to store state (which doesn't have to and probably shouldn't inherit from SESSION) and implement methods for SESSION-VERIFY and SESSION-COOKIE-VALUE - that's it. Hunchentoot will continue to use cookies and/or to rewrite URLs to keep track of session state and it will store "the current session" (whatever that is in your implementation) in *SESSION*. Everything else (like persisting sessions, GC, getting and setting values) you'll have to take care of yourself and the other session functions (like START-SESSION or SESSION-VALUE) won't work anymore. (Almost) total freedom, but a lot of responsibility as well... :)

[Special variable]
*session-secret*

A random ASCII string that's used to encode the public session data. This variable is initially unbound and will be set (using RESET-SESSION-SECRET) the first time a session is created, if necessary. You can prevent this from happening if you set the value yourself before starting acceptors.

[Function]
reset-session-secret => secret

Sets *SESSION-SECRET* to a new random value. All old sessions will cease to be valid.

[Generic function]
session-cookie-name acceptor => name

Returns the name (a string) of the cookie (or the GET parameter) which is used to store a session on the client side. The default is to use the string "hunchentoot-session", but you can specialize this function if you want another name.

[Generic function]
session-created acceptor new-session => result

This function is called whenever a new session has been created. There's a default method which might trigger a session GC based on the value of *SESSION-GC-FREQUENCY*.

The return value is ignored.

[Generic function]
next-session-id acceptor => id

Returns the next sequential session ID, an integer, which should be unique per session. The default method uses a simple global counter and isn't guarded by a lock. For a high-performance production environment you might consider using a more robust implementation.

[Generic accessor]
session-db acceptor => database
(setf (session-db acceptor ) new-value)

Returns the current session database which is an alist where each car is a session's ID and the cdr is the corresponding SESSION object itself. The default is to use a global list for all acceptors.

[Generic function]
session-db-lock acceptor &key whole-db-p => lock

A function which returns a lock that will be used to prevent concurrent access to sessions. The first argument will be the acceptor that handles the current request, the second argument is true if the whole (current) session database is modified. If it is NIL, only one existing session in the database is modified.

This function can return NIL which means that sessions or session databases will be modified without a lock held (for example for single-threaded environments). The default is to always return a global lock (ignoring the acceptor argument) for Lisps that support threads and NIL otherwise.

[Generic function]
session-verify request => session-or-nil

Tries to get a session identifier from the cookies (or alternatively from the GET parameters) sent by the client (see SESSION-COOKIE-NAME and SESSION-COOKIE-VALUE). This identifier is then checked for validity against the REQUEST object request. On success the corresponding session object (if not too old) is returned (and updated). Otherwise NIL is returned.

A default method is provided and you only need to write your own one if you want to maintain your own sessions.

[Generic function]
session-cookie-value session => string

Returns a string which can be used to safely restore the session session if as session has already been established. This is used as the value stored in the session cookie or in the corresponding GET parameter and verified by SESSION-VERIFY.

A default method is provided and there's no reason to change it unless you want to use your own session objects.

Cookies

Outgoing cookies are stored in the request's REPLY object (see COOKIE-OUT and COOKIES-OUT*). They are CLOS objects defined like this: 
(defclass cookie ()
  ((name :initarg :name
         :reader cookie-name
         :type string
         :documentation "The name of the cookie - a string.")
   (value :initarg :value
          :accessor cookie-value
          :initform ""
          :documentation "The value of the cookie. Will be URL-encoded when sent to the browser.")
   (expires :initarg :expires
            :initform nil
            :accessor cookie-expires
            :documentation "The time (a universal time) when the cookie expires (or NIL).")
   (max-age :initarg :max-age
            :initform nil
            :accessor cookie-max-age
            :documentation "The time delta (in seconds) after which the cookie expires (or NIL).")
   (path :initarg :path
         :initform nil
         :accessor cookie-path
         :documentation "The path this cookie is valid for (or NIL).")
   (domain :initarg :domain
           :initform nil
           :accessor cookie-domain
           :documentation "The domain this cookie is valid for (or NIL).")
   (secure :initarg :secure
           :initform nil
           :accessor cookie-secure
           :documentation "A generalized boolean denoting whether this is a secure cookie.")
   (http-only :initarg :http-only
              :initform nil
              :accessor cookie-http-only
              :documentation "A generalized boolean denoting whether this is a HttpOnly cookie.")))
The reader COOKIE-NAME and the accessors COOKIE-VALUE, COOKIE-EXPIRES, COOKIE-MAX-AGE, COOKIE-PATH, COOKIE-DOMAIN, COOKIE-SECURE, and COOKIE-HTTP-ONLY are all exported from the HUNCHENTOOT package. For now, the class name itself is not exported.

[Function]
set-cookie name &key value expires path domain secure http-only reply => cookie

Creates a COOKIE object from the parameters provided to this function and adds it to the outgoing cookies of the REPLY object reply. If a cookie with the same name (case-sensitive) already exists, it is replaced. The default for reply is *REPLY*. The default for value is the empty string.

[Function]
set-cookie* cookie &optional reply => cookie

Adds the COOKIE object cookie to the outgoing cookies of the REPLY object reply. If a cookie with the same name (case-sensitive) already exists, it is replaced. The default for reply is *REPLY*.

Logging

Hunchentoot can log accesses and diagnostic messages to two separate destinations, which can be either files in the file system or streams. Logging can also be disabled by setting the ACCESS-LOG-DESTINATION and MESSAGE-LOG-DESTINATION slots in the ACCEPTOR to NIL. The two slots can be initialized by providing the :ACCESS-LOG-DESTINATION and :MESSAGE-LOG-DESTINATION initialization arguments when creating the acceptor or set by setting the slots through its ACCEPTOR-MESSAGE-LOG-DESTINATION and ACCEPTOR-ACCESS-LOG-DESTINATION accessors.

When the path for the message or accept log is set to a variable holding an output stream, hunchentoots writes corresponding log entries to that stream. By default, Hunchentoot logs to *STANDARD-ERROR*.

Access logging is done in a format similar to what the Apache web server can write so that logfile analysis using standard tools is possible. Errors during request processing are logged to a separate file.

The standard logging mechanism is deliberately simple and slow. The log files are opened for each log entry and closed again after writing, and access to them is protected by a global lock. Derived acceptor classes can implement methods for the ACCEPTOR-LOG-MESSAGE and ACCEPTOR-LOG-ACCESS generic functions in order to log differently (e.g. to a central logging server or in a different file format.

Errors happening within a handler which are not caught by the handler itself are handled by Hunchentoot by logging them to the established ACCEPTOR-MESSAGE-LOG-DESTINATION.

[Function]
log-message* log-level format-string &rest format-arguments => result

Convenience function which calls the message logger of the current acceptor (if there is one) with the same arguments it accepts. Returns NIL if there is no message logger or whatever the message logger returns.

This is the function which Hunchentoot itself uses to log errors it catches during request processing.

[Special variable]
*log-lisp-errors-p*

Whether Lisp errors in request handlers should be logged.

[Special variable]
*log-lisp-backtraces-p*

Whether Lisp backtraces should be logged. Only has an effect if *LOG-LISP-ERRORS-P* is true as well.

[Special variable]
*log-lisp-warnings-p*

Whether Lisp warnings in request handlers should be logged.

[Special variable]
*lisp-errors-log-level*

Log level for Lisp errors. Should be one of :ERROR (the default), :WARNING, or :INFO.

[Special variable]
*lisp-warnings-log-level*

Log level for Lisp warnings. Should be one of :ERROR, :WARNING (the default), or :INFO.

Conditions and error handling

This section describes how Hunchentoot deals with exceptional situations. See also the secion about logging.

When an error occurs while processing a request, Hunchentoot's default behavior is to catch the error, log it and optionally display it to the client in the HTML response. This behavior can be customized through the values of a number of special variables, which are documented below.

[Special variable]
*catch-errors-p*

If the value of this variable is NIL (the default is T), then errors which happen while a request is handled aren't caught as usual, but instead your Lisp's debugger is invoked. This variable should obviously always be set to a true value in a production environment. See MAYBE-INVOKE-DEBUGGER if you want to fine-tune this behaviour.

[Special variable]
*show-lisp-errors-p*

Whether Lisp errors should be shown in HTML output. Note that this only affects canned responses generated by Lisp. If an error template is present for the "internal server error" status code, this special variable is not used (see acceptor-status-message).

[Special variable]
*show-lisp-backtraces-p*

Whether Lisp backtraces should be shown in HTML output if *SHOW-LISP-ERRORS-P* is true and an error occurs.

[Generic function]
maybe-invoke-debugger condition => |

This generic function is called whenever a condition condition is signaled in Hunchentoot. You might want to specialize it on specific condition classes for debugging purposes. The default method invokes the debugger with condition if *CATCH-ERRORS-P* is NIL.

[Condition type]
hunchentoot-condition

Superclass for all conditions related to Hunchentoot.

[Condition type]
hunchentoot-error

Superclass for all errors related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION.

[Condition type]
parameter-error

Signalled if a function was called with incosistent or illegal parameters. A subclass of HUNCHENTOOT-ERROR.

[Condition type]
hunchentoot-warning

Superclass for all warnings related to Hunchentoot and a subclass of HUNCHENTOOT-CONDITION.

Miscellaneous

Various functions and variables which didn't fit into one of the other categories.

[Function]
abort-request-handler &optional result => result

This function can be called by a request handler at any time to immediately abort handling the request. This works as if the handler had returned result. See the source code of REDIRECT for an example.

[Function]
handle-if-modified-since time &optional request => |

This function is designed to be used inside a handler. If the client has sent an 'If-Modified-Since' header (see RFC 2616, section 14.25) and the time specified matches the universal time time then the header +HTTP-NOT-MODIFIED+ with no content is immediately returned to the client.

Note that for this function to be useful you should usually send 'Last-Modified' headers back to the client. See the code of CREATE-STATIC-FILE-DISPATCHER-AND-HANDLER for an example.

[Function]
handle-static-file path &optional content-type => nil

Sends the file denoted by the pathname designator path with content type content-type to the client. Sets the necessary handlers. In particular the function employs HANDLE-IF-MODIFIED-SINCE.

If content-type is NIL the function tries to determine the correct content type from the file's suffix or falls back to "application/octet-stream" as a last resort.

Note that this function calls SEND-HEADERS internally, so after you've called it, the headers are sent and the return value of your handler is ignored.

[Function]
redirect target &key host port protocol add-session-id code => |

Sends back appropriate headers to redirect the client to target (a string).

If target is a full URL starting with a scheme, host, port, and protocol are ignored. Otherwise, target should denote the path part of a URL, protocol must be one of the keywords :HTTP or :HTTPS, and the URL to redirect to will be constructed from host, port, protocol, and target.

code must be a 3xx HTTP redirection status code to send to the client. It defaults to 302 ("Found"). If host is not provided, the current host (see HOST) will be used. If protocol is the keyword :HTTPS, the client will be redirected to a https URL, if it's :HTTP it'll be sent to a http URL. If both host and protocol aren't provided, then the value of protocol will match the current request.

[Function]
require-authorization &optional realm => |

Sends back appropriate headers to require basic HTTP authentication (see RFC 2617) for the realm realm. The default value for realm is "Hunchentoot".

[Function]
no-cache => |

Adds appropriate headers to completely prevent caching on most browsers.

[Function]
ssl-p &optional acceptor => generalized-boolean

Whether the current connection to the client is secure. See ACCEPTOR-SSL-P.

[Function]
reason-phrase return-code => string

Returns a reason phrase for the HTTP return code return-code (which should be an integer) or NIL for return codes Hunchentoot doesn't know.

[Function]
rfc-1123-date &optional time => string

Generates a time string according to RFC 1123. Default is current time. This can be used to send a 'Last-Modified' header - see HANDLE-IF-MODIFIED-SINCE.

[Function]
url-encode string &optional external-format => string

URL-encodes a string using the external format external-format. The default for external-format is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*.

[Function]
url-decode string &optional external-format => string

Decodes a URL-encoded string which is assumed to be encoded using the external format external-format, i.e. this is the inverse of URL-ENCODE. It is assumed that you'll rarely need this function, if ever. But just in case - here it is. The default for external-format is the value of *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT*.

[Function]
escape-for-html string => result

Escapes the characters #\<, #\>, #\', #\", and #\& for HTML output.

[Function]
http-token-p object => generalized-boolean

This function tests whether object is a non-empty string which is a token according to RFC 2068 (i.e. whether it may be used for, say, cookie names).

[Function]
mime-type pathspec => result

Given a pathname designator pathspec returns the MIME type (as a string) corresponding to the suffix of the file denoted by pathspec (or NIL).

[Function]
within-request-p => generalized-boolean

Returns true if in the context of a request. Otherwise, NIL.

[Special variable]
*tmp-directory*

This should be a pathname denoting a directory where temporary files can be stored. It is used for file uploads.

[Special variable]
*header-stream*

If this variable is not NIL, it should be bound to a stream to which incoming and outgoing headers will be written for debugging purposes.

[Special variable]
*cleanup-function*

A designator for a function without arguments which is called on a regular basis if *CLEANUP-INTERVAL* is not NIL. The initial value is the name of a function which invokes a garbage collection on 32-bit versions of LispWorks.

This variable is only available on LispWorks.

[Special variable]
*cleanup-interval*

Should be NIL or a positive integer. The system calls *CLEANUP-FUNCTION* whenever *CLEANUP-INTERVAL* new worker threads (counted globally across all acceptors) have been created unless the value is NIL. The initial value is 100.

This variable is only available on LispWorks.

Testing

Hunchentoot comes with a test script which verifies that the example web server responds as expected. This test script uses the Drakma HTTP client library and thus shares a significant amount of its base code with Hunchentoot itself. Still, running the test script is a useful confidence test, and it is also possible to run the script across machines in order to verify a new Hunchentoot (or, for that matter Drakma) port.

To run the confidence test, start the example web server. Then, in your Lisp listener, type 

(hunchentoot-test:test-hunchentoot "http://localhost:4242")
You will see some diagnostic output and a summary line that reports whether any tests have failed. (You can also use the example certificate and key files in the test directory and start and test an https server instead.)

[Function]
hunchentoot-test:test-hunchentoot base-url &key => |

Runs the built-in confidence test. base-url is the base URL to use for testing, it should not have a trailing slash. The keyword arguments accepted are for future extension and should not currently be used.

The script expects the Hunchentoot example test server to be running at the given base-url and retrieves various pages from that server, expecting certain responses.

Debugging

By default, Hunchentoot intercepts all errors that occur while executing request handlers, logs them to the log file and displays a static error page to the user. While developing applications, you may want to change that behavior so that the debugger is invoked when an error occurs. You can set the *CATCH-ERRORS-P* to NIL to make that happen. Alternatively, you may want to have Hunchentoot display detailed error information in the error response page. You can set the *SHOW-LISP-ERRORS-P* to a true value to make that happen. If you don't want to see Lisp backtraces in these error pages, you can set *SHOW-LISP-BACKTRACES-P* to NIL.

History

Hunchentoot's predecessor TBNL (which is short for "To Be Named Later") grew over the years as a toolkit that I used for various commercial and private projects. In August 2003, Daniel Barlow started a review of web APIs on the lispweb mailing list and I described the API of my hitherto-unreleased bunch of code (and christened it "TBNL").

It turned out that Jeff Caldwell had worked on something similar so he emailed me and proposed to join our efforts. As I had no immediate plans to release my code (which was poorly organized, undocumented, and mostly CMUCL-specific), I gave it to Jeff and he worked towards a release. He added docstrings, refactored, added some stuff, and based it on KMRCL to make it portable across several Lisp implementations.

Unfortunately, Jeff is at least as busy as I am so he didn't find the time to finish a full release. But in spring 2004 I needed a documented version of the code for a client of mine who thought it would be good if the toolkit were publicly available under an open source license. So I took Jeff's code, refactored again (to sync with the changes I had done in the meantime), and added documentation. This resulted in TBNL 0.1.0 (which initially required mod_lisp as its front-end).

In March 2005, Bob Hutchinson sent patches which enabled TBNL to use other front-ends than mod_lisp. This made me aware that TBNL was already almost a full web server, so eventually I wrote Hunchentoot which was a full web server, implemented as a wrapper around TBNL. Hunchentoot 0.1.0 was released at the end of 2005 and was originally LispWorks-only.

Hunchentoot 0.4.0, released in October 2006, was the first release which also worked with other Common Lisp implementations. It is a major rewrite and also incorporates most of TBNL and replaces it completely.

Hunchentoot 1.0.0, released in February 2009, is again a major rewrite and should be considered work in progress. It moved to using the usocket and Bordeaux Threads libraries for non-LispWorks Lisps, thereby removing most of the platform dependent code. Threading behaviour was made controllable through the introduction of taskmasters. mod_lisp support and several other things were removed in this release to simplify the code base (and partly due to the lack of interest). Several architectural changes (lots of them not backwards-compatible) were made to ease customization of Hunchentoot's behaviour. A significant part of the 1.0.0 redesign was done by Hans Hübner.

Symbol index

Here are all exported symbols of the HUNCHENTOOT package in alphabetical order linked to their corresponding documentation entries:

Acknowledgements

Thanks to Jeff Caldwell - TBNL would not have been released without his efforts. Thanks to Stefan Scholl and Travis Cross for various additions and fixes to TBNL, to Michael Weber for initial file upload code, and to Janis Dzerins for his RFC 2388 code. Thanks to Bob Hutchison for his code for multiple front-ends (which made me realize that TBNL was already pretty close to a "real" web server) and the initial UTF-8 example. Thanks to Hans Hübner for a lot of architectural and implementation enhancements for the 1.0.0 release and also for transferring the documentation to sane XHTML. Thanks to John Foderaro's AllegroServe for inspiration. Thanks to Uwe von Loh for the Hunchentoot logo.

Hunchentoot originally used code from ACL-COMPAT, specifically the chunking code from Jochen Schmidt. (This has been replaced by Chunga.) When I ported Hunchentoot to other Lisps than LispWorks, I stole code from ACL-COMPAT, KMRCL, and trivial-sockets for implementation-dependent stuff like sockets and MP. (This has been replaced by Bordeaux Threads and usocket.)

Parts of this documentation were prepared with DOCUMENTATION-TEMPLATE, no animals were harmed.

BACK TO MY HOMEPAGE

hunchentoot-1.2.35/www/img/0000755000004100000410000000000012656661410015577 5ustar www-datawww-datahunchentoot-1.2.35/www/img/made-with-lisp-logo.jpg0000644000004100000410000003044712656661410022073 0ustar www-datawww-dataÿØÿàJFIFddÿìDuckyPÿîAdobedÀÿÛ„      ÿÀd,ÿÄ¢  s!1AQa"q2‘¡±B#ÁRÑá3bð$r‚ñ%C4S’¢²csÂ5D'“£³6TdtÃÒâ&ƒ „”EF¤´VÓU(òãóÄÔäôeu…•¥µÅÕåõfv†–¦¶ÆÖæö7GWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø)9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúm!1AQa"q‘2¡±ðÁÑá#BRbrñ3$4C‚’S%¢c²ÂsÒ5âDƒT“ &6E'dtU7ò£³Ã()Óã󄔤´ÄÔäôeu…•¥µÅÕåõFVfv†–¦¶ÆÖæöGWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúÿÚ ?ûùŠ»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wˆ~Hþbj™þk_ÝÜ%Å—–1u¿,hB4DT³ÒVÞ* å'7äÄŸ‹À2u8F>ß~n>Ÿ)ÉÄ{¤GɘùKó/Êžy×|á¡ùVê]`yê-?_Ö ŽºxÔ$Vy,¡¹­%š fNJ¤òªŠòa–0 ¶¾]õÞΣ2Dz3쩵ث±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®ÅX’yóÉ’\yžÊ3é·‡“"iüצEsÝiñ¢ Ü@¬dE** =²Ï [;òóaâG}ùsL<­¯GæŸ,ùwÌðØÜéùK³Õ"ÓoB-ͺÞB“§³¨tÅ‚±„äg÷Â\Q¼'¹NÅ]Š±áæÏ-‰ßÉg[´O6-‚j‹å÷%ÓÙ;´bxãj@èUŠ×‰§*TV~¸x«nöÊ›]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUàߟÿ“qþmy/T·Ñ%‹EüÀ´±¹·òÇšý^q Ôm ÞŸ%Ê+H¶÷»Å £,²…/æV—QáL^ñê?O¼8Úœ,vÚ]èø¼ÿVÿœ¡‹BóFùSiùM®i¿™Wš@Ô­|«­Þiš]Œv±;Áû«è®.½uãõhdøT± BsbŽ,g4å躰 ?-«âCTµœ2áu¯Ÿ#äûËò'Ê_šÞOÌÍßÌi|Ùæ5Ù†Ó|¯¤HùoGÓî&Š;x-¤xnf!T›–g ‘¹BÏ!ÔäÇôB4^¤þ:;=42}s•“ÐrŽ÷ÑYˆå;v*ìUØ«óï4ÏËÏ)êÞpÖ-o/¬4’ÏO$¹•î'ŽÞ$dxÒ­$ª*Ϊì@äá3Myr q2/ˆ?6¿1ÿ0?4gÒ|‡§ù2ßBÖ’þÇ]Ð<µa"ëžkìæåÜÒE%¾™¤FÌ M4óÏ!‘>.\qÁ“XË€D‚ ¦÷s”Z\v|ÓËé>ù~¡ö³ùÿçüëçiì¼ãæÏÍCòãÏVÉåø|„-ãM6<šÚçQ¹·úÝðbºƒ '§¤~Ñ:1‹G yñ^þèÝ´ù¶þNSõJT|º|yŸ°>™ò‰çO/è­¦ùãÎñ~`jQL~©æÒ¢Ògk~ÜÅÒC$œÃq¤b„™Ë(HÜEy]¹˜ã(Š‘¿…3l­±Ø«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š¿¿çéú5î“æoÉ?Ì.i¬ï~¯©iÃQ·s–óXÍoujÈëFV¬òAÛlè;‰Âp–ã»ß±t=³”$<Ò/ùÇ?ùÍM?_K%þp^C¥k $g_ŒV—‡ [Þ‹ ‡ùöFïÀý®{¶½˜–;˦±ê=ÝãËŸ½¯K¯ôÏŸ{éoÏ¿È]óóDÐ4Ûÿ0Þy~Mñîìï-QgŽE™H¯2‚H‹Wmú×4}‘ÚÓìéÊB"V+}œ½NœgTö­I·Ð4MB´’Ymt[{ if`Ò4vѬJÎÀX…ÜÓ®k2ä9&fy’O;1á1¯ËÿÉ¿%~qù'Y²ó±Õµo%ÙyóÍ2Ùy^×S»²ÒïµßÉs¤‘4þ•äsq ÜCØ×;}6£&xëipGzß–ße.,ËUÕ¯n­çßšv?”:]Ãé•žZÒ~t鶩ÔZ"¦çG·’?R»¹b%õ#Œ¤<üa©Îx|9úå=£ºGù s¸YjÎ1 áç/Ñæ{ÿ[é_ùÇ/%ëþPòv§q¬[ÏåÛ5j’k>\ü¸–O.XΊÐrf1É)yaB"ŠGhãZ)g9 1'Š@Q—óìä3̹zLfßkÜçÐyS”y›Í^Zò^sæ6ëÖ[Ñ-)õOQ-á ~Êr*ÍJ*ÉØrP„¦j"ËÎ0#Aóö§ùíæ2¹·ü©òK=žüãúu‹)i¦—÷#§÷‚ÙÝdl£>¯O§úåÅ.èïó—!ð³äâKU)}âvû9ýÏó¾½k¢Û¦¡ù×ùù©ÚÇr´‹L´Õ?ÂvOJò[{}*H/%j²\Li±$f>ÐÕjMi±€ã?+`hÉ:ß$ÏχîÝámùñÿ8§ Ç£kùÃæ­>ì0Xïlu¯;DT¶ÀúÑËÀ÷äJÿ6fÇKÛ\ø÷ŒsùœÎ?93Û¯4ë?š>@ów•(ÿ>ôßÌ;]{J¹µÿy¥ ½¹´gB!ž¸#‚úŠN¦å'ŠPV G]—K1ù¼&"ùÄWütüm9HÂwc¯âþvúòþò]óÎÒ;–XcüÅò\–÷¡ªCË—k<* ¡%¡Ôî4û1ïÐf7dÌKáüÙX÷HWûÑórpž¾ñ÷i}o™Î{±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUùÙÿ?5ò“k¿óv^b‚i¼‘æ{Û™éºZ^$¶. ø4ÓÃ_–m»'jïµÕö¼8°ßqýÉïÉÊßÉÏ8aÇÅs4O^[rï³ú&Ÿ9ÂFR¢ÿ‘Ÿó–þ}ü¡º¦[Î^GŒ„]îR'³Jîl®b€¾Øð O,‡jû=ƒ[s¢}ã‘÷ÓÏÞ>¶x¶;‡ëOågç§å¯ç ’Ïäí~95$Œ=÷–ï)£oµO8ž@wxË'ùYçºþÊÔhdŽÝãxŸè4]ÎD2INîÿ.ícŸXŸÊžd×?/‡™Ù¿Å–¾]º[k}IdÚfxdI¤âÜE?S,ÓöÆ|1á5 9q á÷~£cÉ‘ÇÏ„‘|ëñöØÃy~ÿÊþròsZþ]/™*<…k×–|™ ÝÙÚÌ5¨ÝŒwwP_½´2‹añ@¾·÷Íë?Æ‘•Íìín'<³>,Žò ‘ÃåVwë·-†ÖÄG†CÓq€ïøþ:½é¿ç uWW[oȯ>}`ssåx¢cñHšô¦”=Q[Ã35¥åcòŸüK•ù£üÉ}Ÿ­j˜ž>gå ¯—?*ôé*¦è<žcÕÊÐÑ~‘úIÿbÀæË.U´þ÷°ïð•4+™|ïç-^2kšj4³yëÍ÷«s%šT0};k¨[xâOlÖfíN«÷c`†"¯ôËãm\©=çñ·ÁñßçWüçg–ü¾—zåù«Z¢“Í7*˦[šS”x½ÃÐü)Ђãlßvg²™2Tõ˜ÿ7ø¿»ï÷89ûB1ÚžþÏÍÉ¿žó’Þp¾¼Ñ4}kóÌ×,Ÿ¥5R‚Ü1¤k5̆;{dK*öFvñ}1QˆéøܺØã˨–À’ú»LÿŸ`ÿÎDßÚ%ÍÖ·ägûVš•ëÊ»¹µÓç½6s˜‡¶°ÊGà?[š;1êÇö>+ó·•¼Áù5ù‰«ù[üKe?š<—{õ{sË—s4P^F¨ÜùÄģР0+ÔØBPÔc²=2èGOs’ÌoqÜû¯ò£þr·Ì•ï—<¯ù™©/“ÿ4|õß#yëT¡³¸ºky-›Oנ⬑ÜÃ;Fò¯Udø]7-¨ìoÊLæÓŽ,r(uwp÷W/‡Wa‡XI{Hr? ¿g?+¿34ŸÌï/É©Z[¾“®i3ýCÍÞW¸ek2ýQ]¡v_†HÝX= ų%ÇMçµ×ü¯©[ýjÛPòî¯n°ÝÚú©-¥Ê,ª$†däÀe!•‡Pj2œ‚¶#æ’ Oq}Yù{ÿ9»ùÍäÈà²Öî­|ÿ¥CEôõ•"ð ¦ËyWcþT¢Cœö³Ù}&}à —/‘ýæb×ä‡=ýלּ¿ÿ? ü·»†?ñ7’¼Ã¡Ýµ¥µÔ _Þ<–®~ˆóžÍìv¢'Ñ8‘çq?§ïscÚp<Á Ρÿ?üš¶Š¶:šõ)ÈøPZZD€ÔlÌ÷ux)Êá솬åñ?©‘í,}xgœ¿çáÞf¼Ž["yÇC­U5=^áï¥*z2ÁÛ¢0÷gµÓ{Ž;åÈOöïúiöœÒ)ñOŸ¿6ÿ1ÿ3î¾³ç6ßkˆ¯Î =ÜEg t¬V±… 6¨Zøœéô§Ò Å<úüù¸93O'Ômö×üâ¯üà'™¿5ŽŸç͈¯|›ùtÅ'Óô‚¦ SYNªQ\VÞÿ~0äëýØ¡ ]wjG§òû°Ñvd²ú§´~ÒýÎòo’¼§ù{åû*ù'@³ò×—ôÕãi¦XÆ#@hw;³»R¬îK1݉9ÌäÉ,’⑲ôXñÇሠù£þsCþr)?ç¿+$—G˜Ì;zúg’c >ƒ"¯ÖoÈ5[,Š@¡¬Œ€Ž5ÌÎÎÒ~c&ÿHçú¾.&¿UàcÛê<¿[ñkþq[Οó¾Fó½ÇŸ?=í|Áæ=[H“ë~TÒíl¡¼ÓÍØøÍÕÛKr’I(oîÔÇÀ7ÆÌM8ôzìy§TçÞè4y0Â\Y,žÔOÌ/ËëùÍK=6âëþqêçòÛHcéœ>k¾‡Mó vF" "Î;™.¡ª¥ÌÉõFâLY$¼â?ÍŸêwq~p}?œv?/ÖøÊúëþrþpsÎúBù¡ßUòÌÓ¼¯çØ£’çN¿Ó‘Œ‹¦^Š‡1 ’±¹õmÏ'·fNi.PŇV ±ìNòŸó‡qóå/âèF¼øÚ)‹åÐô÷~9t~¹þGÿÎDþ_~zèÐÜùvþ;1Çn³ê¾R¸™æ¯–rØJƒcðȱÉÉ›>šxNü¿ûàXwš}T3 ¹÷=ë1Ü—b®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìU-Õ´m#_Óî4wJ³Ö´»µãu¦ßÁͼ£Áâ•YX|ÆÈÄØ4Q(‰ "Þw¢þDþIùsQ]_@ü¡òfªG –FÏB°†h˜R†'HA 4R7ß®]-VY 3${ËTtØ¢lDî ó»þqÇò¯óÿI[>è\µKXš=Í–`Õ,¹TÒ)ø°e©¯§"²W~5ß%¦ÕäÓ›‰Û»£ F—qR÷õ~)ÿÎ@Îþk~NYj^iòÔ©ù‘ä[s\Þéñ2jVVêIõ.¬¾*¢¯Úx™Àݘ"ŠçG¥í\y ½2û>nƒSÙ™1!¸û_fÑÖ¦Ú6®ùŠíl<¿¢ßë·Í@¶Z}´·RšÖ”H•›·†FSM&12Ø }}ùiÿ8ÿ9ù†ðO}åTü½Ñå#ž§æ‰>©(_Ú¥’ .¹Ð©÷fk‹±W–~pk¡y:g´ü¾Ÿó?]ÔîNòÏ“¢µKˆ®oæGhܲƒ µº-,Ò•UQJ–*­~ž473ßEgB9J‰•~GÈ9&C½ÃÚV$ =1‰"÷$ôt™{>ŒLªR¹Õõ§“¼±ùùÿ8,ZD-ùÿÿ8íqŠ (‹ù£Ë0õå¥OÖ`ZÐÇ=9*ź¶IáÖoôdÿc/Ôæã†m&ß\>ÐûBÆûòïó«È‰umú/ϾBóe±WŠhÖâÖt±H*¯­XG 0ÍqÃ>¢AÏ¡ÐÄ¿8?2¿çß^cò~º<íÿ8Åæ³¥IopoSÈz½íŹ‚P>¦êp°š7§Â¥ÝX ƒ1RW6¸ûN9aþpý#—㓪ËÙ’âÂ~ôǽfÿ9—ùùù&Ñhßó‘?“^`½Óm¤þg6« êªhÌ·Ö±>ôÐl`ÿ)ØîSÙøóoŠcñäw2±×æöXŸãcö>–òwüçÏü㛣ŒKç·òó€[Mó œÖ¬•£OšÛoiŽbäì½D?†ýß‹rñö– õ¯{Û4ïùÈÈX/èïÎ#Ý»'©è§˜4ïP( U£3†]Èê3ésp—ȹUˆò˜ù‡¬Ã470Åqo*\[Ü"Éñ°ttqUeaPA ŒÇ"›ÕqWb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*Ð î"¤mâ68«ùÓÿœ¯ò”0¿ç+o?.?ç¼ Z½ÅÄzF·m§·z÷7kÙR:úp$"‹)Pª$sãn‡$±éøò¹ü:<¶¶ɨàÄ7åñ~ÚÿÎ8~FéóŸ•ÚOl/ŸUÔ=GÔ<Ë«3? FuQ3CéÆ¡QE6oˆ±<æ³Ru ÏÃÜôM8ÁŒD|}ïËÏùù-½—<ÿå]GÉþsó=›üíæ­æí.=VálᵈÁkbðÀ… í«±ß‰'}Îë±ÉÉ$ †ß7OÚÀB`Ä›<÷~¨ÿÎ9þaÍOÈÿËO<¼ßX¾Õ´H"Ö¥¨©Ô,ëizzšVx\Šö¦i5x¼,²ŸÙÑÜérø¸£/'ã×çÇ缟Ÿó—^Oò~Ÿæ½gFü¨°ó.—äئѯ¤³7PÍ~jêñ’§Ô‘Ø#ÐþíÒµ¿Òé| 1‘ʉßÝ°tZO¨ðØ{÷/Ü/"ù3Iü½ò¦‘äíkÛ+EIÖ}FåîîŸÕ•æc,ò|Ny9Üç7—!É##̽mü²ó,בÅåÖ«}«®žðú†æ{­6çNŽÈôÅÓ?Ù5 R”ËqåàŒ‡ó…}¶Õ<|R‰î?¢™š¼¹cæÿ-ë~WÔ溷Óõû9log±­®R9”«¦O‰³ ÆF0èÎp‰«ñãþp‡I»Ó¿ç2¿9<©aæ=cVò—¢óDzi¿¼–ághuˆ,!šj2ÆòÉ3+¾æžþÒ:XHf¾ët]ŸÔÎ š÷Óö›9×~ìUƒê_–?–ºÌ¢}cò÷Ë:¬à’&¼ÒlçpHüRDÇz»-²G”ͬáçòY§þVþYi3 +òçÊúeÀ ‹‹M"ʪš‰"c‰Ïó‘ù•`9D|™Ð@@2¦Æ9ç*é^dÐ|Ÿ©kö6>hóD7SùwBšeK›Èì•ZàÃ5n Õ oJžŠÔ˜Ç# 6Ø‘'sÉóοmÿ9I?üäç–gЮ´ËOùÇM8qÚ3Ï+C'ª’#¦zþ·L¡*€MIul¸?åÍ߉øø8²üq_Ýþ>)?üæüäæ¥ÿ8Ñå¿'jº7—¬|É©y«RžÐXßNðªAm’IÓø‰ è:S}ûd»?D52 š v¬éâo££´>üºŽÇÌ1ͦ:ùpA®Cc,–ó[þ’´ã:Á.ÒFÉê­öõÌ;ðçc¡ûœªã…£ï~IÎ*隆ÿ9Ùù‡ä/Íž`×<£ùo˜ÒÎÛUÔ¦¼¢ÛOŸI~. Qçâ ^´¯Å›íqI•rI¢j¥Iúü´9λ÷b¯ÉùùO”-ü¡¡hŸ›>^óo™´Ÿ7yŸÌVš5öm©ÏœlâÓ§%£·Œ¨GV·pwäÕ®ÔÞö>N2qùoÍÒö¶>& ²kŸ“ë¿ùÅ?ÉÍÈ_—¾Pó¤zÆ¿«ù§Ï^QÑnüË&­ªÜ_Û­ÄöÑÜÍõh¥b‘RB*h`kµ$Ìh ªn‹„¬Ù÷}ç“æÁäÏ5Ÿ!-«yØiŸá%¾ [GÑoªúµÛ©ÆµÛÇlÄÅÃÄ8¹^þç+' áç[{ÞQÿ8Ñkùñiùe ÎE^[^~`I©]I£õC,V ÃÃØÿ£´ýCXöàPuåúÄäýÏÓ_ŽmA”C÷¿Wã¹ôb¹O=üÌüÔòä÷–¿Åÿ˜úúùs˦î+¨k›¢n' cŒEiÒB1Ùh)¾[‡óK†ËVlÐÅ)š ƒÊ^kÐ|óå­ÎW½mK˾bµKÝPh&¶3[ɺIé\$r¨a¸ä£mò9 a#s á18‰E‘d;v*ìUØ«±Wb¨OR°Ñ´ÝCXÕ.’ËLÒm¥¼ÔodÙ!‚2K#R»*©' A‘¡Í€,¿ ??¿7¼Ûù]çûŸÌoùÆcçÿËË¿4Üɨú¶-¯–uMbs$²Ï¤Øj²*†v>˜ej•àΛK§ŽXpfᔇqõæCÎjsËøðñŸ‘>@¾†ÿŸgyoȨ?2õ½b+³ù÷§ê/iæ‹]f3å–Ÿ9 )!õ+4ÊÞ»0 UXľ/lÎ~>Ž•ßøäåvL!ê'ëë›õ4NéùGå"[Î[þoÎ]ùêéEΦè“þXþX]JI.£¹]ÄÝ¸Ë Ì*:OÓ7“ËùLX£ÖøãñÉÒÃæ²e—JáÇ7Êÿó‘žeòGüãÇæä/–Òå¿6¼Ñæ«]òßOUã¥^G¨j+ð›ÍON½·¿¸œ“Z–ððªÕSŠÕ‚íÎÔO‰}OØE~„ëð ?‡]Ú7ý/ÕïùÊÏè?!ÿ&/?1t»Xµ}[WšÛLòe¼ü…¼—·ÑÉ,RL)Q<…E qãU­FE¥ñòðC›ºÖj| \cŸGÀþeüˆóœçüÁÿ9)ùÑùÉæÿ4yãSò£y¯Ë:-…úÛhÚx»…e±‡êÉ ëêý5Z•¥G3´†ª0Ô 8ànyïu³Óà9rH“V;¼ž›ÿ8+æè?,ÿç¿04üÑ-Ƨk¦kšÖ· i9Ï4VvVÇlŽä‘ÎHŠ¨;j÷Ê{O‹©Œ#ÜÚ[{:~šS=ä±ïÉ? ùçþs‡H×?6¿9ÿ4üâù.mZçNò§å”oŸgn¶ážrRPôærS!§"üH\ž§,4$cÇMnK>)kAžI/`üúËI·¹óÏç—˜m]î-´ë-2ÂÚêz4ÍõÍÔª]ˆ V€µ©ëÛ,í¹T =ÿµ«±£ê™÷<_ó7óÿSÿœ‘ü×ó~›ç/Íý_ò£ò›ËÒÜAåO)èvw—÷z›C)ŠÝÆÑ£Y®&»<òŽ¼TÓ®N(Óc0‘æOOsFmIÔd"R1ˆä_ƒê¿ù÷ËÎIèö·å¿>yoÍ­ù?}a$þ]Õ¼Ó–’Ù]Bëè}^+¹ ¢9â-É#æ‚iȶjøÄŽ>´ævgDáéoÐßÎ_!럙¿–¾gò?–üéuùy­k©l¶^p²äžÓк†â@‹ÖïûÔ¢$H(éC©Óå² `tv™ñœ1‰êüÿœaÿœ×¿çuÿùÉ$þ{y«Ró÷‘ìå»Ò Õo溒}KI¹k&²²{†ÿ¦5ÄEhiÅyýžG7ºÝ ÔG±/»¸ïgÜétz³€äŽCu÷ÖÿœLÿœ”ó'‘ÿ>¿6ßóÿUŸËñþah’y§TƒR絺¶·ý+hC#Éa;ˆã~é(M~Ž3Ã]ýz4Z¹C,¼SV/ôýÏ°ÿç|•ª~{ÜþbÿÎI~g[]ésþliw^Vü®Ò¢‘ »Ðü âH½[y”Ö)îK.ãwCÆ^#_«È0pá‡ð›>rýŽv—ÏÅ–Ä(yEò¯üâö›¨éóž>yò6™æï0ë>Rü¾bŽÊ×WÔ¦º%-Ùl€”(åj@;wÛ3µ¤d@×!ñpô`Yˆ&…ó,Kþ~-ùc¤é?›_—K×uý[[üʹÔ.u]Vý¯-ì…ÍݼpC§Âꂃ¼Ÿb:t¦övNbqÊÀ¨×/Òõp’4MŸÆÏÓÏËßùÅï,þ\ù«Fó^›ù‘ù‘¯M¢ …¶‰¯yŽ[ý2A5¼–ô–Õ£UnNI¿ÂÁ[¶irëe’&&1Ü7vø´qÇ!!)ï;?$¿ç?(<Çÿ9+ùéÿ9¤þdj_—z=Ýþ£sæKIV7š…¶¯ªK:Ùòõ +¼!ß ñ—¥7Ú½DtØ` A;Uô é4¸%¨Ë2%C{ø—©ÿÎ%iþkü’ÿœØóWäF™ç ¯2y>(µ;}]X¿ÕæZ‹è.ì‘ÎŽV6qܺþÖQ¯1Ï¥H£·ênÑ aÕ`Øßõ¿lsœzägüýkRc¤~Iyri®5-CZ¼X#PÎM¼vp  <ªÆà€Þ‡Ã7݇æ}ߥÒvÑÚßú«º˜º.‡£hÉBšMµ’I‚%ŒPÏÙïš9Kˆ’îb(üîÿœè>Qó¯üãÊ~|y/ÏZ×Ö4sgkäÝGAÔ¦¶Ó¯#¼Ôc·¹õ¡9ÑCчÄGì×6ݙŠÞ¢7çc~N¯´xg‡Ä‰>TvæËÿçu>h_ó¶¾kÐ^ïÌ¿˜iåÏ3k¹/4×kw|ÖŠ©%ZR‘ïÈü"µ^®0–³„íîlÒJqÒq åDýïÉÿ&þl~Wkú^³}ù×æ¯Í‡üÞÖn®æN“©%Í®–®œm¥6oqo,‹’d‰\U>ʛ̘2DŒG€t#›¥Ç›9 ¸»ï“î¿ùø&¥ÿ8¥ùåË_5Oç8¯ïôiSÎO[Y‚ÇE™>½)vrMÁ™&nlZ§©Üæ³²…ê&j¹íÝ¿'cÚf´ð|·ïÛ›Á¿0ç1#"4ùÈ?-þyêñk6£^_èP‹9í!ÕÞ(¡³¹ŠòJ˜áT©P¬¡˜q C•‹] ùŽ#Füù|lº)áÄ2‰›öü_¬ßó‹>ó/æä寞|â?çdÖl'MR~3pÖwsÚ-É@A!YOÅ°¥3E­ÅY¥òïG–Y0ÆRæ_@f+’ìUØ«±Wb®Å]Š¾üÖòü¯OùÊÿË/&^Cõ¯"~BéãO8)ÞõmNne”£pZ–‚jC5ý¬ÙàÉàiå/♡îÏÚë³CÆÔF=",ûÏ úºãòÛÉ7{Ó¿3@Ãmç½:ÒmŸÿ>ûÿœŒýÿ*×Pÿœ“[OÊw’’ù~Ö]Nx}/PKÄi®ñABÿW/‹®ùž{WñŒ~®ý¾÷vfjà9=?¹ôÿäOüâÏ¿.ÿ/<åù+ù‹çÍ+Îß”^`Óõ -;I°ÓÚÊþÔœz²›†g¥³*ü\]«ÊŠajµ°É1’"Bº÷9zm±Àã™'ô¾gÓ¿çߟó~A¼Öô_ÊùÉòß‘õÉ‹]ÁúŽq"0áY­­ Bò*Qy‡^_ä³0ö®€˜îCÜ\AÙ™ H†JÞçÿ8Íÿ8‰ù£ÿ8×ç+ÙtÍ^ü½ó[Éæý"]á½¹kH'zf”EÆYHsUê+LÆÖkñêc¼H廓¤ÐäÓËiÏf3sÿ8iù½ùOù§æ?̯ùůÌmËÖþk3~’ò—ší¤{hRy=WŠ9a·ºä‹&ñžê>Ì9r˜í yqˆg‰5Ô0: ˜²áоÅü™ò÷çf‡¦ëS~wyûFó®·©ÜÇ.—i¡éâÎÓM…«Ä’•æÔj¼`®ûµ~~¢x¤G‡™æçiã– ø’ùt{>c¹Ï?ÍùÁ»OÌŸùÊmó’öïJ_˹㲾ó·–d3}vûS°C"D±z>„Ë©2?ÂyW6Ø{HãÓœbøº'W›³¼Lã&Ü=Gš¯üä§üáþ|þuù ó ßUÓôŸ,Cm æuƒ¼ñÞÝÛÙJ^d#м‘±…‹:pUV^gl>Òð1J¿OÚ_gøùc._fy¿DóT~DºÐ?)ïôŸ'ùŠÒÞÒ×Ê÷wö†ãN³† b ¶Œ­WêêÈ€l§‰è3_ŽQã¼–G^÷>q—Bèø ò¿þpÛóÿò×ó›Xüå²üâòÃëžq½»—Ï ºL¬—vÚò__GmðÆZD „S‰µFm3v†˜†3C–ýƒ¬Ã Í)ÉÄ,óÛ¿röOùËùÄQÿ9$ÞR×4o7ÿƒ¼Ûäôš K©¡yí®-æt+txÞ7^Jë^¤~¸ú å¬`·ë´?˜¢ œù3ò«þr[É”gʶ¿vfüʗ̨Kço2ÁwªBºKZ¬_S&s a$aÁ&›·s‘ÉŸòqpTkÛvXðç†>;•ó;ìñùÆ?ùÃÏÎoùÇ?:\ë_šž_Ô¼¯æ9-—Îú(Ó¦iï!µ2´^ŒÒo©•·­ MAÚ™ÞÐŨ…›·hÑèréå|B5/ú¯Î½þr+ÍŸ¾IüÖòö‘æcQ¹†ÂóOšì®Ÿ|Å~¯':©e‹ˆªÒŒ6Ûl?Ê¥€b”I :õGä2Ç1Ë Ëô£4îÙùÿ9‹ÿ8ýùÿ9ùåùmå¯+òîƒå_)Þk^y¾¶¹m6+©/Ò1h“EF¹<#qpxUèø·=Ÿª†Ÿ Œ·$Õuå÷:~–zŒ±ØwÓŸÞ¶ÿþqsþsOS±¼Ó¯ç.L¶wð½½ÔB„-ŠU×’*°¨4¨5Äkt ØħG©"¼TŸ¿çÿ;<ÙùCäÏÈÍ7óGËwåï–tÍ6;«YtÉÞê}FÏ›Í0¸¢7’BUiP)^õŽ-~(e9LO'¯DåÐå–1ŒHpŠéÕéÿ—?óŸÞTü†óO侧ùÑmgp4û{ËO6ù~Îk;ÍcžIæõ&I!–OR«*Àª×rrœÚ¬SÌ2{ÁêÝ‹K–8Ž3?q'çÿùÄoùÉÏ(ü³åoÎÌOËË'ùzõ/gó—tËÓ×ÒÌO,þ­¼(Õš¡eXòeb«LœZü.Xã+= ÙÇË¡Ïš£’Q¡Ü7yüüÃL±ÐtŸùÆʯ,Ãèéú-ž£e¥Ù;r)¼zmŠò­MXGñËûFG$åÖ¿I-=¬F8—úèIç¿>7ãòÖ‡ÿ9+ùäÜ~^y^H$‹òóÈÖÒ[ÛÞ›eáÖ.¥†ÕÇÂ)ýÛqáÀžY‹ùì8láâ=K“ù,¹hfáôFÑ´¯.é^¡ØC¥èÚ-¬6:V›n¡"··qDŠ:*ª€3U)O2í#CLò)v*ìUØ«±Wb®ÅR +Êú‰ªy—[Ó4õ¶Õ¼áw ÷˜ïËÉ$—3[ÛEg &Fn*Š¨”Q»S“12”Ì€äÆ0$Žgš‘dìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«Ç?1 ?(ÿ6<Ãå¿5~`yLëú÷”B/_}Pµü&ÝÚÜÃþðñ©ðé™uY1DÆçÉ£.›R%!d{ÞǘíîÅ]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb®Å]Š»v*ìUØ«±Wb¯ÿÙhunchentoot-1.2.35/run-test.lisp0000644000004100000410000000666612656661410016667 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*- ;;; Copyright (c) 2011, Hans Huebner. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :cl-user) (defparameter *test-port* 4241) (asdf:oos 'asdf:load-op :hunchentoot-test) (defun run-tests () (format t "~&;; Starting web server on localhost:~A." *test-port*) (force-output) (let ((server (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port *test-port*)))) (unwind-protect (progn (format t "~&;; Sleeping 2 seconds to give the server some time to start...") (force-output) (sleep 2) (format t "~&;; Now running confidence tests.") (force-output) (hunchentoot-test:test-hunchentoot (format nil "http://localhost:~A" *test-port*))) (format t "~&;; Stopping server.") (force-output) (hunchentoot:stop server) (format t "~&;; Cleaning temporary files.") (hunchentoot-test::clean-tmp-dir)))) #-sbcl (run-tests) ;;; KLUDGE (by Nikodemus Siivola) ;;; ;;; SBCL grabs a massive lock in WITH-COMPILATION-UNIT, which ASDF ;;; uses in PERFORM-PLAN ... which makes spawning threads during testing ;;; problematic to say the least. ;;; ;;; So, release the world lock for the duration. Nikodemus says that in this ;;; specific usage this should be safe --- and promises that people who copy ;;; this code and use it elsewhere will burn in hell for their sins. ;;; ;;; More promisingly, he swears up and down that that massive lock from ;;; W-C-U will be gone by early 2012 at the latest, so this will not be ;;; an eternal kludge, we hope. (defun %call-without-world-lock-kludge (thunk) #+(and sbcl sb-thread) (let ((s (find-symbol "**WORLD-LOCK**" :sb-c))) (if (and s (boundp s)) (let ((lock (symbol-value s))) (unwind-protect (progn (if (sb-thread:holding-mutex-p lock) (sb-thread:release-mutex lock) (setf lock nil)) (funcall thunk)) (when lock (sb-thread:grab-mutex lock)))) (funcall thunk))) #-(and sbcl sb-thread) (funcall thunk)) #+sbcl (%call-without-world-lock-kludge 'run-tests)hunchentoot-1.2.35/url-rewrite/0000755000004100000410000000000012656661410016460 5ustar www-datawww-datahunchentoot-1.2.35/url-rewrite/specials.lisp0000644000004100000410000000511312656661410021154 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :url-rewrite) (defvar *url-rewrite-tags* '(("a" . "href") ("area" . "href") ("frame" . "src") ("img" . "src") ("input" . "src") ("form" . "action") ("iframe" . "src")) "The tag/attribute combinations where URL-rewriting should happen.") (defvar *url-rewrite-fill-tags* '(("form" . "action")) "The tag/attribute combinations where URL-rewriting should optionally add an attribute.") (defvar *find-string-hash* (make-hash-table :test #'equal) "Hash tables used internally by READ-UNTIL to cache offset arrays.") ;; stuff for Nikodemus Siivola's HYPERDOC ;; see ;; and (defvar *hyperdoc-base-uri* "http://weitz.de/url-rewrite/") (let ((exported-symbols-alist (loop for symbol being the external-symbols of :url-rewrite collect (cons symbol (concatenate 'string "#" (string-downcase symbol)))))) (defun hyperdoc-lookup (symbol type) (declare (ignore type)) (cdr (assoc symbol exported-symbols-alist :test #'eq)))) hunchentoot-1.2.35/url-rewrite/packages.lisp0000644000004100000410000000321412656661410021127 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :cl-user) (defpackage #:url-rewrite (:use :cl) (:export #:*url-rewrite-tags* #:*url-rewrite-fill-tags* #:starts-with-scheme-p #:add-get-param-to-url #:rewrite-urls #:url-encode))hunchentoot-1.2.35/url-rewrite/primitives.lisp0000644000004100000410000001563212656661410021553 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :url-rewrite) (declaim (inline peek-char*)) (defun peek-char* () "PEEK-CHAR with input stream bound to *STANDARD-INPUT* and returning NIL on EOF." (peek-char nil nil nil)) (declaim (inline whitespacep)) (defun whitespacep (c) "Checks whether C is a whitespace character." (find c '(#\Space #\Tab #\Newline #\Linefeed #\Return #\Page))) (declaim (inline letterp)) (defun letterp (c) "Checks whether C is a character between A and Z \(case-insensitive)." (and (characterp c) (or (char<= #\a c #\z) (char<= #\A c #\Z)))) (declaim (inline name-char-p)) (defun name-char-p (c) "Checks whether C is a name constituent character in the sense of HTML." (and (characterp c) (or (letterp c) (digit-char-p c) (char= c #\-) (char= c #\.)))) (defun comment-start-p () "Checks whether *STANDARD-OUTPUT* currently 'looks at' the string \"--\". Will move the position within the stream by one unless the first characters it sees is not a hyphen." (unless (eql (peek-char*) #\-) ;; if the first character isn't #\- we can return immediately (return-from comment-start-p nil)) ;; otherwise read the #\- so we can check the next character (read-char) (eql (peek-char*) #\-)) (defun read-while (predicate &key (skip t) (write-through t)) "Reads characters from *STANDARD-INPUT* while PREDICATE returns a true value for each character. Returns the string which was read unless SKIP is true. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true. On EOF the string read so far is returned." (let ((collector (or skip (make-array 0 :element-type 'character :fill-pointer t :adjustable t)))) (handler-case (loop while (funcall predicate (peek-char)) do (let ((char (read-char))) (when write-through (write-char char)) (unless skip (vector-push-extend char collector))) finally (return (and (not skip) collector))) (end-of-file () (and (not skip) collector))))) (defun read-until (string &key (skip t) (write-through t)) "Reads characters from *STANDARD-INPUT* up to and including STRING. Returns the string which was read \(excluding STRING) unless SKIP is true. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true. On EOF the string read so far is returned." (let* ((length (length string)) (offsets ;; we first check whether some substring which starts ;; STRING can be found again later in STRING - this is ;; necessary because we only peek one character ahead (cond ((gethash string *find-string-hash*)) (t (setf (gethash string *find-string-hash*) ;; the resulting array of offsets is ;; cached in *FIND-STRING-HASH* so we can ;; use it again in case READ-UNTIL is ;; called with the same STRING argument (loop with offsets = (make-array length :initial-element nil) for i from 1 below length ;; check if STRING starting from 0 ;; has something in common with ;; STRING starting from I for mismatch = (mismatch string string :start1 i :test #'char=) when (> mismatch i) ;; if this is the case remember the ;; length of the match plus the ;; character which must follow in ;; OFFSETS do (push (cons (char string (- mismatch i)) (1+ (- mismatch i))) (svref offsets i)) finally (return offsets)))))) (collector (or skip (make-array 0 :element-type 'character :fill-pointer t :adjustable t)))) (handler-case (loop for i = 0 then (cond (match (1+ i)) ;; if there is an offset (see above) ;; we don't have to start from the ;; beginning of STRING ((cdr (assoc c (svref offsets i)))) (t 0)) for c = (peek-char) for match = (char= c (char string i)) while (or (not match) (< (1+ i) length)) do (cond (skip (read-char)) (t (vector-push-extend (read-char) collector))) when write-through do (write-char c) finally (if write-through (write-char (read-char)) (read-char)) (unless skip ;; decrement the fill pointer because collector now also ;; contains STRING itself (decf (fill-pointer collector) (1- length))) (return (and (not skip) collector))) (end-of-file () (and (not skip) collector))))) hunchentoot-1.2.35/url-rewrite/util.lisp0000644000004100000410000001316512656661410020334 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :url-rewrite) (declaim (inline skip-whitespace)) (defun skip-whitespace (&key (skip t) (write-through t)) "Read characters from *STANDARD-INPUT* as long as they are whitespace. Returns the string which was read unless SKIP is true. On EOF the string read so far is returned. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true." (read-while #'whitespacep :skip skip :write-through write-through)) (defun read-delimited-string (&key (skip t) (write-through t)) "Reads and returns as its first value a string from *STANDARD-INPUT*. The string is either delimited by ' or \" in which case the delimiters aren't part of the string but the second return value is the delimiter character or it is assumed to extend to the next character which is not a name constituent \(see NAME-CHAR-P). On EOF the string read so far is returned. If SKIP is true NIL is returned. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true." ;; note that this function has no means to signal to the caller ;; that it encountered EOF before the closing delimiter was read, ;; i.e. "'foo' bar='baz'" and "'foo" yield the same result, namely ;; the values "foo" and #\' (handler-case (let* ((peek-char (peek-char)) (delimiter (find peek-char '(#\' #\")))) (when delimiter (read-char) (when write-through (write-char delimiter))) (multiple-value-prog1 (values (read-while (if delimiter (lambda (c) (char/= c delimiter)) (lambda (c) (name-char-p c))) :skip skip :write-through write-through) delimiter) (when delimiter (read-char) (when write-through (write-char delimiter))))) (end-of-file () ;; this can only happen if the very first PEEK-CHAR fails, ;; otherwise EOF is handled by READ-WHILE nil))) (declaim (inline read-name)) (defun read-name (&key (skip t) (write-through t)) "Read characters from *STANDARD-INPUT* as long as they are name constituents. Returns the string which was read unless SKIP is true. On EOF the string read so far is returned. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true." (read-while #'name-char-p :skip skip :write-through write-through)) (defun read-attribute (&key (skip t) (write-through t)) "Read characters from *STANDARD-INPUT* assuming that they constitue a SGML-style attribute/value pair. Returns three values - the name of the attribute, its value, and the whole string which was read. On EOF the string(s) read so far is/are returned. If SKIP is true NIL is returned. Writes all characters read to *STANDARD-OUTPUT* if WRITE-THROUGH is true." (let* ((name (read-name :skip skip :write-through write-through)) (whitespace1 (skip-whitespace :skip skip :write-through write-through))) (cond ((eql (peek-char*) #\=) (read-char) (when write-through (write-char #\=)) (let ((whitespace2 (skip-whitespace :skip skip :write-through write-through))) (multiple-value-bind (value delimiter) (read-delimited-string :skip skip :write-through write-through) (let ((delimiter-string (if delimiter (string delimiter) ""))) (if skip nil (values name value (concatenate 'string name whitespace1 "=" whitespace2 delimiter-string value delimiter-string))))))) (t (if skip nil (values name nil (concatenate 'string name whitespace1))))))) (defun skip-comment () "Skip SGML comment from *STANDARD-INPUT*, i.e. a string enclosed in '--' on both sides. Returns no values. Writes all characters read to *STANDARD-OUTPUT*. This function assumes \(without checking) that the current position of *STANDARD-INPUT* is at the beginning of a comment, after the first hyphen - see COMMENT-START-P." (read-char) (write-string "--") (read-until "--") (values)) hunchentoot-1.2.35/url-rewrite/url-rewrite.lisp0000644000004100000410000003756512656661410021652 0ustar www-datawww-data;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :url-rewrite) (defun starts-with-scheme-p (string) "Checks whether the string STRING represents a URL which starts with a scheme, i.e. something like 'https://' or 'mailto:'." (loop with scheme-char-seen-p = nil for c across string when (or (char-not-greaterp #\a c #\z) (digit-char-p c) (member c '(#\+ #\- #\.) :test #'char=)) do (setq scheme-char-seen-p t) else return (and scheme-char-seen-p (char= c #\:)))) (defun url-encode (string) "URL-encode a string." (with-output-to-string (s) (loop for c across string do (cond ((or (char<= #\0 c #\9) (char<= #\a c #\z) (char<= #\A c #\Z) (find c "$-_.!*'()," :test #'char=)) (write-char c s)) ((char= c #\Space) (write-char #\+ s)) (t (format s "%~2,'0x" (char-code c))))))) (defun add-get-param-to-url (url name value) "URL is assumed to be a http URL. The pair of NAME and VALUE will be added as a GET parameter to this URL. Assumes that there's no other parameter of the same name. Only checks if #\? is part of the string to decide how to attach the new parameter to the end of the string." ;; possible bug: doesn't check for #\? which is written as, say, ;; "&x3f;" - also, is there any other way a question mark could be a ;; legitimate part of a URL? (concatenate 'string url (if (find #\? url :test #'char=) "&" "?") name "=" (url-encode value))) (defun rewrite-urls (rewrite-fn &optional (test-fn (complement #'starts-with-scheme-p))) "Reads an \(X)HTML document from *STANDARD-INPUT* and writes it back to *STANDARD-OUTPUT*. Any attribute value which is in one of the positions denoted by *URL-REWRITE-TAGS* is rewritten by REWRITE-FN if it passes the test denoted by the optional function TEST-FN which defaults to the complement of STARTS-WITH-SCHEME-P. This function aims to yield correct results for correct \(X)HTML input and it also tries hard to never signal an error although it may warn if it encounters syntax errors. It will NOT detect any possible error nor is there any warranty that it will work correctly with faulty input." (loop ;; read (and write back) until we see a #\< which is a candidate ;; for a tag or a markup declaration (read-until "<") ;; get next char without reading it (let ((peek-char (peek-char*))) (cond ((null peek-char) ;; stop if EOF (return-from rewrite-urls)) ((char= peek-char #\!) ;; we've seen ") ;; "" is nothing special, just write the ;; char and go back to the start of the loop (write-char (read-char))) ((letterp peek-char) ;; a letter, so this should be something like ;; - we just check for names and ;; delimited strings separated by whitespace ;; until we see the next #\> (read-name) (skip-whitespace) (block parameter-loop (loop (let ((peek-char (peek-char*))) (cond ((null peek-char) ;; stop if EOF (warn "EOF in markup declaration") (return-from rewrite-urls)) ((char= peek-char #\>) ;; a #\> ends the markup ;; declaration - write it back ;; and exit the loop (write-char (read-char)) (return-from parameter-loop)) ((or (letterp peek-char) (find peek-char '(#\' #\") :test #'char=)) ;; a delimiter or a letter, so ;; we expect a delimited string (read-delimited-string) (skip-whitespace)) ((comment-start-p) ;; a comment - skip it and write it back (skip-comment)) (t ;; something else - this is an error ;; so we warn and exit the loop (warn "Unexpected character ~S in markup declaration" peek-char) (return-from parameter-loop))))))) ((comment-start-p) ;; we've seen "