diff options
| -rw-r--r-- | weeb/main.scm | 52 |
1 files changed, 37 insertions, 15 deletions
diff --git a/weeb/main.scm b/weeb/main.scm index b6e47ec..d9f5bdf 100644 --- a/weeb/main.scm +++ b/weeb/main.scm @@ -29,7 +29,11 @@ #:use-module (weeb router) #:use-module (weeb struct) #:use-module (weeb sxml) - #:export (run-server)) + #:export (%enable-web-console + run-server)) + +(define %enable-web-console + (make-parameter #f)) (define status-codes '((100 . "Continue") @@ -134,21 +138,39 @@ (uri (strip-query-string (getenv "REQUEST_URI")))) (make-struct <request> method uri query headers (fcgi-read)))) +(define (render-generic-500) + (sxml->html + `(html + (body + (h1 "Error"))))) + +(define (render-web-console stack) + (sxml->html + `(html + (body + (h1 "Error") + (pre ,(call-with-output-string (cut display-backtrace stack <>))))))) + (define (handle-errors thunk) - (catch #t - (lambda () - (with-exception-handler - (lambda (exn) - (let ((captured-stack (make-stack #t))) - (throw 'custom-error-key exn captured-stack))) - thunk - #:unwind? #f)) - (lambda (key exn captured-stack) - (let ((stack-trace (call-with-output-string (cut display-backtrace captured-stack <>)))) - (list 500 stack-trace))))) + (let ((stack #f)) + (call-with-error-handling + thunk + #:pass-keys '(quit interrupt) + #:on-error + (begin + (set! stack (make-stack #t)) + 'pass) + #:post-error + (lambda _ + (list 500 (if (%enable-web-console) + (render-web-console stack) + (render-generic-500))))))) (define (run-server router) (while (zero? (fcgi-accept)) - (let* ((request (receive-request)) - (response (iter-routes request router))) - (write-response (any->response response))))) + (write-response + (any->response + (handle-errors + (lambda () + (let* ((request (receive-request))) + (iter-routes request router)))))))) |