Tweak handling web server errors

This commit is contained in:
Christopher Baines 2024-08-14 20:40:34 +01:00
parent b2dcccb264
commit 0c08ce069d
2 changed files with 44 additions and 24 deletions

View file

@ -712,26 +712,49 @@
#:sxml (server-starting-up-page) #:sxml (server-starting-up-page)
#:code 503))) #:code 503)))
(call-with-error-handling (with-exception-handler
(if startup-completed? (lambda (exn)
running-controller-thunk (case (most-appropriate-mime-type
startup-controller-thunk) mime-types
#:on-error 'backtrace '(text/html application/json))
#:post-error (lambda args ((application/json)
(case (most-appropriate-mime-type (render-json `((error . ,(if (%show-error-details)
mime-types (simple-format #f "~A" exn)
'(text/html application/json)) #f)))
((application/json) #:code 500))
(render-json `((error . ,(if (%show-error-details) (else
(simple-format #f "~A" args) (render-html #:sxml (error-page
#f))) (if (%show-error-details)
#:code 500)) exn
(else #f))
(render-html #:sxml (error-page #:code 500))))
(if (%show-error-details) (lambda ()
args (with-throw-handler #t
#f)) (if startup-completed?
#:code 500)))))) running-controller-thunk
startup-controller-thunk)
(lambda (key . args)
(match method-and-path-components
((method path-components ...)
(simple-format
(current-error-port)
"error: when processing: /~A ~A\n ~A ~A\n"
method (string-join path-components "/")
key args)))
(let* ((stack (make-stack #t 4))
(backtrace
(call-with-output-string
(lambda (port)
(display "\nBacktrace:\n" port)
(display-backtrace stack port)
(newline port)
(newline port)))))
(display
backtrace
(current-error-port))))))
#:unwind? #t))
(define* (base-controller request method-and-path-components (define* (base-controller request method-and-path-components
startup-completed?) startup-completed?)

View file

@ -969,10 +969,7 @@
(h1 "An error occurred") (h1 "An error occurred")
(p "Sorry about that!") (p "Sorry about that!")
,@(if error ,@(if error
(match error `((pre ,error))
((key . args)
`((b ,key)
(pre ,args))))
'()))))) '())))))
(define* (server-starting-up-page) (define* (server-starting-up-page)