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