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 channels)
#:use-module (fibers scheduler) #:use-module (fibers scheduler)
#:use-module (fibers conditions) #:use-module (fibers conditions)
#:use-module (knots)
#:use-module (knots web-server) #:use-module (knots web-server)
#:use-module (knots resource-pool) #:use-module (knots resource-pool)
#:use-module ((guix build syscalls) #: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))) (let ((render-metrics (make-render-metrics registry)))
(run-knots-web-server (run-knots-web-server
(lambda (request) (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))) (let ((path-components
(handler request finished? body controller mime-types
secret-key-base (request->path-components-and-mime-type request)))
startup-completed (case (most-appropriate-mime-type
render-metrics))) mime-types
#:exception-handler '(text/html application/json))
(lambda (exn request) ((application/json)
(when (resource-pool-timeout-error? exn) (apply
(spawn-fiber values
(lambda () (render-json `((error . ,(if (%show-error-details)
(let* ((pool (resource-pool-timeout-error-pool exn)) (simple-format #f "~A" exn)
(stats (resource-pool-stats pool))) #f)))
(simple-format (current-error-port) #:code 500)))
"resource pool timeout error: ~A, ~A\n" (else
pool (apply
stats))))) 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 (raise-exception exn))
(default-exception-handler exn request) (lambda ()
(metric-increment requests-metric)
(let ((path-components (let ((body (read-request-body request)))
mime-types (handler request finished? body controller
(request->path-components-and-mime-type request))) secret-key-base
(case (most-appropriate-mime-type startup-completed
mime-types render-metrics)))))
'(text/html application/json)) #:unwind? #t))
((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))))))
#:connection-buffer-size (expt 2 16) #:connection-buffer-size (expt 2 16)
#:host host #:host host
#:port port))) #:port port)))