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-2010, 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 calls HANDLE-REQUEST to
 101 select and call a handler and sends the output of this handler to the
 102 client using START-OUTPUT.  Note that PROCESS-CONNECTION is called
 103 once per connection and loops in case of a persistent connection while
 104 PROCESS-REQUEST is called anew for each request.
 105
 106 Essentially, you can view process-request as a thin wrapper around
 107 HANDLE-REQUEST.
 108
 109 The return value of this function is ignored."))
 110
 111 (defun convert-hack (string external-format)
 112   "The rfc2388 package is buggy in that it operates on a character
 113 stream and thus only accepts encodings which are 8 bit transparent.
 114 In order to support different encodings for parameter values
 115 submitted, we post process whatever string values the rfc2388 package
 116 has returned."
 117   (flex:octets-to-string (map '(vector (unsigned-byte 8) *) 'char-code string)
 118                          :external-format external-format))
 119
 120 (defun parse-rfc2388-form-data (stream content-type-header external-format)
 121   "Creates an alist of POST parameters from the stream STREAM which is
 122 supposed to be of content type 'multipart/form-data'."
 123   (let* ((parsed-content-type-header (rfc2388:parse-header content-type-header :value))
 124          (boundary (or (cdr (rfc2388:find-parameter
 125                              "BOUNDARY"
 126                              (rfc2388:header-parameters parsed-content-type-header)))
 127                        (return-from parse-rfc2388-form-data))))
 128     (loop for part in (rfc2388:parse-mime stream boundary)
 129           for headers = (rfc2388:mime-part-headers part)
 130           for content-disposition-header = (rfc2388:find-content-disposition-header headers)
 131           for name = (cdr (rfc2388:find-parameter
 132                            "NAME"
 133                            (rfc2388:header-parameters content-disposition-header)))
 134           when name
 135           collect (cons name
 136                         (let ((contents (rfc2388:mime-part-contents part)))
 137                           (if (pathnamep contents)
 138                             (list contents
 139                                   (rfc2388:get-file-name headers)
 140                                   (rfc2388:content-type part :as-string t))
 141                             (convert-hack contents external-format)))))))
 142
 143 (defun get-post-data (&key (request *request*) want-stream (already-read 0))
 144   "Reads the request body from the stream and stores the raw contents
 145 \(as an array of octets) in the corresponding slot of the REQUEST
 146 object.  Returns just the stream if WANT-STREAM is true.  If there's a
 147 Content-Length header, it is assumed, that ALREADY-READ octets have
 148 already been read."
 149   (let* ((headers-in (headers-in request))
 150          (content-length (when-let (content-length-header (cdr (assoc :content-length headers-in
 151                                                                       :test #'eq)))
 152                            (parse-integer content-length-header :junk-allowed t)))
 153          (content-stream (content-stream request)))
 154     (setf (slot-value request 'raw-post-data)
 155           (cond (want-stream
 156                  (let ((stream (make-flexi-stream content-stream :external-format +latin-1+)))
 157                    (when content-length
 158                      (setf (flexi-stream-bound stream) content-length))
 159                    stream))
 160                 ((and content-length (> content-length already-read))
 161                  (decf content-length already-read)
 162                  (when (input-chunking-p)
 163                    ;; see RFC 2616, section 4.4
 164                    (log-message* :warning "Got Content-Length header although input chunking is on."))
 165                  (let ((content (make-array content-length :element-type 'octet)))
 166                    (read-sequence content content-stream)
 167                    content))
 168                 ((input-chunking-p)
 169                  (loop with buffer = (make-array +buffer-length+ :element-type 'octet)
 170                        with content = (make-array 0 :element-type 'octet :adjustable t)
 171                        for index = 0 then (+ index pos)
 172                        for pos = (read-sequence buffer content-stream)
 173                        do (adjust-array content (+ index pos))
 174                           (replace content buffer :start1 index :end2 pos)
 175                        while (= pos +buffer-length+)
 176                        finally (return content)))))))
 177
 178 (defmethod initialize-instance :after ((request request) &rest init-args)
 179   "The only initarg for a REQUEST object is :HEADERS-IN.  All other
 180 slot values are computed in this :AFTER method."
 181   (declare (ignore init-args))
 182   (with-slots (headers-in cookies-in get-parameters script-name query-string session)
 183       request
 184     (handler-case*
 185         (progn
 186           (let* ((uri (request-uri request))
 187                  (match-start (position #\? uri)))
 188             (cond
 189              (match-start
 190               (setq script-name (subseq uri 0 match-start)
 191                     query-string (subseq uri (1+ match-start))))
 192              (t (setq script-name uri))))
 193           ;; some clients (e.g. ASDF-INSTALL) send requests like
 194           ;; "GET http://server/foo.html HTTP/1.0"...
 195           (setq script-name (regex-replace "^https?://[^/]+" script-name ""))
 196           ;; compute GET parameters from query string and cookies from
 197           ;; the incoming 'Cookie' header
 198           (setq get-parameters
 199                 (form-url-encoded-list-to-alist (split "&" query-string))
 200                 cookies-in
 201                 (form-url-encoded-list-to-alist (split "\\s*[,;]\\s*" (cdr (assoc :cookie headers-in
 202                                                                                   :test #'eq)))
 203                                                 +utf-8+)
 204                 session (session-verify request)
 205                 *session* session))
 206       (error (condition)
 207         (log-message* :error "Error when creating REQUEST object: ~A" condition)
 208         ;; we assume it's not our fault...
 209         (setf (return-code*) +http-bad-request+)))))
 210
 211 (defmethod process-request (request)
 212   "Standard implementation for processing a request.  You should not
 213 change or replace this functionality unless you know what you're
 214 doing."
 215   (catch 'request-processed ; used by HTTP HEAD handling to end request processing in a HEAD request (see START-OUTPUT)
 216     (let (*tmp-files*
 217           *headers-sent*
 218           (*request* request))
 219       (unwind-protect
 220            (with-mapped-conditions ()
 221              (labels
 222                  ((report-error-to-client (error &optional backtrace)
 223                     (when *log-lisp-errors-p*
 224                       (log-message* *lisp-errors-log-level* "~A~@[~%~A~]" error (when *log-lisp-backtraces-p*
 225                                                                                   backtrace)))
 226                     (start-output +http-internal-server-error+
 227                                   (acceptor-status-message *acceptor*
 228                                                            +http-internal-server-error+
 229                                                            :error (princ-to-string error)
 230                                                            :backtrace (princ-to-string backtrace)))))
 231                (multiple-value-bind (body error backtrace)
 232                    ;; skip dispatch if bad request
 233                    (when (eql (return-code *reply*) +http-ok+)
 234                      (catch 'handler-done
 235                        (handle-request *acceptor* *request*)))
 236                  (when error
 237                    ;; error occured in request handler
 238                    (report-error-to-client error backtrace))
 239                  (unless *headers-sent*
 240                    (handler-case
 241                        (with-debugger
 242                          (start-output (return-code *reply*)
 243                                        (or (acceptor-status-message *acceptor*
 244                                                                     (return-code *reply*))
 245                                            body)))
 246                      (error (e)
 247                        ;; error occured while writing to the client.  attempt to report.
 248                        (report-error-to-client e)))))))
 249         (dolist (path *tmp-files*)
 250           (when (and (pathnamep path) (probe-file path))
 251             ;; the handler may have chosen to (re)move the uploaded
 252             ;; file, so ignore errors that happen during deletion
 253             (ignore-errors*
 254               (delete-file path))))))))
 255
 256 (defun within-request-p ()
 257   "True if we're in the context of a request, otherwise nil."
 258   (and (boundp '*request*) *request*))
 259
 260 (defun parse-multipart-form-data (request external-format)
 261   "Parse the REQUEST body as multipart/form-data, assuming that its
 262 content type has already been verified.  Returns the form data as
 263 alist or NIL if there was no data or the data could not be parsed."
 264   (handler-case*
 265       (let ((content-stream (make-flexi-stream (content-stream request) :external-format +latin-1+)))
 266         (prog1
 267             (parse-rfc2388-form-data content-stream (header-in :content-type request) external-format)
 268           (let ((stray-data (get-post-data :already-read (flexi-stream-position content-stream))))
 269             (when (and stray-data (plusp (length stray-data)))
 270               (hunchentoot-warn "~A octets of stray data after form-data sent by client."
 271                                 (length stray-data))))))
 272     (error (condition)
 273       (log-message* :error "While parsing multipart/form-data parameters: ~A" condition)
 274       nil)))
 275
 276 (defun maybe-read-post-parameters (&key (request *request*) force external-format)
 277   "Make surce that any POST parameters in the REQUEST are parsed.  The
 278 body of the request must be either application/x-www-form-urlencoded
 279 or multipart/form-data to be considered as containing POST parameters.
 280 If FORCE is true, parsing is done unconditionally.  Otherwise, parsing
 281 will only be done if the RAW-POST-DATA slot in the REQUEST is false.
 282 EXTERNAL-FORMAT specifies the external format of the data in the
 283 request body.  By default, the encoding is determined from the
 284 Content-Type header of the request or from
 285 *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* if none is found."
 286   (when (and (header-in :content-type request)
 287              (member (request-method request) *methods-for-post-parameters* :test #'eq)
 288              (or force
 289                  (not (slot-value request 'raw-post-data)))
 290              ;; can't reparse multipart posts, even when FORCEd
 291              (not (eq t (slot-value request 'raw-post-data))))
 292     (unless (or (header-in :content-length request)
 293                 (input-chunking-p))
 294       (log-message* :warning "Can't read request body because there's ~
 295 no Content-Length header and input chunking is off.")
 296       (return-from maybe-read-post-parameters nil))
 297     (handler-case*
 298         (multiple-value-bind (type subtype charset)
 299               (parse-content-type (header-in :content-type request))
 300           (let ((external-format (or external-format
 301                                      (when charset
 302                                        (handler-case
 303                                            (make-external-format charset :eol-style :lf)
 304                                          (error ()
 305                                            (hunchentoot-warn "Ignoring ~
 306 unknown character set ~A in request content type."
 307                                                  charset))))
 308                                      *hunchentoot-default-external-format*)))
 309             (setf (slot-value request 'post-parameters)
 310                   (cond ((and (string-equal type "application")
 311                               (string-equal subtype "x-www-form-urlencoded"))
 312                          (form-url-encoded-list-to-alist
 313                           (split "&" (raw-post-data :request request :external-format +latin-1+))
 314                           external-format))
 315                         ((and (string-equal type "multipart")
 316                               (string-equal subtype "form-data"))
 317                          (prog1 (parse-multipart-form-data request external-format)
 318                            (setf (slot-value request 'raw-post-data) t)))))))
 319       (error (condition)
 320         (log-message* :error "Error when reading POST parameters from body: ~A" condition)
 321         ;; this is not the right thing to do because it could happen
 322         ;; that we aren't finished reading from the request stream and
 323         ;; can't send a reply - to be revisited
 324         (setf (return-code*) +http-bad-request+
 325               *close-hunchentoot-stream* t)
 326         (abort-request-handler)))))
 327
 328 (defun recompute-request-parameters (&key (request *request*)
 329                                           (external-format *hunchentoot-default-external-format*))
 330   "Recomputes the GET and POST parameters for the REQUEST object
 331 REQUEST.  This only makes sense if you're switching external formats
 332 during the request."
 333   (maybe-read-post-parameters :request request :force t :external-format external-format)
 334   (setf (slot-value request 'get-parameters)
 335         (form-url-encoded-list-to-alist (split "&" (query-string request)) external-format))
 336   (values))
 337
 338 (defun script-name* (&optional (request *request*))
 339   "Returns the file name of the REQUEST object REQUEST. That's the
 340 requested URI without the query string \(i.e the GET parameters)."
 341   (script-name request))
 342
 343 (defun query-string* (&optional (request *request*))
 344   "Returns the query string of the REQUEST object REQUEST. That's
 345 the part behind the question mark \(i.e. the GET parameters)."
 346   (query-string request))
 347
 348 (defun get-parameters* (&optional (request *request*))
 349   "Returns an alist of the GET parameters associated with the REQUEST
 350 object REQUEST."
 351   (get-parameters request))
 352
 353 (defmethod post-parameters :before ((request request))
 354   ;; Force here because if someone calls POST-PARAMETERS they actually
 355   ;; want them, regardless of why the RAW-POST-DATA has been filled
 356   ;; in. (For instance, if SEND-HEADERS has been called, filling in
 357   ;; RAW-POST-DATA, and then subsequent code calls POST-PARAMETERS,
 358   ;; without the :FORCE flag POST-PARAMETERS would return NIL.)
 359   (maybe-read-post-parameters
 360    :request request :force (not (slot-value request 'post-parameters))))
 361
 362 (defun post-parameters* (&optional (request *request*))
 363   "Returns an alist of the POST parameters associated with the REQUEST
 364 object REQUEST."
 365   (post-parameters request))
 366
 367 (defun headers-in* (&optional (request *request*))
 368   "Returns an alist of the incoming headers associated with the
 369 REQUEST object REQUEST."
 370   (headers-in request))
 371
 372 (defun cookies-in* (&optional (request *request*))
 373   "Returns an alist of all cookies associated with the REQUEST object
 374 REQUEST."
 375   (cookies-in request))
 376
 377 (defgeneric header-in (name request)
 378   (:documentation "Returns the incoming header with name NAME.  NAME
 379 can be a keyword \(recommended) or a string.")
 380   (:method (name request)
 381    (cdr (assoc* name (headers-in request)))))
 382
 383 (defun header-in* (name &optional (request *request*))
 384   "Returns the incoming header with name NAME.  NAME can be a keyword
 385 \(recommended) or a string."
 386   (header-in name request))
 387
 388 (defun authorization (&optional (request *request*))
 389   "Returns as two values the user and password \(if any) as encoded in
 390 the 'AUTHORIZATION' header.  Returns NIL if there is no such header."
 391   (let* ((authorization (header-in :authorization request))
 392          (start (and authorization
 393                      (> (length authorization) 5)
 394                      (string-equal "Basic" authorization :end2 5)
 395                      (scan "\\S" authorization :start 5))))
 396     (when start
 397       (destructuring-bind (&optional user password)
 398           (split ":" (base64:base64-string-to-string (subseq authorization start)))
 399         (values user password)))))
 400
 401 (defun remote-addr* (&optional (request *request*))
 402   "Returns the address the current request originated from."
 403   (remote-addr request))
 404
 405 (defun remote-port* (&optional (request *request*))
 406   "Returns the port the current request originated from."
 407   (remote-port request))
 408
 409 (defun real-remote-addr (&optional (request *request*))
 410   "Returns the 'X-Forwarded-For' incoming http header as the
 411 second value in the form of a list of IP addresses and the first
 412 element of this list as the first value if this header exists.
 413 Otherwise returns the value of REMOTE-ADDR as the only value."
 414   (let ((x-forwarded-for (header-in :x-forwarded-for request)))
 415     (cond (x-forwarded-for (let ((addresses (split "\\s*,\\s*" x-forwarded-for)))
 416                              (values (first addresses) addresses)))
 417           (t (remote-addr request)))))
 418
 419 (defun host (&optional (request *request*))
 420   "Returns the 'Host' incoming http header value."
 421   (header-in :host request))
 422
 423 (defun request-uri* (&optional (request *request*))
 424   "Returns the request URI."
 425   (request-uri request))
 426
 427 (defun request-method* (&optional (request *request*))
 428   "Returns the request method as a Lisp keyword."
 429   (request-method request))
 430
 431 (defun server-protocol* (&optional (request *request*))
 432   "Returns the request protocol as a Lisp keyword."
 433   (server-protocol request))
 434
 435 (defun user-agent (&optional (request *request*))
 436   "Returns the 'User-Agent' http header."
 437   (header-in :user-agent request))
 438
 439 (defun cookie-in (name &optional (request *request*))
 440   "Returns the cookie with the name NAME \(a string) as sent by the
 441 browser - or NIL if there is none."
 442   (cdr (assoc name (cookies-in request) :test #'string=)))
 443
 444 (defun referer (&optional (request *request*))
 445   "Returns the 'Referer' \(sic!) http header."
 446   (header-in :referer request))
 447
 448 (defun get-parameter (name &optional (request *request*))
 449   "Returns the GET parameter with name NAME \(a string) - or NIL if
 450 there is none.  Search is case-sensitive."
 451   (cdr (assoc name (get-parameters request) :test #'string=)))
 452
 453 (defun post-parameter (name &optional (request *request*))
 454   "Returns the POST parameter with name NAME \(a string) - or NIL if
 455 there is none.  Search is case-sensitive."
 456   (cdr (assoc name (post-parameters request) :test #'string=)))
 457
 458 (defun parameter (name &optional (request *request*))
 459   "Returns the GET or the POST parameter with name NAME \(a string) -
 460 or NIL if there is none.  If both a GET and a POST parameter with the
 461 same name exist the GET parameter is returned.  Search is
 462 case-sensitive."
 463   (or (get-parameter name request)
 464       (post-parameter name request)))
 465
 466 (defun handle-if-modified-since (time &optional (request *request*))
 467   "Handles the 'If-Modified-Since' header of REQUEST.  The date string
 468 is compared to the one generated from the supplied universal time
 469 TIME."
 470   (let ((if-modified-since (header-in :if-modified-since request))
 471         (time-string (rfc-1123-date time)))
 472     ;; simple string comparison is sufficient; see RFC 2616 14.25
 473     (when (and if-modified-since
 474                (equal if-modified-since time-string))
 475       (setf (return-code*) +http-not-modified+)
 476       (abort-request-handler))
 477     (values)))
 478
 479 (defun external-format-from-content-type (content-type)
 480   "Creates and returns an external format corresponding to the value
 481 of the content type header provided in CONTENT-TYPE.  If the content
 482 type was not set or if the character set specified was invalid, NIL is
 483 returned."
 484   (when content-type
 485     (when-let (charset (nth-value 2 (parse-content-type content-type)))
 486       (handler-case
 487           (make-external-format (as-keyword charset) :eol-style :lf)
 488         (error ()
 489           (hunchentoot-warn "Invalid character set ~S in request has been ignored."
 490                             charset))))))
 491
 492 (defun raw-post-data (&key (request *request*) external-format force-text force-binary want-stream)
 493   "Returns the content sent by the client if there was any \(unless
 494 the content type was \"multipart/form-data\").  By default, the result
 495 is a string if the type of the `Content-Type' media type is \"text\",
 496 and a vector of octets otherwise.  In the case of a string, the
 497 external format to be used to decode the content will be determined
 498 from the `charset' parameter sent by the client \(or otherwise
 499 *HUNCHENTOOT-DEFAULT-EXTERNAL-FORMAT* will be used).
 500
 501 You can also provide an external format explicitly \(through
 502 EXTERNAL-FORMAT) in which case the result will unconditionally be a
 503 string.  Likewise, you can provide a true value for FORCE-TEXT which
 504 will force Hunchentoot to act as if the type of the media type had
 505 been \"text\".  Or you can provide a true value for FORCE-BINARY which
 506 means that you want a vector of octets at any rate.
 507
 508 If, however, you provide a true value for WANT-STREAM, the other
 509 parameters are ignored and you'll get the content \(flexi) stream to
 510 read from it yourself.  It is then your responsibility to read the
 511 correct amount of data, because otherwise you won't be able to return
 512 a response to the client.  If the content type of the request was
 513 `multipart/form-data' or `application/x-www-form-urlencoded', the
 514 content has been read by Hunchentoot already and you can't read from
 515 the stream anymore.
 516
 517 You can call RAW-POST-DATA more than once per request, but you can't
 518 mix calls which have different values for WANT-STREAM.
 519
 520 Note that this function is slightly misnamed because a client can send
 521 content even if the request method is not POST."
 522   (when (and force-binary force-text)
 523     (parameter-error "It doesn't make sense to set both FORCE-BINARY and FORCE-TEXT to a true value."))
 524   (unless (or external-format force-binary)
 525     (setq external-format (or (external-format-from-content-type (header-in :content-type request))
 526                               (when force-text
 527                                 *hunchentoot-default-external-format*))))
 528   (let ((raw-post-data (or (slot-value request 'raw-post-data)
 529                            (get-post-data :request request :want-stream want-stream))))
 530     (cond ((typep raw-post-data 'stream) raw-post-data)
 531           ((member raw-post-data '(t nil)) nil)
 532           (external-format (octets-to-string raw-post-data :external-format external-format))
 533           (t raw-post-data))))
 534
 535 (defun aux-request-value (symbol &optional (request *request*))
 536   "Returns the value associated with SYMBOL from the request object
 537 REQUEST \(the default is the current request) if it exists.  The
 538 second return value is true if such a value was found."
 539   (when request
 540     (let ((found (assoc symbol (aux-data request) :test #'eq)))
 541       (values (cdr found) found))))
 542
 543 (defsetf aux-request-value (symbol &optional request)
 544     (new-value)
 545   "Sets the value associated with SYMBOL from the request object
 546 REQUEST \(default is *REQUEST*).  If there is already a value
 547 associated with SYMBOL it will be replaced."
 548   (with-rebinding (symbol)
 549     (with-unique-names (place %request)
 550       `(let* ((,%request (or ,request *request*))
 551               (,place (assoc ,symbol (aux-data ,%request) :test #'eq)))
 552          (cond
 553            (,place
 554             (setf (cdr ,place) ,new-value))
 555            (t
 556             (push (cons ,symbol ,new-value)
 557                   (aux-data ,%request))
 558             ,new-value))))))
 559
 560 (defun delete-aux-request-value (symbol &optional (request *request*))
 561   "Removes the value associated with SYMBOL from the request object
 562 REQUEST."
 563   (when request
 564     (setf (aux-data request)
 565             (delete symbol (aux-data request)
 566                     :key #'car :test #'eq)))
 567   (values))