Simplify web server exception handling

This used to be more complicated as the exception handler was
configurable, but now it's not so this can be simplified.
This commit is contained in:
Christopher Baines 2026-03-22 15:16:17 +00:00
parent bb6d9fd89d
commit 677d941cb3

View file

@ -317,26 +317,6 @@ on the procedure being called at any particular time."
;; Close the client port ;; Close the client port
#f) #f)
(define (exception-handler exn request)
(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/knots error-string
(current-error-port)))
(values (build-response #:code 500)
;; TODO Make this configurable
(string->utf8
"internal server error")))
(define* (handle-request handler client (define* (handle-request handler client
read-request-exception-handler read-request-exception-handler
write-response-exception-handler write-response-exception-handler
@ -362,36 +342,47 @@ on the procedure being called at any particular time."
(connection . (close)))) (connection . (close))))
#vu8())) #vu8()))
(else (else
(call-with-escape-continuation (with-exception-handler
(lambda (return) (lambda (exn)
(with-exception-handler (sanitize-response
(lambda (exn) request
(build-response #:code 500)
(string->utf8
"internal server error")))
(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/knots error-string
(current-error-port))))
(lambda ()
(start-stack
#t
(call-with-values (call-with-values
(lambda () (lambda ()
(exception-handler exn request)) (handler request))
(lambda (response body) (match-lambda*
(call-with-values ((response body)
(lambda () (sanitize-response request response body))
(sanitize-response request response body)) (other
return)))) (raise-exception
(lambda () (make-exception-with-irritants
(start-stack (list (make-exception-with-message
#t (simple-format
(call-with-values #f
(lambda () "wrong number of values returned from handler, expecting 2, got ~A"
(handler request)) (length other)))
(match-lambda* handler)))))))))))))))
((response body)
(sanitize-response request response body))
(other
(raise-exception
(make-exception-with-irritants
(list (make-exception-with-message
(simple-format
#f
"wrong number of values returned from handler, expecting 2, got ~A"
(length other)))
handler)))))))))))))))
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(write-response-exception-handler exn request)) (write-response-exception-handler exn request))