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
(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))))