branch: main
commit 4da8cc5b69615058b5fdf6dc2579ce563d5904f1
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Mon Jan 6 17:22:34 2025 +0100
web: server: Exit when ‘accept’ throws.
* src/web/server/fiberized.scm (socket-loop): Catch 'system-error around
‘accept’.
---
src/web/server/fiberized.scm | 11 ++++++++++-
1 file changed, 10 insertions(+), 1 deletion(-)
diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm
index 8b53569..259121d 100644
--- a/src/web/server/fiberized.scm
+++ b/src/web/server/fiberized.scm
@@ -208,7 +208,16 @@ false otherwise."
(#(response body)
(values response body))))
(let loop ()
- (match (accept socket (logior SOCK_NONBLOCK SOCK_CLOEXEC))
+ (match (catch 'system-error
+ (lambda ()
+ (accept socket (logior SOCK_NONBLOCK SOCK_CLOEXEC)))
+ (lambda args
+ ;; This may be EMFILE or similar. At this point, little can be
+ ;; done so exit.
+ (let ((errno (system-error-errno args)))
+ (log-error "could not accept connection: ~a; exiting"
+ (strerror errno))
+ (primitive-exit 1))))
((client . sockaddr)
(spawn-fiber (lambda () (client-loop client have-request))
#:parallel? #t)
