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

Don't wait indefinitely for new requests in the web server

Browse source 
Inspired by the similar changes in Cuirass.
This commit is contained in:
Christopher Baines 2025-01-23 19:49:08 +01:00
parent d2ee45581b
commit 8805265243
1 changed files with 22 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

27
knots/web-server.scm
View file

@ -19,6 +19,8 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-71)
#:use-module (fibers)
#:use-module (fibers timers)
#:use-module (fibers operations)
#:use-module (fibers conditions)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
@ -31,6 +33,7 @@
#:use-module (web http)
#:use-module (web request)
#:use-module (web response)
#:use-module (knots timeout)
#:use-module (knots non-blocking)
#:export (run-knots-web-server
@ -290,8 +293,9 @@ on the procedure being called at any particular time."
#f)))
#:unwind? #t))))
(define (client-loop client handler
write-response-exception-handler)
(define* (client-loop client handler
write-response-exception-handler
connection-idle-timeout)
;; Always disable Nagle's algorithm, as we handle buffering
;; ourselves; when we force-output, we really want the data to go
;; out.
@ -302,7 +306,18 @@ on the procedure being called at any particular time."
(let loop ()
(cond
((catch #t
(lambda () (eof-object? (lookahead-u8 client)))
(lambda ()
(or
(if (eq? #f connection-idle-timeout)
#f
(perform-operation
(choice-operation (wrap-operation
(wait-until-port-readable-operation client)
(const #f))
(wrap-operation
(sleep-operation connection-idle-timeout)
(const #t)))))
(eof-object? (lookahead-u8 client))))
(lambda _ #t))
(close-port client))
(else
@ -329,7 +344,8 @@ on the procedure being called at any particular time."
(port 8080)
(socket (make-default-socket family addr port))
(write-response-exception-handler
default-write-response-exception-handler))
default-write-response-exception-handler)
(connection-idle-timeout 60))
"Run the fibers web server.
HANDLER should be a procedure that takes one argument, the HTTP
@ -362,7 +378,8 @@ before sending back to the client."
((client . sockaddr)
(spawn-fiber (lambda ()
(client-loop client handler
write-response-exception-handler))
write-response-exception-handler
connection-idle-timeout))
#:parallel? #t)
(loop))))))