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