Changeset 20436 in project


Ignore:
Timestamp:
09/21/10 16:56:46 (8 years ago)
Author:
mario
Message:

awful: exception pages are sent to clients with code 500

File:
1 edited

Legend:

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

    r20250 r20436  
    9494(define %web-repl-path (make-parameter #f))
    9595(define %session-inspector-path (make-parameter #f))
     96(define %error (make-parameter #f))
    9697
    9798;; db-support parameters (set by awful-<db> eggs)
     
    332333(define (run-resource proc path)
    333334  (let ((out (->string (proc path))))
    334     (if (%redirect) ;; redirection
    335         (let ((new-uri (if (string? (%redirect))
    336                            (uri-reference (%redirect))
    337                            (%redirect))))
    338           (with-headers `((location ,new-uri))
    339                         (lambda ()
    340                           (%redirect #f)
    341                           (send-status 302 "Found"))))
    342         (with-headers (append
    343                        (or (awful-response-headers)
    344                            `((content-type text/html)))
    345                        (or (and-let* ((headers (awful-response-headers))
    346                                       (content-length (alist-ref 'content-length headers)))
    347                              (list (cons 'content-length content-length)))
    348                            `((content-length ,(string-length out)))))
    349                       (lambda ()
    350                         (write-logged-response)
    351                         (unless (eq? 'HEAD (request-method (current-request)))
    352                           (display out (response-port (current-response)))))))))
     335    (if (%error)
     336        (send-response code: 500
     337                       reason: "Internal server error"
     338                       body: ((page-template) ((page-exception-message) (%error)))
     339                       headers: '((content-type text/html)))
     340        (if (%redirect) ;; redirection
     341            (let ((new-uri (if (string? (%redirect))
     342                               (uri-reference (%redirect))
     343                               (%redirect))))
     344              (with-headers `((location ,new-uri))
     345                            (lambda ()
     346                              (%redirect #f)
     347                              (send-status 302 "Found"))))
     348            (with-headers (append
     349                           (or (awful-response-headers)
     350                               `((content-type text/html)))
     351                           (or (and-let* ((headers (awful-response-headers))
     352                                          (content-length (alist-ref 'content-length headers)))
     353                                 (list (cons 'content-length content-length)))
     354                               `((content-length ,(string-length out)))))
     355                          (lambda ()
     356                            (write-logged-response)
     357                            (unless (eq? 'HEAD (request-method (current-request)))
     358                              (display out (response-port (current-response))))))))))
    353359
    354360(define (resource-ref path vhost-root-path)
     
    422428                                exn
    423429                                (begin
     430                                  (%error exn)
    424431                                  (debug (with-output-to-string
    425432                                           (lambda ()
Note: See TracChangeset for help on using the changeset viewer.