Changeset 12536 in project for release/4/spiffy/trunk/spiffy.scm


Ignore:
Timestamp:
11/16/08 21:36:16 (11 years ago)
Author:
sjamaan
Message:

Make build-error-message accept an argument to disable HTML, export it and default the exception handler to send errors to stderr instead of client

File:
1 edited

Legend:

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

    r12534 r12536  
    3838(module spiffy
    3939  (start-server with-headers send-status send-static-file log-to
    40    write-logged-response
     40   write-logged-response build-error-message
    4141   current-request remote-address local-address
    4242   current-response current-file current-pathinfo
     
    116116  (make-parameter
    117117   (lambda (exn chain)
    118      (send-status 500 "Internal server error" (build-error-message exn chain)))))
     118     (log-to (error-log) (build-error-message exn chain #t))
     119     (send-status 500 "Internal server error"))))
    119120
    120121;; This is very powerful, but it also means people need to write quite
     
    158159         (exn-arguments (cpa 'exn 'arguments '()))
    159160         (exn? (condition-predicate 'exn)))
    160     (lambda (exn chain)
     161    (lambda (exn chain #!optional raw-output)
    161162      (with-output-to-string
    162163        (lambda ()
    163164          (if (exn? exn)
    164165              (begin
    165                 (display "<h2>Error:")
     166                (unless raw-output (display "<h2>"))
     167                (display "Error:")
    166168                (and-let* ((loc (exn-location exn)))
    167                   (printf " (<em>~A</em>)" (htmlize (->string loc))))
    168                 (printf "</h2>\n<h3>~A</h3>\n" (htmlize (exn-message exn)))
     169                  (if raw-output
     170                      (printf " (~A)" (->string loc))
     171                      (printf " (<em>~A</em>)" (htmlize (->string loc)))))
     172                (if raw-output
     173                    (printf "\n~A\n" (exn-message exn))
     174                    (printf "</h2>\n<h3>~A</h3>\n" (htmlize (exn-message exn))))
    169175                (unless (null? (exn-arguments exn))
    170                         (printf "<ul>")
     176                        (unless raw-output (printf "<ul>"))
    171177                        (for-each
    172178                         (lambda (a)
    173                            (##sys#with-print-length-limit 120 (lambda () (printf "<li>~S</li>" (htmlize (->string a))))))
     179                           (##sys#with-print-length-limit
     180                            120
     181                            (lambda ()
     182                              (if raw-output
     183                                  (print (->string a))
     184                                  (printf "<li>~A</li>"
     185                                          (htmlize (->string a)))))))
    174186                         (exn-arguments exn))
    175                         (printf "</ul>"))
    176                 (printf "<pre>~a</pre>" (htmlize chain)))
     187                        (unless raw-output
     188                         (printf "</ul>")))
     189                (if raw-output
     190                    (print chain)
     191                    (printf "<pre>~a</pre>" (htmlize chain))))
    177192              (begin
    178193                (##sys#with-print-length-limit
    179194                 120
    180195                 (lambda ()
    181                    (printf "<h2>Uncaught exception:</h2>\n~S" exn))))))))))
     196                   (if raw-output
     197                       (printf "Uncaught exception:\n~S\n" exn)
     198                       (printf "<h2>Uncaught exception:</h2>\n~S\n" exn)))))))))))
    182199
    183200(define (extension->mime-type ext)
Note: See TracChangeset for help on using the changeset viewer.