Guard against logging failing

As I've seen this happening where there are errors writing to FD 1.

1 files changed, 19 insertions, 6 deletions

diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index e86b97b..d0be4e4 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -49,12 +49,25 @@
         #t)
       #f))
 
-(define (handler request body controller secret-key-base startup-completed
+(define (handler request finished?
+                 body controller secret-key-base startup-completed
                  render-metrics)
-  (display
-   (format #f "~a ~a\n"
-           (request-method request)
-           (uri-path (request-uri request))))
+  (with-exception-handler
+      (lambda (exn)
+        (with-exception-handler
+            (lambda _ #f)
+          (lambda ()
+            (simple-format (current-error-port)
+                           "exception when logging: ~A\n" exn))
+          #:unwind? #t)
+        ;; If we can't log, exit
+        (signal-condition! finished?))
+    (lambda ()
+      (display
+       (format #f "~a ~a\n"
+               (request-method request)
+               (uri-path (request-uri request)))))
+    #:unwind? #t)
   (apply values
          (let-values (((request-components mime-types)
                        (request->path-components-and-mime-type request)))
@@ -152,7 +165,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
                 (lambda ()
                   (run-server/patched
                    (lambda (request body)
-                     (handler request body controller
+                     (handler request finished? body controller
                               secret-key-base
                               startup-completed
                               render-metrics))