From 1dbd1b592ef03ae2ae79aa64417c3ffee92e63ac Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 31 Jul 2020 10:52:38 +0200 Subject: web: Ignore errors within put-bytevector. * src/web/server/fiberized.scm (with-ignored-disconnects): New macro factorizing the catch clause ignoring client disconnection related errors. Use it for both "sendfiles" and "put-bytevector" procedures. --- src/web/server/fiberized.scm | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm index d4674b8..654636b 100644 --- a/src/web/server/fiberized.scm +++ b/src/web/server/fiberized.scm @@ -110,6 +110,17 @@ (alist-cons 'content-length length (strip-headers response)))) +(define-syntax-rule (with-ignored-disconnects exp ...) + "Run EXP and ignore silently any exceptions caused by a premature client +disconnection. Re-raise any other kind of exceptions." + (catch 'system-error + (lambda () + exp ...) + (lambda args + (unless (memv (system-error-errno args) + (list EPIPE ECONNRESET)) + (apply throw args))))) + (define (client-loop client have-request) ;; Always disable Nagle's algorithm, as we handle buffering ;; ourselves. @@ -150,20 +161,16 @@ (setsockopt client SOL_SOCKET SO_SNDBUF (* 128 1024)) (if (file-port? output) - (catch 'system-error - (lambda () - (sendfile output input size)) - (lambda args - (unless (memv (system-error-errno args) - (list EPIPE ECONNRESET)) - (apply throw args)))) + (with-ignored-disconnects + (sendfile output input size)) (dump-port input output)) (close-port output) (values)))))) (#f (begin (write-response response client) (when body - (put-bytevector client body)) + (with-ignored-disconnects + (put-bytevector client body))) (force-output client)) (if (and (keep-alive? response) (not (eof-object? (peek-char client)))) -- cgit v1.2.3