Don't use with-exception-handler with (backtrace)

With with-exception-handler being called with #:unwind? #f (implicitly). This
breaks Guile internals used by (backtrace) [1], meaning you get a different
exception/backtrace when Guile itself breaks.

This should avoid the "string->number: Wrong type argument in position
1 (expecting string): #f" exception I've been haunted by for the last year.

1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=46009

1 files changed, 16 insertions, 21 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 8a5e990..338bab6 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -427,26 +427,21 @@ port. Also, the port used can be changed by passing the --port option.\n"
             (render-json
              `((error . ,(agent-error-details exn)))
              #:code 400)
-            (begin
-              (match method-and-path-components
-                ((method path-components ...)
-                 (simple-format
-                  (current-error-port)
-                  "error: when processing: /~A ~A\n  ~A"
-                  method (string-join path-components "/")
-                  exn)))
-              (render-json
-               `((error . ,(simple-format #f "~A" exn)))
-               #:code 500))))
+            (render-json
+             `((error . ,(simple-format #f "~A" exn)))
+             #:code 500)))
     (lambda ()
-      (with-exception-handler
-          (lambda (exn)
-            (catch #t
-              (lambda ()
-                (backtrace))
-              (lambda (key . args)
-                (simple-format (current-error-port)
-                               "error: guile crashed printing backtrace\n")))
-            (raise-exception exn))
-        controller-thunk))
+      (with-throw-handler #t
+        controller-thunk
+        (lambda (key . args)
+          (unless (and (eq? '%exception key)
+                       (agent-error? (car args)))
+            (match method-and-path-components
+              ((method path-components ...)
+               (simple-format
+                (current-error-port)
+                "error: when processing: /~A ~A\n  ~A ~A"
+                method (string-join path-components "/")
+                key args)))
+            (backtrace)))))
     #:unwind? #t))