diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-04 16:02:46 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-04 16:05:56 +0200 |
commit | 0abf19203febf61c073280f7531cbeba15a458a5 (patch) | |
tree | db75857594bc86304e6740e4247ba2d75cb507f7 /src | |
parent | d250a95c4685d933ed23a8548054a96f6a3d3ff2 (diff) | |
download | cuirass-0abf19203febf61c073280f7531cbeba15a458a5.tar cuirass-0abf19203febf61c073280f7531cbeba15a458a5.tar.gz |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/web/server/fiberized.scm | 113 |
1 files changed, 57 insertions, 56 deletions
diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm index 654636b..5df1d58 100644 --- a/src/web/server/fiberized.scm +++ b/src/web/server/fiberized.scm @@ -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) |