Use print-backtrace-and-exception/knots

3 files changed, 35 insertions, 67 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index ca1f11b..fa227da 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -46,6 +46,7 @@
   #:use-module (fibers timers)
   #:use-module (fibers channels)
   #:use-module (fibers operations)
+  #:use-module (knots)
   #:use-module (knots timeout)
   #:use-module (knots web-server)
   #:use-module (knots thread-pool)
@@ -1024,21 +1025,11 @@ INTERVAL (a time-duration object), otherwise does nothing and returns #f."
               ((method path-components ...)
                (simple-format
                 (current-error-port)
-                "error: when processing: /~A ~A\n  ~A\n"
-                method (string-join path-components "/")
-                exn)))
-
-            (let* ((stack (make-stack #t 4))
-                   (backtrace
-                    (call-with-output-string
-                      (lambda (port)
-                        (display "\nBacktrace:\n" port)
-                        (display-backtrace stack port)
-                        (newline port)
-                        (newline port)))))
-              (display
-               backtrace
-               (current-error-port))))
+                "error: when processing: /~A ~A\n"
+                method (string-join path-components "/"))))
+
+            (print-backtrace-and-exception/knots exn))
+
           (raise-exception exn))
         controller-thunk))
     #:unwind? #t))
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 8cea955..6ec6578 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -32,6 +32,7 @@
   #:use-module (json)
   #:use-module (logging logger)
   #:use-module (gcrypt random)
+  #:use-module (knots)
   #:use-module (knots timeout)
   #:use-module (knots web-server)
   #:use-module (knots thread-pool)
@@ -543,7 +544,7 @@
                            (lambda ()
                              (with-exception-handler
                                  (lambda (exn)
-                                   (backtrace)
+                                   (print-backtrace-and-exception/knots exn)
                                    (raise-exception exn))
                                (lambda ()
                                  (let ((result
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 8bb487e..93ce230 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -225,7 +225,7 @@
                                  (string=? (exception-origin exn)
                                            "fport_write"))
                                 #f
-                                (backtrace))
+                                (print-backtrace-and-exception/knots exn))
                             (raise-exception exn))
                         (lambda ()
                           (match (atomic-box-ref
@@ -1208,10 +1208,6 @@
          (lambda ()
            (with-exception-handler
                (lambda (exn)
-                 (simple-format
-                  (current-error-port)
-                  "build-allocator-thread: exception: ~A\n"
-                  exn)
                  (metric-increment failure-counter-metric)
                  (atomic-box-set! allocation-needed #t))
              (lambda ()
@@ -1219,9 +1215,8 @@
                    (lambda (exn)
                      (simple-format
                       (current-error-port)
-                      "error in build allocator thread: ~A\n"
-                      exn)
-                     (backtrace)
+                      "error in build allocator thread\n")
+                     (print-backtrace-and-exception/knots exn)
                      (raise-exception exn))
                  (lambda ()
                    (update-build-allocation-plan build-coordinator)
@@ -1273,14 +1268,13 @@
    (lambda ()
      (while #t
        (with-exception-handler
-           (lambda (exn)
-             (simple-format (current-error-port)
-                            "exception in allocation plan fiber: ~A\n"
-                            exn))
+           (lambda _ #f)
          (lambda ()
            (with-exception-handler
                (lambda (exn)
-                 (backtrace)
+                 (simple-format (current-error-port)
+                                "exception in allocation plan fiber\n")
+                 (print-backtrace-and-exception/knots exn)
                  (raise-exception exn))
              (lambda ()
                (match (get-message (build-coordinator-allocator-channel coordinator))
@@ -1617,19 +1611,6 @@
             (while #t
               (with-exception-handler
                   (lambda (exn)
-                    (with-exception-handler
-                        (lambda _
-                          ;; Things are really going wrong if logging about
-                          ;; the hook processing thread crashing, also raises
-                          ;; an exception, so just try and sleep and hope
-                          ;; things go better next time
-                          (sleep 10))
-                      (lambda ()
-                        (log-msg (build-coordinator-logger build-coordinator)
-                                 'CRITICAL
-                                 "hook processing thread " event-name
-                                 " exception: " exn))
-                      #:unwind? #t)
                     (sleep 10))
                 (lambda ()
                   (with-exception-handler
@@ -1637,8 +1618,8 @@
                         (log-msg
                          (build-coordinator-logger build-coordinator)
                          'CRITICAL
-                         "error in " event-name " hook processing thread: " exn)
-                        (backtrace)
+                         "error in " event-name " hook processing thread")
+                        (print-backtrace-and-exception/knots exn)
                         (raise-exception exn))
                     (lambda ()
                       (while #t
@@ -1826,30 +1807,25 @@
         (lambda (exn)
           (log-msg (build-coordinator-logger build-coordinator)
                    'CRITICAL
-                   "build-submit-outputs hook raised exception: "
-                   exn))
+                   "build-submit-outputs hook raised exception")
+          (print-backtrace-and-exception/knots exn)
+          (raise-exception exn))
       (lambda ()
-        (with-exception-handler
-            (lambda (exn)
-              (backtrace)
-              (raise-exception exn))
-          (lambda ()
-            (let ((hook-result
-                   (call-with-delay-logging
-                    (lambda ()
-                      (build-submit-outputs-hook
-                       build-coordinator
-                       (assq-ref build 'uuid))))))
-              (if (boolean? hook-result)
-                  hook-result
-                  (begin
-                    (log-msg
-                     (build-coordinator-logger build-coordinator)
-                     'CRITICAL
-                     "build-submit-outputs hook returned non boolean: "
-                     hook-result)
-                    #t))))))
-      #:unwind? #t))
+        (let ((hook-result
+               (call-with-delay-logging
+                (lambda ()
+                  (build-submit-outputs-hook
+                   build-coordinator
+                   (assq-ref build 'uuid))))))
+          (if (boolean? hook-result)
+              hook-result
+              (begin
+                (log-msg
+                 (build-coordinator-logger build-coordinator)
+                 'CRITICAL
+                 "build-submit-outputs hook returned non boolean: "
+                 hook-result)
+                #t))))))
 
   (call-with-duration-metric
    (build-coordinator-metrics-registry build-coordinator)