From ca3d5a17810c8f6e30e182c60dd31328ee38941d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 19 Feb 2025 12:44:47 +0000
Subject: [PATCH] Fix handling of client-loop exceptions

Maybe other things can go wrong here, so log so that there's some
information available.
---
 knots/web-server.scm | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/knots/web-server.scm b/knots/web-server.scm
index 2482a79..ab16b80 100644
--- a/knots/web-server.scm
+++ b/knots/web-server.scm
@@ -338,7 +338,18 @@ on the procedure being called at any particular time."
   (let loop ()
     (cond
      ((with-exception-handler
-          (lambda _ #t)
+          (lambda (exn)
+            (unless (and (exception-with-origin? exn)
+                         (string=? (exception-origin exn)
+                                   "fport_write"))
+              (display "knots web-server, exception in client loop:\n"
+                       (current-error-port))
+              (print-exception
+               (current-error-port)
+               #f
+               '%exception
+               (list exn)))
+            #t)
         (lambda ()
           (or
            (if (eq? #f connection-idle-timeout)
@@ -350,7 +361,8 @@ on the procedure being called at any particular time."
                                   (wrap-operation
                                    (sleep-operation connection-idle-timeout)
                                    (const #t)))))
-           (eof-object? (lookahead-u8 client)))))
+           (eof-object? (lookahead-u8 client))))
+        #:unwind? #t)
       (close-port client))
      (else
       (let ((keep-alive? (handle-request handler client