[no subject]

[Ludovic Courtès]

branch: main
commit a909fa99340db5e5cd64612ea4e07e929dc643ad
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jul 6 17:11:41 2024 +0200

    remote-worker: Send ‘build-rejected’ message when build cannot be performed.
    
    Previously, starting from commit
    2365ba786c805477fcbae6eaeb358b0dd0501598, ‘cuirass remote-worker’ would
    silently ignore builds whose derivation could not be substituted.  As a
    result, the corresponding build would remain in ‘submitted’ status
    indefinitely.  This change fixes it.
    
    * src/cuirass/remote.scm (build-rejected-message): New procedure.
    * src/cuirass/scripts/remote-server.scm (serve-build-requests): Handle
    ‘build-rejected’ messages.
    * src/cuirass/scripts/remote-worker.scm (run-build): Send
    ‘build-rejected-message’ when ‘ensure-path/retry’ returns #f.
---
 src/cuirass/remote.scm                |  5 +++++
 src/cuirass/scripts/remote-server.scm | 17 +++++++++++++++++
 src/cuirass/scripts/remote-worker.scm |  4 +++-
 3 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 6f6a4d4..aaa44f7 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -78,6 +78,7 @@
             build-request-message
             no-build-message
             build-started-message
+            build-rejected-message
             build-failed-message
             build-succeeded-message
             worker-ping
@@ -531,6 +532,10 @@ parts."
   "Return a message that indicates that the build of DRV has started."
   `(build-started (drv ,drv) (worker ,worker)))
 
+(define (build-rejected-message drv worker)
+  "Return a message that indicates that the build of DRV has started."
+  `(build-rejected (drv ,drv) (worker ,worker)))
+
 (define* (build-failed-message drv url #:optional log)
   "Return a message that indicates that the build of DRV has failed."
   `(build-failed (drv ,drv) (url ,url) (log ,log)))
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index f9a7fb4..35203cd 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -515,6 +515,23 @@ FETCH-WORKER to download the build's output(s)."
                (db-update-build-worker! drv name)
                (db-update-build-status! drv (build-status started)
                                         #:log-file log-file)))
+            (`(build-rejected (drv ,drv) (worker ,name))
+             ;; Worker rejected the build, which might be either because the
+             ;; derivation is unavailable or because of a transient error.  In
+             ;; the latter case, reschedule it; in the former case, cancel it.
+             ;;
+             ;; XXX: 'file-exists?' is not accurate because DRV might be
+             ;; substitutable without being in the store, but it's a good
+             ;; cheap approximation.
+             (if (file-exists? drv)
+                 (begin
+                   (log-warning "~a: build rejected: ~a; rescheduling"
+                                name drv)
+                   (db-update-build-status! drv (build-status scheduled)))
+                 (begin
+                   (log-warning "~a: build rejected: ~a; canceling"
+                                name drv)
+                   (db-update-build-status! drv (build-status canceled)))))
             (_
              (log-warning "ignoring unrecognized message: ~s" command)))))
 
diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index 848ce65..7abcb06 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -269,7 +269,9 @@ still be substituted."
                           name drv)
                 (register-gc-roots drv)
                 (reply (build-succeeded-message drv local-publish-url)))))
-          (log-error "~a cannot be fetched; not building it" drv)))))
+          (begin
+            (log-error "~a cannot be fetched; not building it" drv)
+            (reply (build-rejected-message drv name)))))))
 
 (define* (run-command command server
                       #:key