cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Stop using the knots web-server exception handler

Browse source 
As I want to remove this.
This commit is contained in:
Christopher Baines 2025-03-10 21:45:16 +00:00
parent c602c6b533
commit 73e1c0318b
1 changed files with 58 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

98
guix-data-service/web/server.scm
View file

@ -31,6 +31,7 @@
#:use-module (fibers channels)
#:use-module (fibers scheduler)
#:use-module (fibers conditions)
#:use-module (knots)
#:use-module (knots web-server)
#:use-module (knots resource-pool)
#:use-module ((guix build syscalls)
@ -242,49 +243,66 @@ port. Also, the port used can be changed by passing the --port option.\n"
(let ((render-metrics (make-render-metrics registry)))
(run-knots-web-server
(lambda (request)
(metric-increment requests-metric)
(with-exception-handler
(lambda (exn)
(when (resource-pool-timeout-error? exn)
(spawn-fiber
(lambda ()
(let* ((pool (resource-pool-timeout-error-pool exn))
(stats (resource-pool-stats pool)))
(simple-format (current-error-port)
"resource pool timeout error: ~A, ~A\n"
pool
stats)))))
(let ((body (read-request-body request)))
(handler request finished? body controller
secret-key-base
startup-completed
render-metrics)))
#:exception-handler
(lambda (exn request)
(when (resource-pool-timeout-error? exn)
(spawn-fiber
(lambda ()
(let* ((pool (resource-pool-timeout-error-pool exn))
(stats (resource-pool-stats pool)))
(simple-format (current-error-port)
"resource pool timeout error: ~A, ~A\n"
pool
stats)))))
(let ((path-components
mime-types
(request->path-components-and-mime-type request)))
(case (most-appropriate-mime-type
mime-types
'(text/html application/json))
((application/json)
(apply
values
(render-json `((error . ,(if (%show-error-details)
(simple-format #f "~A" exn)
#f)))
#:code 500)))
(else
(apply
values
(render-html #:sxml (error-page
(if (%show-error-details)
exn
#f))
#:code 500))))))
(lambda ()
(with-exception-handler
(lambda (exn)
(let* ((error-string
(call-with-output-string
(lambda (port)
(simple-format
port
"exception when processing: ~A ~A\n"
(request-method request)
(uri-path (request-uri request)))
(print-backtrace-and-exception/knots
exn
#:port port)))))
(display error-string
(current-error-port)))
;; Use the error output from the default exception handler
(default-exception-handler exn request)
(raise-exception exn))
(lambda ()
(metric-increment requests-metric)
(let ((path-components
mime-types
(request->path-components-and-mime-type request)))
(case (most-appropriate-mime-type
mime-types
'(text/html application/json))
((application/json)
(apply
values
(render-json `((error . ,(if (%show-error-details)
(simple-format #f "~A" exn)
#f)))
#:code 500)))
(else
(apply
values
(render-html #:sxml (error-page
(if (%show-error-details)
exn
#f))
#:code 500))))))
(let ((body (read-request-body request)))
(handler request finished? body controller
secret-key-base
startup-completed
render-metrics)))))
#:unwind? #t))
#:connection-buffer-size (expt 2 16)
#:host host
#:port port)))