diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-08-14 20:40:34 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-08-14 20:40:34 +0100 |
| commit | 0c08ce069dd08e2a73aadc4c9ee3a7900d6ef34a (patch) | |
| tree | d564ac1819fae822cfc408b056541ece2d61cb3d /guix-data-service | |
| parent | b2dcccb26479598a662f1c64e90b425379412fc0 (diff) | |
| download | data-service-0c08ce069dd08e2a73aadc4c9ee3a7900d6ef34a.tar data-service-0c08ce069dd08e2a73aadc4c9ee3a7900d6ef34a.tar.gz | |
Tweak handling web server errors
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/web/controller.scm | 63 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 5 |
2 files changed, 44 insertions, 24 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index a589941..8f23af7 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -712,26 +712,49 @@ #:sxml (server-starting-up-page) #:code 503))) - (call-with-error-handling - (if startup-completed? - running-controller-thunk - startup-controller-thunk) - #:on-error 'backtrace - #:post-error (lambda args - (case (most-appropriate-mime-type - mime-types - '(text/html application/json)) - ((application/json) - (render-json `((error . ,(if (%show-error-details) - (simple-format #f "~A" args) - #f))) - #:code 500)) - (else - (render-html #:sxml (error-page - (if (%show-error-details) - args - #f)) - #:code 500)))))) + (with-exception-handler + (lambda (exn) + (case (most-appropriate-mime-type + mime-types + '(text/html application/json)) + ((application/json) + (render-json `((error . ,(if (%show-error-details) + (simple-format #f "~A" exn) + #f))) + #:code 500)) + (else + (render-html #:sxml (error-page + (if (%show-error-details) + exn + #f)) + #:code 500)))) + (lambda () + (with-throw-handler #t + (if startup-completed? + 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 startup-completed?) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 98766de..61b75f1 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -969,10 +969,7 @@ (h1 "An error occurred") (p "Sorry about that!") ,@(if error - (match error - ((key . args) - `((b ,key) - (pre ,args)))) + `((pre ,error)) '()))))) (define* (server-starting-up-page) |