Changeset 26596 in project


Ignore:
Timestamp:
04/29/12 19:57:36 (9 years ago)
Author:
Mario Domenech Goulart
Message:

awful: special case for resource handlers which yield procedures. In those cases, awful won't do anything besides calling the returned procedure (not even set headers). That can be useful for calling things like `send-static-file' from resource handlers, so awful won't try to send anything else.

File:
1 edited

Legend:

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

    r26252 r26596  
    407407  (let ((handler
    408408         (lambda (path proc)
    409            (let ((out (->string (proc path))))
    410              (if (%error)
    411                  (send-response code: 500
    412                                 reason: "Internal server error"
    413                                 body: ((page-template) ((page-exception-message) (%error)))
    414                                 headers: '((content-type text/html)))
    415                  (if (%redirect) ;; redirection
    416                      (let ((new-uri (if (string? (%redirect))
    417                                         (uri-reference (%redirect))
    418                                         (%redirect))))
    419                        (with-headers `((location ,new-uri))
    420                                      (lambda ()
    421                                        (send-status 302 "Found"))))
    422                      (with-headers (append
    423                                     (or (awful-response-headers)
    424                                         `((content-type text/html)))
    425                                     (or (and-let* ((headers (awful-response-headers))
    426                                                    (content-length (alist-ref 'content-length headers)))
    427                                           (list (cons 'content-length content-length)))
    428                                         `((content-length ,(string-length out)))))
    429                                    (lambda ()
    430                                      (write-logged-response)
    431                                      (unless (eq? 'HEAD (request-method (current-request)))
    432                                        (display out (response-port (current-response))))))))))))
     409           (let ((resp (proc path)))
     410             (if (procedure? resp)
     411                 (let ((out (->string resp)))
     412                   (if (%error)
     413                       (send-response code: 500
     414                                      reason: "Internal server error"
     415                                      body: ((page-template) ((page-exception-message) (%error)))
     416                                      headers: '((content-type text/html)))
     417                       (if (%redirect) ;; redirection
     418                           (let ((new-uri (if (string? (%redirect))
     419                                              (uri-reference (%redirect))
     420                                              (%redirect))))
     421                             (with-headers `((location ,new-uri))
     422                                           (lambda ()
     423                                             (send-status 302 "Found"))))
     424                           (with-headers (append
     425                                          (or (awful-response-headers)
     426                                              `((content-type text/html)))
     427                                          (or (and-let* ((headers (awful-response-headers))
     428                                                         (content-length (alist-ref 'content-length headers)))
     429                                                (list (cons 'content-length content-length)))
     430                                              `((content-length ,(string-length out)))))
     431                                         (lambda ()
     432                                           (write-logged-response)
     433                                           (unless (eq? 'HEAD (request-method (current-request)))
     434                                             (display out (response-port (current-response))))))))))))))
    433435    (call/cc (lambda (continue)
    434436               (for-each (lambda (hook)
     
    567569                                               (print-error-message exn))))
    568570                                    ((page-exception-message) exn))
    569                                   (++ (if (regexp? path)
    570                                           (contents given-path)
    571                                           (contents))
    572                                       (if (eq? (javascript-position) 'bottom)
    573                                           (include-page-javascript ajax? no-javascript-compression)
    574                                           "")))))
     571                                  (let ((resp
     572                                         (if (regexp? path)
     573                                             (contents given-path)
     574                                             (contents))))
     575                                    (if (procedure? resp)
     576                                        resp
     577                                        (++ resp
     578                                            (if (eq? (javascript-position) 'bottom)
     579                                                (include-page-javascript ajax? no-javascript-compression)
     580                                                "")))))))
    575581                          (if (%redirect)
    576582                              #f ;; no need to do anything.  Let `run-resource' perform the redirection
Note: See TracChangeset for help on using the changeset viewer.