guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

web: Ignore errors within put-bytevector.

Browse source 
* 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.
This commit is contained in:
Mathieu Othacehe 2020-07-31 10:52:38 +02:00
parent a24bed0b1f
commit 1dbd1b592e
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
src/web/server/fiberized.scm
View file

@ -110,6 +110,17 @@
(alist-cons 'content-length length (alist-cons 'content-length length
(strip-headers response)))) (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) (define (client-loop client have-request)
;; Always disable Nagle's algorithm, as we handle buffering ;; Always disable Nagle's algorithm, as we handle buffering
;; ourselves. ;; ourselves.
@ -150,20 +161,16 @@
(setsockopt client SOL_SOCKET SO_SNDBUF (setsockopt client SOL_SOCKET SO_SNDBUF
(* 128 1024)) (* 128 1024))
(if (file-port? output) (if (file-port? output)
(catch 'system-error (with-ignored-disconnects
(lambda () (sendfile output input size))
(sendfile output input size))
(lambda args
(unless (memv (system-error-errno args)
(list EPIPE ECONNRESET))
(apply throw args))))
(dump-port input output)) (dump-port input output))
(close-port output) (close-port output)
(values)))))) (values))))))
(#f (begin (#f (begin
(write-response response client) (write-response response client)
(when body (when body
(put-bytevector client body)) (with-ignored-disconnects
(put-bytevector client body)))
(force-output client)) (force-output client))
(if (and (keep-alive? response) (if (and (keep-alive? response)
(not (eof-object? (peek-char client)))) (not (eof-object? (peek-char client))))