request.lisp

   1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
   2 ;;; $Header: /usr/local/cvsrep/hunchentoot/request.lisp,v 1.35 2008/02/13 16:02:18 edi Exp $
   3
   4 ;;; Copyright (c) 2004-2009, Dr. Edmund Weitz.  All rights reserved.
   5
   6 ;;; Redistribution and use in source and binary forms, with or without
   7 ;;; modification, are permitted provided that the following conditions
   8 ;;; are met:
   9
  10 ;;;   * Redistributions of source code must retain the above copyright
  11 ;;;     notice, this list of conditions and the following disclaimer.
  12
  13 ;;;   * Redistributions in binary form must reproduce the above
  14 ;;;     copyright notice, this list of conditions and the following
  15 ;;;     disclaimer in the documentation and/or other materials
  16 ;;;     provided with the distribution.
  17
  18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  21 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  29
  30 (in-package :hunchentoot)
  31
  32 (defclass request ()
  33   ((acceptor :initarg :acceptor
  34              :documentation "The acceptor which created this request
  35 object."
  36              :reader request-acceptor)
  37    (headers-in :initarg :headers-in
  38                :documentation "An alist of the incoming headers."
  39                :reader headers-in)
  40    (method :initarg :method
  41            :documentation "The request method as a keyword."
  42            :reader request-method)
  43    (uri :initarg :uri
  44         :documentation "The request URI as a string."
  45         :reader request-uri)
  46    (server-protocol :initarg :server-protocol
  47                     :documentation "The HTTP protocol as a keyword."
  48                     :reader server-protocol)
  49    (remote-addr :initarg :remote-addr
  50                 :documentation "The IP address of the client that
  51 initiated this request."
  52                 :reader remote-addr)
  53    (remote-port :initarg :remote-port
  54                 :documentation "The TCP port number of the client
  55 socket from which this request originated."
  56                 :reader remote-port)
  57    (content-stream :initarg :content-stream
  58                    :reader content-stream
  59                    :documentation "A stream from which the request
  60 body can be read if there is one.")
  61    (cookies-in :initform nil
  62                :documentation "An alist of the cookies sent by the client."
  63                :reader cookies-in)
  64    (get-parameters :initform nil
  65                    :documentation "An alist of the GET parameters sent
  66 by the client."
  67                    :reader get-parameters)
  68    (post-parameters :initform nil
  69                     :documentation "An alist of the POST parameters
  70 sent by the client."
  71                     :reader post-parameters)
  72    (script-name :initform nil
  73                 :documentation "The URI requested by the client without
  74 the query string."
  75                 :reader script-name)
  76    (query-string :initform nil
  77                  :documentation "The query string of this request."
  78                  :reader query-string)
  79    (session :initform nil
  80             :accessor session
  81             :documentation "The session object associated with this
  82 request.")
  83    (aux-data :initform nil
  84              :accessor aux-data
  85              :documentation "Used to keep a user-modifiable alist with
  86 arbitrary data during the request.")
  87    (raw-post-data :initform nil
  88                   :documentation "The raw string sent as the body of a
  89 POST request, populated only if not a multipart/form-data request."))
  90   (:documentation "Objects of this class hold all the information
  91 about an incoming request.  They are created automatically by
  92 acceptors and can be accessed by the corresponding handler.
  93
  94 You should not mess with the slots of these objects directly, but you
  95 can subclass REQUEST in order to implement your own behaviour.  See
  96 the REQUEST-CLASS slot of the ACCEPTOR class."))
  97
  98 (defgeneric process-request (request)
  99   (:documentation "This function is called by PROCESS-CONNECTION after
 100 the incoming headers have been read.  It selects and calls a handler
 101 and sends the output of this handler to the client using START-OUTPUT.
 102 It also sets up simple error handling for the request handler.  Note
 103 that PROCESS-CONNECTION is called once per connection and loops in
 104 case of a persistent connection while PROCESS-REQUEST is called anew
 105 for each request.
 106
 107 Like PROCESS-CONNECTION, this might be a good place to introduce
 108 around methods which bind special variables or do other interesting
 109 things.
 110
 111 The return value of this function is ignored."))
 112
 113 (defun convert-hack (string external-format)
 114   "The rfc2388 package is buggy in that it operates on a character
 115 stream and thus only accepts encodings which are 8 bit transparent.
 116 In order to support different encodings for parameter values
 117 submitted, we post process whatever string values the rfc2388 package
 118 has returned."
 119   (flex:octets-to-string (map '(vector (unsigned-byte 8) *) 'char-code string)
 120                          :external-format external-format))
 121
 122 (defun parse-rfc2388-form-data (stream content-type-header external-format)
 123   "Creates an alist of POST parameters from the stream STREAM which is
 124 supposed to be of content type 'multipart/form-data'."
 125   (let* ((parsed-content-type-header (rfc2388:parse-header content-type-header :value))
 126          (boundary (or (cdr (rfc2388:find-parameter
 127                              "BOUNDARY"
 128                              (rfc2388:header-parameters parsed-content-type-header)))
 129                        (return-from parse-rfc2388-form-data))))
 130     (loop for part in (rfc2388:parse-mime stream boundary)
 131           for headers = (rfc2388:mime-part-headers part)
 132           for content-disposition-header = (rfc2388:find-content-disposition-header headers)
 133           for name = (cdr (rfc2388:find-parameter
 134                            "NAME"
 135                            (rfc2388:header-parameters content-disposition-header)))
 136           when name
 137           collect (cons name
 138                         (let ((contents (rfc2388:mime-part-contents part)))
 139                           (if (pathnamep contents)
 140                             (list contents
 141                                   (rfc2388:get-file-name headers)
 142                                   (rfc2388:content-type part :as-string t))
 143                             (convert-hack contents external-format)))))))
 144
 145 (defun get-post-data (&key (request *request*) want-stream (already-read 0))
 146   "Reads the request body from the stream and stores the raw contents
 147 \(as an array of octets) in the corresponding slot of the REQUEST
 148 object.  Returns just the stream if WANT-STREAM is true.  If there's a
 149 Content-Length header, it is assumed, that ALREADY-READ octets have
 150 already been read."
 151   (let* ((headers-in (headers-in request))
 152          (content-length (when-let (content-length-header (cdr (assoc :content-length headers-in
 153                                                                       :test #'eq)))
 154                            (parse-integer content-length-header :junk-allowed t)))
 155          (content-stream (content-stream request)))
 156     (setf (slot-value request 'raw-post-data)
 157           (cond (want-stream
 158                  (let ((stream (make-flexi-stream content-stream :external-format +latin-1+)))
 159                    (when content-length
 160                      (setf (flexi-stream-bound stream) content-length))
 161                    stream))
 162                 ((and content-length (> content-length already-read))
 163                  (decf content-length already-read)
 164                  (when (input-chunking-p)
 165                    ;; see RFC 2616, section 4.4
 166                    (log-message :warning "Got Content-Length header although input chunking is on."))
 167                  (let ((content (make-array content-length :element-type 'octet)))
 168                    (read-sequence content content-stream)
 169                    content))
 170                 ((input-chunking-p)
 171                  (loop with buffer = (make-array +buffer-length+ :element-type 'octet)
 172                        with content = (make-array 0 :element-type 'octet :adjustable t)
 173                        for index = 0 then (+ index pos)
 174                        for pos = (read-sequence buffer content-stream)
 175                        do (adjust-array content (+ index pos))
 176                           (replace content buffer :start1 index :end2 pos)
 177                        while (= pos +buffer-length+)
 178                        finally (return content)))))))
 179
 180 (defmethod initialize-instance :after ((request request) &rest init-args)
 181   "The only initarg for a REQUEST object is :HEADERS-IN.  All other
 182 slot values are computed in this :AFTER method."
 183   (declare (ignore init-args))
 184   (with-slots (headers-in cookies-in get-parameters script-name query-string session)
 185       request
 186     (handler-case
 187         (progn
 188           (let* ((uri (request-uri request))
 189                  (match-start (position #\? uri)))
 190             (cond
 191              (match-start
 192               (setq script-name (subseq uri 0 match-start)
 193                     query-string (subseq uri (1+ match-start))))
 194              (t (setq script-name uri))))
 195           ;; some clients (e.g. ASDF-INSTALL) send requests like
 196           ;; "GET http://server/foo.html HTTP/1.0"...
 197           (setq script-name (regex-replace "^https?://[^/]+" script-name ""))
 198           ;; compute GET parameters from query string and cookies from
 199           ;; the incoming 'Cookie' header
 200           (setq get-parameters
 201                 (form-url-encoded-list-to-alist (split "&" query-string))
 202                 cookies-in
 203                 (form-url-encoded-list-to-alist (split "\\s*[,;]\\s*" (cdr (assoc :cookie headers-in
 204                                                                                   :test #'eq)))
 205                                                 +utf-8+)
 206                 session (session-verify request)
 207                 *session* session))
 208       (error (condition)
 209         (log-message :error "Error when creating REQUEST object: ~A" condition)
 210         ;; we assume it's not our fault...
 211         (setf (return-code*) +http-bad-request+)))))
 212
 213 (defmethod process-request (request)
 214   "Standard implementation for processing a request.  You should not
 215 change or replace this functionality unless you know what you're
 216 doing."
 217   (let (*tmp-files* *headers-sent*)
 218     (unwind-protect
 219          (with-mapped-conditions ()
 220            (let* ((*request* request)
 221                   (*within-request-p* t))
 222              (multiple-value-bind (body error)
 223                  (catch 'handler-done
 224                    (handler-bind ((error
 225                                    (lambda (cond)
 226                                      (when *log-lisp-errors-p*
 227                                        (log-message *lisp-errors-log-level* "~A" cond))
 228                                      ;; if the headers were already sent
 229                                      ;; the error happens within the body
 230                                      ;; and we have to close the stream
 231                                      (when *headers-sent*
 232                                        (setq *close-hunchentoot-stream* t))
 233                                      (throw 'handler-done
 234                                        (values nil cond))))
 235                                   (warning
 236                                    (lambda (cond)
 237                                      (when *log-lisp-warnings-p*
 238                                        (log-message *lisp-warnings-log-level* "~A" cond)))))
 239                      ;; skip dispatch if bad request
 240                      (when (eql (return-code *reply*) +http-ok+)
 241                        ;; now do the work
 242                        (funcall (acceptor-request-dispatcher *acceptor*) *request*))))
 243                (when error
 244                  (setf (return-code *reply*)
 245                        +http-internal-server-error+))
 246                (start-output :content (cond ((and error *show-lisp-errors-p*)
 247                                              (format nil "<pre>~A</pre>"
 248                                                      (escape-for-html (format nil "~A" error))))
 249                                             (error
 250                                              "An error has occured.")
 251                                             (t body))))))
 252       (dolist (path *tmp-files*)
 253         (when (and (pathnamep path) (probe-file path))
 254           ;; the handler may have chosen to (re)move the uploaded
 255           ;; file, so ignore errors that happen during deletion
 256           (ignore-errors
 257             (delete-file path)))))))
 258
 259 (defun within-request-p ()
 260   "True if we're in the context of a request, otherwise nil."
 261   *within-request-p*)
 262
 263 (defun parse-multipart-form-data (request external-format)
 264   "Parse the REQUEST body as multipart/form-data, assuming that its
 265 content type has already been verified.  Returns the form data as
 266 alist or NIL if there was no data or the data could not be parsed."
 267   (handler-case
 268       (let ((content-stream (make-flexi-stream (content-stream request) :external-format +latin-1+)))
 269         (prog1
 270             (parse-rfc2388-form-data content-stream (header-in :content-type request) external-format)
 271           (let ((stray-data (get-post-data :already-read (flexi-stream-position content-stream))))
 272             (when (and stray-data (plusp (length stray-data)))
 273               (hunchentoot-warn "~A octets of stray data after form-data sent by client."
 274                                 (length stray-data))))))
 275     (error (condition)
 276       (log-message :error "While parsing multipart/form-data parameters: ~A" condition)
 277       nil)))
 278
 279 (defun maybe-read-post-parameters (&key (request *request*) force external-format)
 280   "Make surce that any POST parameters in the REQUEST are parsed.  The
 281 body of the request must be either application/x-www-form-urlencoded
 282 or multipart/form-data to be considered as containing POST parameters.
 283 If FORCE is true, parsing is done unconditionally.  Otherwise, parsing
 284 will only be done if the RAW-POST-DATA slot in the REQUEST is false.
 285 EXTERNAL-FORMAT specifies the external format of the data in the
 286 request body.  By default, the encoding is determined from the
 287 Content-Type header of the request or from
 288 *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* if none is found."
 289   (when (and (header-in :content-type request)
 290              (member (request-method request) *methods-for-post-parameters* :test #'eq)
 291              (or force
 292                  (not (slot-value request 'raw-post-data))))
 293     (unless (or (header-in :content-length request)
 294                 (input-chunking-p))
 295       (log-message :warning "Can't read request body because there's ~
 296 no Content-Length header and input chunking is off.")
 297       (return-from maybe-read-post-parameters nil))
 298     (handler-case
 299         (multiple-value-bind (type subtype charset)
 300               (parse-content-type (header-in :content-type request))
 301           (let ((external-format (or external-format
 302                                      (when charset
 303                                        (handler-case
 304                                            (make-external-format charset :eol-style :lf)
 305                                          (error ()
 306                                            (hunchentoot-warn "Ignoring ~
 307 unknown character set ~A in request content type."
 308                                                  charset))))
 309                                      *hunchentoot-default-external-format*)))
 310             (setf (slot-value request 'post-parameters)
 311                   (cond ((and (string-equal type "application")
 312                               (string-equal subtype "x-www-form-urlencoded"))
 313                          (form-url-encoded-list-to-alist
 314                           (split "&" (raw-post-data :external-format +latin-1+))
 315                           external-format))
 316                         ((and (string-equal type "multipart")
 317                               (string-equal subtype "form-data"))
 318                          (prog1 (parse-multipart-form-data request external-format)
 319                            (setf (slot-value request 'raw-post-data) t)))))))
 320       (error (condition)
 321         (log-message :error "Error when reading POST parameters from body: ~A" condition)
 322         ;; this is not the right thing to do because it could happen
 323         ;; that we aren't finished reading from the request stream and
 324         ;; can't send a reply - to be revisited
 325         (setf (return-code*) +http-bad-request+
 326               *close-hunchentoot-stream* t)
 327         (abort-request-handler)))))
 328
 329 (defun recompute-request-parameters (&key (request *request*)
 330                                           (external-format *hunchentoot-default-external-format*))
 331   "Recomputes the GET and POST parameters for the REQUEST object
 332 REQUEST.  This only makes sense if you're switching external formats
 333 during the request."
 334   (maybe-read-post-parameters :request request :force t :external-format external-format)
 335   (setf (slot-value request 'get-parameters)
 336         (form-url-encoded-list-to-alist (split "&" (query-string request)) external-format))
 337   (values))
 338
 339 (defun script-name* (&optional (request *request*))
 340   "Returns the file name of the REQUEST object REQUEST. That's the
 341 requested URI without the query string \(i.e the GET parameters)."
 342   (script-name request))
 343
 344 (defun query-string* (&optional (request *request*))
 345   "Returns the query string of the REQUEST object REQUEST. That's
 346 the part behind the question mark \(i.e. the GET parameters)."
 347   (query-string request))
 348
 349 (defun get-parameters* (&optional (request *request*))
 350   "Returns an alist of the GET parameters associated with the REQUEST
 351 object REQUEST."
 352   (get-parameters request))
 353
 354 (defmethod post-parameters :before ((request request))
 355   (maybe-read-post-parameters :request request))
 356
 357 (defun post-parameters* (&optional (request *request*))
 358   "Returns an alist of the POST parameters associated with the REQUEST
 359 object REQUEST."
 360   (post-parameters request))
 361
 362 (defun headers-in* (&optional (request *request*))
 363   "Returns an alist of the incoming headers associated with the
 364 REQUEST object REQUEST."
 365   (headers-in request))
 366
 367 (defun cookies-in* (&optional (request *request*))
 368   "Returns an alist of all cookies associated with the REQUEST object
 369 REQUEST."
 370   (cookies-in request))
 371
 372 (defgeneric header-in (name request)
 373   (:documentation "Returns the incoming header with name NAME.  NAME
 374 can be a keyword \(recommended) or a string.")
 375   (:method (name request)
 376    (cdr (assoc* name (headers-in request)))))
 377
 378 (defun header-in* (name &optional (request *request*))
 379   "Returns the incoming header with name NAME.  NAME can be a keyword
 380 \(recommended) or a string."
 381   (header-in name request))
 382
 383 (defun authorization (&optional (request *request*))
 384   "Returns as two values the user and password \(if any) as encoded in
 385 the 'AUTHORIZATION' header.  Returns NIL if there is no such header."
 386   (let* ((authorization (header-in :authorization request))
 387          (start (and authorization
 388                      (> (length authorization) 5)
 389                      (string-equal "Basic" authorization :end2 5)
 390                      (scan "\\S" authorization :start 5))))
 391     (when start
 392       (destructuring-bind (&optional user password)
 393           (split ":" (base64:base64-string-to-string (subseq authorization start)))
 394         (values user password)))))
 395
 396 (defun remote-addr* (&optional (request *request*))
 397   "Returns the address the current request originated from."
 398   (remote-addr request))
 399
 400 (defun remote-port* (&optional (request *request*))
 401   "Returns the port the current request originated from."
 402   (remote-port request))
 403
 404 (defun real-remote-addr (&optional (request *request*))
 405   "Returns the 'X-Forwarded-For' incoming http header as the
 406 second value in the form of a list of IP addresses and the first
 407 element of this list as the first value if this header exists.
 408 Otherwise returns the value of REMOTE-ADDR as the only value."
 409   (let ((x-forwarded-for (header-in :x-forwarded-for request)))
 410     (cond (x-forwarded-for (let ((addresses (split "\\s*,\\s*" x-forwarded-for)))
 411                              (values (first addresses) addresses)))
 412           (t (remote-addr request)))))
 413
 414 (defun host (&optional (request *request*))
 415   "Returns the 'Host' incoming http header value."
 416   (header-in :host request))
 417
 418 (defun request-uri* (&optional (request *request*))
 419   "Returns the request URI."
 420   (request-uri request))
 421
 422 (defun request-method* (&optional (request *request*))
 423   "Returns the request method as a Lisp keyword."
 424   (request-method request))
 425
 426 (defun server-protocol* (&optional (request *request*))
 427   "Returns the request protocol as a Lisp keyword."
 428   (server-protocol request))
 429
 430 (defun user-agent (&optional (request *request*))
 431   "Returns the 'User-Agent' http header."
 432   (header-in :user-agent request))
 433
 434 (defun cookie-in (name &optional (request *request*))
 435   "Returns the cookie with the name NAME \(a string) as sent by the
 436 browser - or NIL if there is none."
 437   (cdr (assoc name (cookies-in request) :test #'string=)))
 438
 439 (defun referer (&optional (request *request*))
 440   "Returns the 'Referer' \(sic!) http header."
 441   (header-in :referer request))
 442
 443 (defun get-parameter (name &optional (request *request*))
 444   "Returns the GET parameter with name NAME \(a string) - or NIL if
 445 there is none.  Search is case-sensitive."
 446   (cdr (assoc name (get-parameters request) :test #'string=)))
 447
 448 (defun post-parameter (name &optional (request *request*))
 449   "Returns the POST parameter with name NAME \(a string) - or NIL if
 450 there is none.  Search is case-sensitive."
 451   (cdr (assoc name (post-parameters request) :test #'string=)))
 452
 453 (defun parameter (name &optional (request *request*))
 454   "Returns the GET or the POST parameter with name NAME \(a string) -
 455 or NIL if there is none.  If both a GET and a POST parameter with the
 456 same name exist the GET parameter is returned.  Search is
 457 case-sensitive."
 458   (or (get-parameter name request)
 459       (post-parameter name request)))
 460
 461 (defun handle-if-modified-since (time &optional (request *request*))
 462   "Handles the 'If-Modified-Since' header of REQUEST.  The date string
 463 is compared to the one generated from the supplied universal time
 464 TIME."
 465   (let ((if-modified-since (header-in :if-modified-since request))
 466         (time-string (rfc-1123-date time)))
 467     ;; simple string comparison is sufficient; see RFC 2616 14.25
 468     (when (and if-modified-since
 469                (equal if-modified-since time-string))
 470       (setf (return-code*) +http-not-modified+)
 471       (abort-request-handler))
 472     (values)))
 473
 474 (defun external-format-from-content-type (content-type)
 475   "Creates and returns an external format corresponding to the value
 476 of the content type header provided in CONTENT-TYPE.  If the content
 477 type was not set or if the character set specified was invalid, NIL is
 478 returned."
 479   (when content-type
 480     (when-let (charset (nth-value 2 (parse-content-type content-type)))
 481       (handler-case
 482           (make-external-format (as-keyword charset) :eol-style :lf)
 483         (error ()
 484           (hunchentoot-warn "Invalid character set ~S in request has been ignored."
 485                             charset))))))
 486
 487 (defun raw-post-data (&key (request *request*) external-format force-text force-binary want-stream)
 488   "Returns the content sent by the client if there was any \(unless
 489 the content type was \"multipart/form-data\").  By default, the result
 490 is a string if the type of the `Content-Type' media type is \"text\",
 491 and a vector of octets otherwise.  In the case of a string, the
 492 external format to be used to decode the content will be determined
 493 from the `charset' parameter sent by the client \(or otherwise
 494 *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* will be used).
 495
 496 You can also provide an external format explicitly \(through
 497 EXTERNAL-FORMAT) in which case the result will unconditionally be a
 498 string.  Likewise, you can provide a true value for FORCE-TEXT which
 499 will force Hunchentoot to act as if the type of the media type had
 500 been \"text\".  Or you can provide a true value for FORCE-BINARY which
 501 means that you want a vector of octets at any rate.
 502
 503 If, however, you provide a true value for WANT-STREAM, the other
 504 parameters are ignored and you'll get the content \(flexi) stream to
 505 read from it yourself.  It is then your responsibility to read the
 506 correct amount of data, because otherwise you won't be able to return
 507 a response to the client.  If the content type of the request was
 508 `multipart/form-data' or `application/x-www-form-urlencoded', the
 509 content has been read by Hunchentoot already and you can't read from
 510 the stream anymore.
 511
 512 You can call RAW-POST-DATA more than once per request, but you can't
 513 mix calls which have different values for WANT-STREAM.
 514
 515 Note that this function is slightly misnamed because a client can send
 516 content even if the request method is not POST."
 517   (when (and force-binary force-text)
 518     (parameter-error "It doesn't make sense to set both FORCE-BINARY and FORCE-TEXT to a true value."))
 519   (unless (or external-format force-binary)
 520     (setq external-format (or (external-format-from-content-type (header-in :content-type request))
 521                               (when force-text
 522                                 *hunchentoot-default-external-format*))))
 523   (let ((raw-post-data (or (slot-value request 'raw-post-data)
 524                            (get-post-data :request request :want-stream want-stream))))
 525     (cond ((typep raw-post-data 'stream) raw-post-data)
 526           ((member raw-post-data '(t nil)) nil)
 527           (external-format (octets-to-string raw-post-data :external-format external-format))
 528           (t raw-post-data))))
 529
 530 (defun aux-request-value (symbol &optional (request *request*))
 531   "Returns the value associated with SYMBOL from the request object
 532 REQUEST \(the default is the current request) if it exists.  The
 533 second return value is true if such a value was found."
 534   (when request
 535     (let ((found (assoc symbol (aux-data request) :test #'eq)))
 536       (values (cdr found) found))))
 537
 538 (defsetf aux-request-value (symbol &optional request)
 539     (new-value)
 540   "Sets the value associated with SYMBOL from the request object
 541 REQUEST \(default is *REQUEST*).  If there is already a value
 542 associated with SYMBOL it will be replaced."
 543   (with-rebinding (symbol)
 544     (with-unique-names (place %request)
 545       `(let* ((,%request (or ,request *request*))
 546               (,place (assoc ,symbol (aux-data ,%request) :test #'eq)))
 547          (cond
 548            (,place
 549             (setf (cdr ,place) ,new-value))
 550            (t
 551             (push (cons ,symbol ,new-value)
 552                   (aux-data ,%request))
 553             ,new-value))))))
 554
 555 (defun delete-aux-request-value (symbol &optional (request *request*))
 556   "Removes the value associated with SYMBOL from the request object
 557 REQUEST."
 558   (when request
 559     (setf (aux-data request)
 560             (delete symbol (aux-data request)
 561                     :key #'car :test #'eq)))
 562   (values))