diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2020-07-31 10:52:38 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-07-31 10:52:38 +0200 |
| commit | 1dbd1b592ef03ae2ae79aa64417c3ffee92e63ac (patch) | |
| tree | 24d5ffddba11d66752a66d6841521f6aae3868bc /src | |
| parent | a24bed0b1f1c6852253b4b0b699ad8bfaf432f6c (diff) | |
| download | cuirass-1dbd1b592ef03ae2ae79aa64417c3ffee92e63ac.tar cuirass-1dbd1b592ef03ae2ae79aa64417c3ffee92e63ac.tar.gz | |
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.
Diffstat (limited to 'src')
| -rw-r--r-- | src/web/server/fiberized.scm | 23 |
1 files changed, 15 insertions, 8 deletions
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)))) |