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

Remove the web-server exception handler

Browse source 
This turned out not to be useful, since I wanted to handle exceptions
happening in the exception handler, so it didn't really help in the
end to allow customising it.
This commit is contained in:
Christopher Baines 2025-03-14 14:27:29 +00:00
parent da69fd19f3
commit e1858dfff5
2 changed files with 9 additions and 82 deletions
Download patch file Download diff file Expand all files Collapse all files

61
knots/web-server.scm
View file

@ -48,7 +48,6 @@
request-body-port/knots request-body-port/knots
read-request-body/knots read-request-body/knots
default-exception-handler
default-write-response-exception-handler default-write-response-exception-handler
web-server? web-server?
@ -310,7 +309,7 @@ on the procedure being called at any particular time."
;; Close the client port ;; Close the client port
#f) #f)
(define (default-exception-handler exn request) (define (exception-handler exn request)
(let* ((error-string (let* ((error-string
(call-with-output-string (call-with-output-string
(lambda (port) (lambda (port)
@ -332,8 +331,7 @@ on the procedure being called at any particular time."
(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)
exception-handler)
(let ((request (let ((request
(with-exception-handler (with-exception-handler
read-request-exception-handler read-request-exception-handler
@ -356,58 +354,14 @@ on the procedure being called at any particular time."
(lambda (return) (lambda (return)
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(with-exception-handler
(lambda (exn)
(call-with-values
(lambda ()
(default-exception-handler
(make-exception
exn
(make-exception-with-message
"exception in exception handler")
(make-exception-with-irritants
exception-handler))
request))
(match-lambda*
((response body)
(call-with-values
(lambda ()
(sanitize-response
request
response
body))
return)))))
(lambda ()
(call-with-values (call-with-values
(lambda () (lambda ()
(exception-handler exn request)) (exception-handler exn request))
(match-lambda* (lambda (response body)
((response body)
(call-with-values (call-with-values
(lambda () (lambda ()
(sanitize-response request response body)) (sanitize-response request response body))
return)) return))))
(other
(call-with-values
(lambda ()
(default-exception-handler
(make-exception-with-irritants
(list (make-exception-with-message
(simple-format
#f
"wrong number of values returned from exception handler, expecting 2, got ~A"
(length other)))
exception-handler))
request))
(match-lambda*
((response body)
(call-with-values
(lambda ()
(sanitize-response
request
response
body))
return))))))))))
(lambda () (lambda ()
(start-stack (start-stack
#t #t
@ -475,7 +429,6 @@ 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
read-request-exception-handler read-request-exception-handler
write-response-exception-handler write-response-exception-handler
connection-idle-timeout connection-idle-timeout
@ -517,8 +470,7 @@ on the procedure being called at any particular time."
(else (else
(let ((keep-alive? (handle-request handler client (let ((keep-alive? (handle-request handler client
read-request-exception-handler read-request-exception-handler
write-response-exception-handler write-response-exception-handler)))
exception-handler)))
(if keep-alive? (if keep-alive?
(loop) (loop)
(close-port client))))))) (close-port client)))))))
@ -537,8 +489,6 @@ 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)
(read-request-exception-handler (read-request-exception-handler
default-read-request-exception-handler) default-read-request-exception-handler)
(write-response-exception-handler (write-response-exception-handler
@ -577,7 +527,6 @@ 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
read-request-exception-handler read-request-exception-handler
write-response-exception-handler write-response-exception-handler
connection-idle-timeout connection-idle-timeout

22
tests/web-server.scm
View file

@ -52,28 +52,6 @@
uri uri
#:port (non-blocking-open-socket-for-uri uri))))))) #:port (non-blocking-open-socket-for-uri uri)))))))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
"Hello, World!")
#:port 0
#:exception-handler
(lambda (exn request)
"Error"))) ;; Bind to any port
(port
(web-server-port web-server))
(uri
(build-uri 'http #:host "127.0.0.1" #:port port)))
(assert-equal
500
(response-code
(http-get
uri
#:port (non-blocking-open-socket-for-uri uri)))))))
(run-fibers-for-tests (run-fibers-for-tests
(lambda () (lambda ()
(let* ((web-server (let* ((web-server