Tweak how the exception handling and logging works for hooks

Since the errors don't seem to be getting logged properly, the backtrace
output stops part way.

1 files changed, 11 insertions, 10 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index a79ca40..dda6b24 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -992,8 +992,11 @@
      #:labels '(event)))
 
   (define (process-event id event arguments handler)
-    (catch
-      #t
+    (with-exception-handler
+        (lambda (exn)
+          (metric-increment failure-counter-metric
+                            #:label-values
+                            `((event . ,event))))
       (lambda ()
         (log-msg (build-coordinator-logger build-coordinator)
                  'DEBUG
@@ -1007,7 +1010,11 @@
                (apply handler build-coordinator arguments))
              #:labels '(event)
              #:label-values `((event . ,event))))
-          (lambda _
+          (lambda args
+            (apply log-msg (build-coordinator-logger build-coordinator)
+                   'ERROR
+                   "error running " event " hook: "
+                   args)
             (backtrace)))
         (log-msg (build-coordinator-logger build-coordinator)
                  'DEBUG
@@ -1025,13 +1032,7 @@
         (metric-increment success-counter-metric
                           #:label-values
                           `((event . ,event))))
-      (lambda (key . args)
-        (log-msg (build-coordinator-logger build-coordinator)
-                 'ERROR
-                 "error running " event " hook: " key " " args)
-        (metric-increment failure-counter-metric
-                          #:label-values
-                          `((event . ,event))))))
+      #:unwind? #t))
 
   (define (single-thread-process-events mtx condvar event-name handler)
     (call-with-new-thread