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

Make the web server exception handler configurable

Browse source
This commit is contained in:
Christopher Baines 2025-01-23 19:54:50 +01:00
parent 8805265243
commit 675d8c3258
1 changed files with 15 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

22
knots/web-server.scm
View file

@ -166,8 +166,15 @@ on the procedure being called at any particular time."
;; Close the client port
#f)
(define (default-exception-handler exn)
(values (build-response #:code 500)
;; TODO Make this configurable
(string->utf8
"internal server error")))
(define (handle-request handler client
write-response-exception-handler)
write-response-exception-handler
exception-handler)
(let ((request
(catch #t
(lambda ()
@ -186,11 +193,7 @@ on the procedure being called at any particular time."
#vu8()))
(else
(with-exception-handler
(lambda (exn)
(values (build-response #:code 500)
;; TODO Make this configurable
(string->utf8
"internal server error")))
exception-handler
(lambda ()
(call-with-values (lambda ()
(with-stack-and-prompt
@ -294,6 +297,7 @@ on the procedure being called at any particular time."
#:unwind? #t))))
(define* (client-loop client handler
exception-handler
write-response-exception-handler
connection-idle-timeout)
;; Always disable Nagle's algorithm, as we handle buffering
@ -322,7 +326,8 @@ on the procedure being called at any particular time."
(close-port client))
(else
(let ((keep-alive? (handle-request handler client
write-response-exception-handler)))
write-response-exception-handler
exception-handler)))
(if keep-alive?
(loop)
(close-port client)))))))
@ -343,6 +348,8 @@ on the procedure being called at any particular time."
INADDR_LOOPBACK))
(port 8080)
(socket (make-default-socket family addr port))
(exception-handler
default-exception-handler)
(write-response-exception-handler
default-write-response-exception-handler)
(connection-idle-timeout 60))
@ -378,6 +385,7 @@ before sending back to the client."
((client . sockaddr)
(spawn-fiber (lambda ()
(client-loop client handler
exception-handler
write-response-exception-handler
connection-idle-timeout))
#:parallel? #t)