Guard against errors in the initializer and destructor

In the worker threads.

1 files changed, 56 insertions, 3 deletions

diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm
index d532960..947697d 100644
--- a/guix-build-coordinator/utils/fibers.scm
+++ b/guix-build-coordinator/utils/fibers.scm
@@ -33,6 +33,58 @@
                                      (name "unnamed"))
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
 arguments of the worker thread procedure."
+
+  (define (initializer/safe)
+    (let ((args
+           (with-exception-handler
+               (lambda (exn)
+                 (simple-format
+                  (current-error-port)
+                  "exception running initializer in worker thread (~A): ~A:\n  ~A\n"
+                  name
+                  initializer
+                  exn)
+                 #f)
+             (lambda ()
+               (with-throw-handler #t
+                 initializer
+                 (lambda args
+                   (backtrace))))
+             #:unwind? #t)))
+
+      (if args
+          args
+          ;; never give up, just keep retrying
+          (begin
+            (sleep 5)
+            (initializer/safe)))))
+
+  (define (destructor/safe args)
+    (let ((success?
+           (with-exception-handler
+               (lambda (exn)
+                 (simple-format
+                  (current-error-port)
+                  "exception running destructor in worker thread (~A): ~A:\n  ~A\n"
+                  name
+                  initializer
+                  exn)
+                 #f)
+             (lambda ()
+               (with-throw-handler #t
+                 (lambda ()
+                   (apply destructor args)
+                   #t)
+                 (lambda _
+                   (backtrace))))
+             #:unwind? #t)))
+
+      (or success?
+          #t
+          (begin
+            (sleep 5)
+            (destructor/safe args)))))
+
   (let ((channel (make-channel)))
     (for-each
      (lambda (thread-index)
@@ -46,7 +98,7 @@ arguments of the worker thread procedure."
                 (number->string thread-index))))
             (const #t))
 
-          (let init ((args (initializer)))
+          (let init ((args (initializer/safe)))
             (parameterize ((%worker-thread-args args))
               (let loop ((current-lifetime lifetime))
                 (let ((exception?
@@ -109,8 +161,9 @@ arguments of the worker thread procedure."
                                     #f)))
                         (loop #f))))))
             (when destructor
-              (apply destructor args))
-            (init (initializer))))))
+              (destructor/safe args))
+
+            (init (initializer/safe))))))
      (iota parallelism))
     channel))