cbaines pushed a commit to branch trunk in repository data-service. commit 73e1c0318bd0a1e84656124cd1d3833e4b8e2fdb Author: Christopher Baines <[email protected]> AuthorDate: Mon Mar 10 21:45:16 2025 +0000
Stop using the knots web-server exception handler
As I want to remove this.
---
guix-data-service/web/server.scm | 98 ++++++++++++++++++++++++----------------
1 file changed, 58 insertions(+), 40 deletions(-)
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index 88f7b1a..2e76a72 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -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)))
