cbaines/guile-knots
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow customising the web server read request exception handler

Browse source
This commit is contained in:
Christopher Baines 2025-02-07 10:48:50 +00:00
parent 025449ea0d
commit 19c1fe235b
1 changed files with 19 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

24
knots/web-server.scm
View file

@ -195,6 +195,16 @@ on the procedure being called at any particular time."
((0) (memq 'keep-alive (response-connection response)))))
(else #f)))))
(define (default-read-request-exception-handler exn)
(display "While reading request:\n" (current-error-port))
(print-exception
(current-error-port)
#f
'%exception
(list exn))
#f)
(define (default-write-response-exception-handler exn request)
(simple-format
(current-error-port)
@ -224,16 +234,15 @@ on the procedure being called at any particular time."
"internal server error")))
(define (handle-request handler client
read-request-exception-handler
write-response-exception-handler
exception-handler)
(let ((request
(catch #t
(with-exception-handler
read-request-exception-handler
(lambda ()
(read-request client))
(lambda (key . args)
(display "While reading request:\n" (current-error-port))
(print-exception (current-error-port) #f key args)
#f))))
#:unwind? #t)))
(let ((response
body
(cond
@ -328,6 +337,7 @@ on the procedure being called at any particular time."
(define* (client-loop client handler
exception-handler
read-request-exception-handler
write-response-exception-handler
connection-idle-timeout
buffer-size)
@ -357,6 +367,7 @@ on the procedure being called at any particular time."
(close-port client))
(else
(let ((keep-alive? (handle-request handler client
read-request-exception-handler
write-response-exception-handler
exception-handler)))
(if keep-alive?
@ -381,6 +392,8 @@ on the procedure being called at any particular time."
(socket (make-default-socket family addr port))
(exception-handler
default-exception-handler)
(read-request-exception-handler
default-read-request-exception-handler)
(write-response-exception-handler
default-write-response-exception-handler)
(connection-idle-timeout 60)
@ -418,6 +431,7 @@ before sending back to the client."
(spawn-fiber (lambda ()
(client-loop client handler
exception-handler
read-request-exception-handler
write-response-exception-handler
connection-idle-timeout
connection-buffer-size))