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

111
knots/web-server.scm
View file

@ -252,37 +252,32 @@ on the procedure being called at any particular time."
#:headers '((content-length . 0))) #:headers '((content-length . 0)))
#vu8())) #vu8()))
(else (else
(call-with-values (call-with-escape-continuation
(lambda () (lambda (return)
(call-with-escape-continuation (with-exception-handler
(lambda (return) (lambda (exn)
(with-exception-handler (call-with-values
(lambda (exn) (lambda ()
(call-with-values (exception-handler exn request))
(lambda () return))
(exception-handler exn request)) (lambda ()
return)) (start-stack
(lambda () #t
(start-stack #t (handler request))))))) (call-with-values
(match-lambda* (lambda ()
((response body) (handler request))
(sanitize-response request response body)) (match-lambda*
(other ((response body)
(let ((stack (make-stack #t)) (sanitize-response request response body))
(exception (other
(make-exception-with-irritants (raise-exception
(list (make-exception-with-message (make-exception-with-irritants
(simple-format (list (make-exception-with-message
#f (simple-format
"wrong number of values returned from handler, expecting 2, got ~A" #f
(length other))) "wrong number of values returned from handler, expecting 2, got ~A"
handler)))) (length other)))
(print-exception handler)))))))))))))))
(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,35 +341,31 @@ 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 (let loop ()
(lambda () (cond
(let loop () ((with-exception-handler
(cond (lambda _ #t)
((catch #t (lambda ()
(lambda () (or
(or (if (eq? #f connection-idle-timeout)
(if (eq? #f connection-idle-timeout) #f
#f (perform-operation
(perform-operation (choice-operation (wrap-operation
(choice-operation (wrap-operation (wait-until-port-readable-operation client)
(wait-until-port-readable-operation client) (const #f))
(const #f)) (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)))) (close-port client))
(lambda _ #t)) (else
(close-port client)) (let ((keep-alive? (handle-request handler client
(else read-request-exception-handler
(let ((keep-alive? (handle-request handler client write-response-exception-handler
read-request-exception-handler exception-handler)))
write-response-exception-handler (if keep-alive?
exception-handler))) (loop)
(if keep-alive? (close-port client)))))))
(loop)
(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)