Include the submit_outputs information in the agent status response

This means that agents will know whether to submit the outputs of builds, even
if they're restarted.

1 files changed, 43 insertions, 2 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 3c443f4..d7bc605 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -1287,11 +1287,52 @@
                    (submit_outputs . ,submit-outputs?)))
                builds)))))))
 
-(define (agent-details datastore agent-id)
+(define (agent-details build-coordinator agent-id)
+  (define datastore
+    (build-coordinator-datastore build-coordinator))
+
+  (define build-submit-outputs-hook
+    (assq-ref (build-coordinator-hooks build-coordinator)
+              'build-submit-outputs))
+
+  (define (submit-outputs? build)
+    (with-exception-handler
+        (lambda (exn)
+          (log-msg (build-coordinator-logger build-coordinator)
+                   'CRITICAL
+                   "build-submit-outputs hook raised exception: "
+                   exn))
+      (lambda ()
+        (with-throw-handler #t
+          (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))))
+          (lambda (key . args)
+            (backtrace))))
+      #:unwind? #t))
+
   (let ((agent (datastore-find-agent datastore agent-id))
         (allocated-builds (datastore-list-agent-builds datastore agent-id)))
+
     `(,@agent                           ; description
-      (builds . ,(list->vector allocated-builds)))))
+      (builds . ,(list->vector
+                  (map (lambda (build)
+                         `(,@build
+                           (submit_outputs . ,submit-outputs?)))
+                       allocated-builds))))))
 
 (define (build-data-location build-id )
   (string-append (%config 'builds-dir) "/"