Changeset 3419

Show
Ignore:
Timestamp:
07/09/08 09:30:39 (6 months ago)
Author:
edi
Message:

Fix handling of chunked requests (bug caught by Cyrus Harmon)

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/thirdparty/hunchentoot/server.lisp

    r3321 r3419  
    463463              (let ((*reply* (make-instance 'reply)) 
    464464                    (*session* nil)) 
     465                (when (server-input-chunking-p *server*) 
     466                  (let ((transfer-encodings (cdr (assoc* :transfer-encoding headers-in)))) 
     467                    (when transfer-encodings 
     468                      (setq transfer-encodings 
     469                            (split "\\s*,\\*" transfer-encodings))) 
     470                    (when (member "chunked" transfer-encodings :test #'equalp) 
     471                      ;; turn chunking on before we read the request body 
     472                      (setf *hunchentoot-stream* (make-chunked-stream *hunchentoot-stream*) 
     473                            (chunked-stream-input-chunking-p *hunchentoot-stream*) t)))) 
    465474                (multiple-value-bind (remote-addr remote-port) 
    466475                    (get-peer-address-and-port socket) 
    …… 
    492501  (let (*tmp-files* *headers-sent*) 
    493502    (unwind-protect 
    494         (progn 
    495           (when (server-input-chunking-p *server*) 
    496             (let ((transfer-encodings (header-in :transfer-encoding request))) 
    497               (when transfer-encodings 
    498                 (setq transfer-encodings 
    499                       (split "\\s*,\\*" transfer-encodings))) 
    500               (when (member "chunked" transfer-encodings :test #'equalp) 
    501                 ;; turn chunking on before we read the request body 
    502                 (setf *hunchentoot-stream* (make-chunked-stream *hunchentoot-stream*) 
    503                       (chunked-stream-input-chunking-p *hunchentoot-stream*) t)))) 
    504           (let* ((*request* request) 
    505                  backtrace) 
    506             (multiple-value-bind (body error) 
    507                 (catch 'handler-done 
    508                   (handler-bind ((error 
    509                                   (lambda (cond) 
    510                                     ;; only generate backtrace if needed 
    511                                     (setq backtrace 
    512                                           (and (or (and *show-lisp-errors-p* 
    513                                                         *show-lisp-backtraces-p*) 
    514                                                    (and *log-lisp-errors-p* 
    515                                                         *log-lisp-backtraces-p*)) 
    516                                                (get-backtrace cond))) 
    517                                     (when *log-lisp-errors-p* 
    518                                       (log-message* *lisp-errors-log-level* 
    519                                                     "~A~:[~*~;~%~A~]" 
    520                                                     cond 
    521                                                     *log-lisp-backtraces-p* 
    522                                                     backtrace)) 
    523                                     ;; if the headers were already sent 
    524                                     ;; the error happens within the body 
    525                                     ;; and we have to close the stream 
    526                                     (when *headers-sent* 
    527                                       (setq *close-hunchentoot-stream* t)) 
    528                                     (throw 'handler-done 
    529                                            (values nil cond)))) 
    530                                  (warning 
    531                                   (lambda (cond) 
    532                                     (when *log-lisp-warnings-p* 
    533                                       (log-message* *lisp-warnings-log-level* 
    534                                                     "~A~:[~*~;~%~A~]" 
    535                                                     cond 
    536                                                     *log-lisp-backtraces-p* 
    537                                                     backtrace))))) 
    538                     ;; skip dispatch if bad request 
    539                     (when (eql (return-code) +http-ok+) 
    540                       ;; now do the work 
    541                       (dispatch-request *server* *request* *reply*)))) 
    542               (when error 
    543                 (setf (return-code *reply*) 
    544                       +http-internal-server-error+)) 
    545               (start-output :content (cond ((and error *show-lisp-errors-p*) 
    546                                             (format nil "<pre>~A~:[~*~;~%~%~A~]</pre>" 
    547                                                     (escape-for-html (format nil "~A" error)) 
    548                                                     *show-lisp-backtraces-p* 
    549                                                     (escape-for-html (format nil "~A" backtrace)))) 
    550                                            (error 
    551                                             "An error has occured.") 
    552                                            (t body)))) 
    553             t)) 
     503        (let* ((*request* request) 
     504               backtrace) 
     505          (multiple-value-bind (body error) 
     506              (catch 'handler-done 
     507                (handler-bind ((error 
     508                                (lambda (cond) 
     509                                  ;; only generate backtrace if needed 
     510                                  (setq backtrace 
     511                                        (and (or (and *show-lisp-errors-p* 
     512                                                      *show-lisp-backtraces-p*) 
     513                                                 (and *log-lisp-errors-p* 
     514                                                      *log-lisp-backtraces-p*)) 
     515                                             (get-backtrace cond))) 
     516                                  (when *log-lisp-errors-p* 
     517                                    (log-message* *lisp-errors-log-level* 
     518                                                  "~A~:[~*~;~%~A~]" 
     519                                                  cond 
     520                                                  *log-lisp-backtraces-p* 
     521                                                  backtrace)) 
     522                                  ;; if the headers were already sent 
     523                                  ;; the error happens within the body 
     524                                  ;; and we have to close the stream 
     525                                  (when *headers-sent* 
     526                                    (setq *close-hunchentoot-stream* t)) 
     527                                  (throw 'handler-done 
     528                                         (values nil cond)))) 
     529                               (warning 
     530                                (lambda (cond) 
     531                                  (when *log-lisp-warnings-p* 
     532                                    (log-message* *lisp-warnings-log-level* 
     533                                                  "~A~:[~*~;~%~A~]" 
     534                                                  cond 
     535                                                  *log-lisp-backtraces-p* 
     536                                                  backtrace))))) 
     537                  ;; skip dispatch if bad request 
     538                  (when (eql (return-code) +http-ok+) 
     539                    ;; now do the work 
     540                    (dispatch-request *server* *request* *reply*)))) 
     541            (when error 
     542              (setf (return-code *reply*) 
     543                    +http-internal-server-error+)) 
     544            (start-output :content (cond ((and error *show-lisp-errors-p*) 
     545                                          (format nil "<pre>~A~:[~*~;~%~%~A~]</pre>" 
     546                                                  (escape-for-html (format nil "~A" error)) 
     547                                                  *show-lisp-backtraces-p* 
     548                                                  (escape-for-html (format nil "~A" backtrace)))) 
     549                                         (error 
     550                                          "An error has occured.") 
     551                                         (t body)))) 
     552          t) 
    554553      (dolist (path *tmp-files*) 
    555554        (when (and (pathnamep path) (probe-file path))