web: server: Ignore all client disconnects.

EPIPE and ECONNRESET errors are already ignored when thrown by "sendfile" and
"put-bytevector" procedures. It turns out "peek-char" can also cause such
errors. So ignore such errors within the whole procedure.

* src/web/server/fiberized.scm (client-loop): Wrap the whole procedure inside
"with-ignored-disconnects" instead of wrapping individually "sendfile" and
"put-bytevector" calls.
This commit is contained in:
Mathieu Othacehe 2020-08-04 16:02:46 +02:00
parent d250a95c46
commit 0abf19203f
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 57 additions and 56 deletions

View File

@ -126,62 +126,63 @@ disconnection. Re-raise any other kind of exceptions."
;; ourselves.
(setsockopt client IPPROTO_TCP TCP_NODELAY 1)
(setvbuf client 'block 1024)
(with-throw-handler #t
(lambda ()
(let ((response-channel (make-channel)))
(let loop ()
(cond
((eof-object? (lookahead-u8 client))
(close-port client))
(else
(call-with-values
(lambda ()
(catch #t
(lambda ()
(let* ((request (read-request client))
(body (read-request-body request)))
(have-request response-channel request body)))
(lambda (key . args)
(display "While reading request:\n" (current-error-port))
(print-exception (current-error-port) #f key args)
(values (build-response #:version '(1 . 0) #:code 400
#:headers '((content-length . 0)))
#vu8()))))
(lambda (response body)
(match (assoc-ref (response-headers response) 'x-raw-file)
((? string? file)
(non-blocking
(call-with-input-file file
(lambda (input)
(let* ((size (stat:size (stat input)))
(response (write-response
(with-content-length response size)
client))
(output (response-port response)))
(setsockopt client SOL_SOCKET SO_SNDBUF
(* 128 1024))
(if (file-port? output)
(with-ignored-disconnects
(sendfile output input size))
(dump-port input output))
(close-port output)
(values))))))
(#f (begin
(write-response response client)
(when body
(with-ignored-disconnects
(put-bytevector client body)))
(force-output client))
(if (and (keep-alive? response)
(not (eof-object? (peek-char client))))
(loop)
(close-port client)))))))))))
(lambda (k . args)
(catch #t
(lambda () (close-port client))
(lambda (k . args)
(display "While closing port:\n" (current-error-port))
(print-exception (current-error-port) #f k args))))))
(with-ignored-disconnects
(with-throw-handler #t
(lambda ()
(let ((response-channel (make-channel)))
(let loop ()
(cond
((eof-object? (lookahead-u8 client))
(close-port client))
(else
(call-with-values
(lambda ()
(catch #t
(lambda ()
(let* ((request (read-request client))
(body (read-request-body request)))
(have-request response-channel request body)))
(lambda (key . args)
(display "While reading request:\n"
(current-error-port))
(print-exception (current-error-port) #f key args)
(values (build-response #:version '(1 . 0) #:code 400
#:headers
'((content-length . 0)))
#vu8()))))
(lambda (response body)
(match (assoc-ref (response-headers response) 'x-raw-file)
((? string? file)
(non-blocking
(call-with-input-file file
(lambda (input)
(let* ((size (stat:size (stat input)))
(response (write-response
(with-content-length response size)
client))
(output (response-port response)))
(setsockopt client SOL_SOCKET SO_SNDBUF
(* 128 1024))
(if (file-port? output)
(sendfile output input size)
(dump-port input output))
(close-port output)
(values))))))
(#f (begin
(write-response response client)
(when body
(put-bytevector client body))
(force-output client))
(if (and (keep-alive? response)
(not (eof-object? (peek-char client))))
(loop)
(close-port client)))))))))))
(lambda (k . args)
(catch #t
(lambda () (close-port client))
(lambda (k . args)
(display "While closing port:\n" (current-error-port))
(print-exception (current-error-port) #f k args)))))))
(define (socket-loop socket request-channel)
(define (have-request response-channel request body)