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

Tweak some web server exception handling

Browse source
This commit is contained in:
Christopher Baines 2025-02-07 10:54:59 +00:00
parent 19c1fe235b
commit b0bb65dbed
1 changed files with 51 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

29
knots/web-server.scm
View file

@ -252,8 +252,6 @@ on the procedure being called at any particular time."
#:headers '((content-length . 0))) #:headers '((content-length . 0)))
#vu8())) #vu8()))
(else (else
(call-with-values
(lambda ()
(call-with-escape-continuation (call-with-escape-continuation
(lambda (return) (lambda (return)
(with-exception-handler (with-exception-handler
@ -263,26 +261,23 @@ on the procedure being called at any particular time."
(exception-handler exn request)) (exception-handler exn request))
return)) return))
(lambda () (lambda ()
(start-stack #t (handler request))))))) (start-stack
#t
(call-with-values
(lambda ()
(handler request))
(match-lambda* (match-lambda*
((response body) ((response body)
(sanitize-response request response body)) (sanitize-response request response body))
(other (other
(let ((stack (make-stack #t)) (raise-exception
(exception
(make-exception-with-irritants (make-exception-with-irritants
(list (make-exception-with-message (list (make-exception-with-message
(simple-format (simple-format
#f #f
"wrong number of values returned from handler, expecting 2, got ~A" "wrong number of values returned from handler, expecting 2, got ~A"
(length other))) (length other)))
handler)))) handler)))))))))))))))
(print-exception
(current-error-port)
(stack-ref stack 2)
'%exception
(list exception))
(raise-exception exception)))))))))
(with-exception-handler (with-exception-handler
(lambda (exn) (lambda (exn)
(write-response-exception-handler exn request)) (write-response-exception-handler exn request))
@ -346,11 +341,10 @@ on the procedure being called at any particular time."
;; out. ;; out.
(setvbuf client 'block buffer-size) (setvbuf client 'block buffer-size)
(setsockopt client IPPROTO_TCP TCP_NODELAY 1) (setsockopt client IPPROTO_TCP TCP_NODELAY 1)
(with-throw-handler #t
(lambda ()
(let loop () (let loop ()
(cond (cond
((catch #t ((with-exception-handler
(lambda _ #t)
(lambda () (lambda ()
(or (or
(if (eq? #f connection-idle-timeout) (if (eq? #f connection-idle-timeout)
@ -362,8 +356,7 @@ on the procedure being called at any particular time."
(wrap-operation (wrap-operation
(sleep-operation connection-idle-timeout) (sleep-operation connection-idle-timeout)
(const #t))))) (const #t)))))
(eof-object? (lookahead-u8 client)))) (eof-object? (lookahead-u8 client)))))
(lambda _ #t))
(close-port client)) (close-port client))
(else (else
(let ((keep-alive? (handle-request handler client (let ((keep-alive? (handle-request handler client
@ -373,8 +366,6 @@ on the procedure being called at any particular time."
(if keep-alive? (if keep-alive?
(loop) (loop)
(close-port client))))))) (close-port client)))))))
(lambda (k . args)
(close-port client))))
(define-record-type <web-server> (define-record-type <web-server>
(make-web-server socket port) (make-web-server socket port)