Changeset 26870 in project


Ignore:
Timestamp:
06/10/12 13:21:38 (9 years ago)
Author:
sjamaan
Message:

spiffy: Use new 'response-has-message-body-for-request?' parameter instead of hardcoded checks for HEAD requests and 304 requests

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/spiffy/trunk/spiffy.scm

    r26867 r26870  
    3535; ticket tracking system (assign tickets to user 'sjamaan'):
    3636; http://trac.callcc.org
    37 
    38 (provide 'spiffy)
    3937
    4038(module spiffy
     
    288286  (let* ((new-headers (cons `(content-length ,(if body (string-length body) 0))
    289287                            headers))
    290          (h (intarweb:headers new-headers (response-headers (current-response)))))
    291     (parameterize ((current-response
    292                     (if (and status (not code) (not reason))
    293                         (update-response (current-response)
    294                                          status: status headers: h)
    295                         (update-response (current-response)
    296                                          code: (or code 200) reason: (or reason "OK")
    297                                          headers: h))))
     288         (h (intarweb:headers new-headers (response-headers (current-response))))
     289         (resp (if (and status (not code) (not reason))
     290                   (update-response (current-response)
     291                                    status: status headers: h)
     292                   (update-response (current-response)
     293                                    code: (or code 200) reason: (or reason "OK")
     294                                    headers: h)))
     295         (req (current-request)))
     296    (parameterize ((current-response resp))
    298297      (write-logged-response)
    299       (unless (or (eq? 'HEAD (request-method (current-request))) (not body))
     298      (when (and body ((response-has-message-body-for-request?) resp req))
    300299        (display body (response-port (current-response)))))))
    301300
     
    311310                             (and-let* ((t (header-value 'if-modified-since h)))
    312311                               (<= last-modified (utc-time->seconds t))))))
    313         (with-headers `((last-modified #(,(seconds->utc-time last-modified)))
    314                         (etag ,etag)
    315                         (content-length ,(if unmodified 0 size))
    316                         (content-type ,(file-extension->mime-type
    317                                         (pathname-extension filename))))
    318           (lambda ()
    319             (if unmodified
    320                 ;; RFC 2616, 10.3.5:
    321                 ;; "The 304 response MUST NOT contain a message-body"
    322                 ;; For this reason, we do not use send-status.
    323                 (parameterize ((current-response
    324                                 (update-response (current-response)
    325                                                  status: 'not-modified)))
    326                   (write-logged-response))
    327                 (begin
    328                   (write-logged-response)
    329                   (unless (eq? 'HEAD (request-method (current-request)))
    330                     (call-with-input-file*
    331                      path (lambda (f)
    332                             (sendfile f (response-port (current-response)))))))))))
     312        (parameterize ((current-response
     313                        (if unmodified
     314                            (update-response (current-response) status: 'not-modified)
     315                            (current-response))))
     316          (with-headers `((last-modified #(,(seconds->utc-time last-modified)))
     317                          (etag ,etag)
     318                          (content-length ,(if unmodified 0 size))
     319                          (content-type ,(file-extension->mime-type
     320                                          (pathname-extension filename))))
     321            (lambda ()
     322              (write-logged-response)
     323              (when ((response-has-message-body-for-request?)
     324                     (current-response) (current-request))
     325                (call-with-input-file*
     326                 path (lambda (f)
     327                        (sendfile f (response-port (current-response))))))))))
    333328    ((exn i/o file) (send-status 'forbidden))))
    334329
Note: See TracChangeset for help on using the changeset viewer.