From a6c96aa1daf879b089c5eb505c1858fd2e32830f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 3 Mar 2025 10:56:36 +0000
Subject: [PATCH] Better handle the web server exception handler not returning
 2 values

---
 knots/web-server.scm | 28 +++++++++++++++++++++++++++-
 tests/web-server.scm | 41 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 68 insertions(+), 1 deletion(-)

diff --git a/knots/web-server.scm b/knots/web-server.scm
index 0ba8fd8..4ab59e3 100644
--- a/knots/web-server.scm
+++ b/knots/web-server.scm
@@ -273,7 +273,33 @@ on the procedure being called at any particular time."
                       (call-with-values
                           (lambda ()
                             (exception-handler exn request))
-                        return))
+                        (match-lambda*
+                          ((response body)
+                           (call-with-values
+                               (lambda ()
+                                 (sanitize-response request response body))
+                             return))
+                          (other
+                           (call-with-values
+                               (lambda ()
+                                 (default-exception-handler
+                                   (make-exception-with-irritants
+                                    (list (make-exception-with-message
+                                           (simple-format
+                                            #f
+                                            "wrong number of values returned from exception handler, expecting 2, got ~A"
+                                            (length other)))
+                                          exception-handler))
+                                   request))
+                             (match-lambda*
+                               ((response body)
+                                (call-with-values
+                                    (lambda ()
+                                      (sanitize-response
+                                       request
+                                       response
+                                       body))
+                                  return))))))))
                   (lambda ()
                     (start-stack
                      #t
diff --git a/tests/web-server.scm b/tests/web-server.scm
index 74f81ea..205d6a2 100644
--- a/tests/web-server.scm
+++ b/tests/web-server.scm
@@ -33,6 +33,47 @@
         uri
         #:port (non-blocking-open-socket-for-uri uri)))))))
 
+(run-fibers-for-tests
+ (lambda ()
+   (let* ((web-server
+           (run-knots-web-server
+            (lambda (request)
+              "Hello, World!")
+            #:port 0)) ;; Bind to any port
+          (port
+           (web-server-port web-server))
+          (uri
+           (build-uri 'http #:host "127.0.0.1" #:port port)))
+
+     (assert-equal
+      500
+      (response-code
+       (http-get
+        uri
+        #:port (non-blocking-open-socket-for-uri uri)))))))
+
+(run-fibers-for-tests
+ (lambda ()
+   (let* ((web-server
+           (run-knots-web-server
+            (lambda (request)
+              "Hello, World!")
+            #:port 0
+            #:exception-handler
+            (lambda (exn request)
+              "Error"))) ;; Bind to any port
+          (port
+           (web-server-port web-server))
+          (uri
+           (build-uri 'http #:host "127.0.0.1" #:port port)))
+
+     (assert-equal
+      500
+      (response-code
+       (http-get
+        uri
+        #:port (non-blocking-open-socket-for-uri uri)))))))
+
 (run-fibers-for-tests
  (lambda ()
    (let* ((web-server