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