branch master updated: web: server: Remove with-ignored-disconnects.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 1bcccba  web: server: Remove with-ignored-disconnects.
1bcccba is described below

commit 1bcccbab768587d80385a998bb3e450e2fdc2226
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Aug 4 18:14:51 2020 +0200

    web: server: Remove with-ignored-disconnects.
    
    Use the pre-unwind-handler of a catch clause instead of nesting
    with-throw-handler inside a catch clause.
    
    * src/web/server/fiberized.scm (with-ignored-disconnects): Remove it,
    (client-loop): replace "with-ignored-disconnects" with a catch clause.
---
 src/web/server/fiberized.scm | 129 ++++++++++++++++++++-----------------------
 1 file changed, 61 insertions(+), 68 deletions(-)

diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm
index 5df1d58..23a2bd9 100644
--- a/src/web/server/fiberized.scm
+++ b/src/web/server/fiberized.scm
@@ -110,79 +110,72 @@
              (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.
   (setsockopt client IPPROTO_TCP TCP_NODELAY 1)
   (setvbuf client 'block 1024)
-  (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)))))))
+  (catch #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 args
+      ;; Ignore premature client disconnections.
+      (unless (memv (system-error-errno args)
+                    (list EPIPE ECONNRESET))
+        (apply throw args)))
+    (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)