From 55dd6a8483a0211361d9bfbfbefa3a41ecc4e1f4 Mon Sep 17 00:00:00 2001
From: Puck Meerburg <puck@puckipedia.com>
Date: Sun, 11 May 2025 22:21:07 +0000
Subject: [PATCH] (zilch magic): handle errors properly in CA builds

This properly stops the rest of the builders, instead of causing a
deadlock.
---
 core/src/magic.sld | 39 ++++++++++++++++++++++++++++++---------
 1 file changed, 30 insertions(+), 9 deletions(-)

diff --git a/core/src/magic.sld b/core/src/magic.sld
index bd39c97..c26d4af 100644
--- a/core/src/magic.sld
+++ b/core/src/magic.sld
@@ -369,7 +369,8 @@
       (unless pending
         (set! pending (make-pending-item drv #f '() 0 '()))
         (mutex-lock! pending-mutex)
-        (set! pending-count (+ pending-count 1))
+        (unless (eq? pending-count 'error)
+          (set! pending-count (+ pending-count 1)))
         (set! ca-to-pending-map (mapping-set! ca-to-pending-map (derivation-path drv) pending))
         (mutex-unlock! pending-mutex)
         (handle-new-drv pending))
@@ -427,13 +428,14 @@
 
        ; Notify our dependencies that we're done.
        (mutex-lock! pending-mutex)
-       (set! pending-count (- pending-count 1))
+       (unless (eq? pending-count 'error)
+         (set! pending-count (- pending-count 1)))
        (mutex-unlock! pending-mutex)
        (set-pending-item-awaiting-count! item 'built)
        (for-each (lambda (depends-on) (set-pending-item-awaiting-count! depends-on (- (pending-item-awaiting-count depends-on) 1)) (wake-up depends-on)) (pending-item-awaited-by item)))
 
      (define root-pend (get-item input-drv))
-     (define (builder conn)
+     (define (builder quit conn)
        (mutex-lock! build-mutex)
        (define item #f)
        (when (pair? to-build)
@@ -442,13 +444,26 @@
        (define local-pending-count #f)
        (if item
          ; If we got an item: unlock the build mutex and build it
-         (begin (mutex-unlock! build-mutex) (do-build conn item) (builder conn))
+         (begin
+          (mutex-unlock! build-mutex)
+          (with-exception-handler
+           (lambda (e)
+            (mutex-lock! pending-mutex)
+            (set! pending-count 'error)
+            (mutex-unlock! pending-mutex)
+            (condition-variable-broadcast! build-condvar)
+            (when (error-object? e)
+              (fprintf (current-error-port) "~S ~A" (thread-name (current-thread)) (error-object-message e)))
+            (quit))
+           (lambda ()
+            (do-build conn item)))
+          (builder quit conn))
          (begin
            ; Check how many pending items there are..
            (mutex-lock! pending-mutex)
            (set! local-pending-count pending-count)
            (mutex-unlock! pending-mutex)
-           (if (= local-pending-count 0)
+           (if (or (eq? local-pending-count 0) (eq? local-pending-count 'error))
              ; We're out of pending items, unlock the mutex and drop the thread
              (begin
               (mutex-unlock! build-mutex)
@@ -458,13 +473,19 @@
              ; We still have pending items, let's go back and wait.
              (begin
               (mutex-unlock! build-mutex build-condvar)
-              (builder conn))))))
+              (builder quit conn))))))
 
-     (define builder-threads (list))
+     (define builder-threads '())
      (do ((i 0 (+ i 1))) ((>= i 16) #f)
-       (set! builder-threads (cons (thread-start! (make-thread (lambda () (builder (daemon-connect))) (string-append "ca-builder-" (number->string i)))) builder-threads)))
+       (set! builder-threads
+        (cons
+         (thread-start!
+           (make-thread
+            (lambda () (call/cc (lambda (cc) (builder cc (daemon-connect)))))
+            (string-append "ca-builder-" (number->string i))))
+         builder-threads)))
 
-     (for-each thread-join! builder-threads)
+     (for-each (lambda (t) (thread-join! t)) builder-threads)
      root-pend)
    (define (drv-resolve-ca drv outputs)
      (if (drv-is-ca drv)