1 files changed, 97 insertions, 30 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 747c6b1..4951ba6 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -269,35 +269,102 @@
 
 (define (post-build-success uuid coordinator-uri password
                             build-id derivation end-time)
+  (define output-details
+    (map
+     (match-lambda
+       ((output-name . output)
+        (let ((path-info (with-store store
+                           (query-path-info
+                            store
+                            (derivation-output-path output)))))
+          `((name       . ,output-name)
+            (hash       . ,(bytevector->nix-base32-string
+                            (path-info-hash path-info)))
+            (size       . ,(path-info-nar-size path-info))
+            (references . ,(list->vector
+                            (map basename
+                                 (path-info-references path-info))))))))
+
+     (derivation-outputs (read-derivation-from-file derivation))))
+
+  (define (attempt-submit-build-result)
+    (with-exception-handler
+      (lambda (exn)
+        (unless (agent-error-from-coordinator? exn)
+          (raise-exception exn))
+
+        (let ((details
+               (agent-error-from-coordinator-details exn)))
+          (if (string? details)
+              (cond
+               ((string=? details "build_already_processed")
+                (simple-format
+                 #t "warning: coordinator indicates this build is already marked as processed\n")
+                #t)
+               ((string=? details "missing_build_log_file")
+                ;; Retry submitting the log file
+                (agent-submit-log-file uuid coordinator-uri password
+                                       build-id derivation)
+
+                (attempt-submit-build-result))
+               (else
+                (raise-exception
+                 (make-exception
+                  (make-exception-with-message
+                   "unrecognised error from coordinator")
+                  (make-exception-with-irritants
+                   details)))))
+              (or
+               (and=> (assoc-ref details "missing_output")
+                      (lambda (missing-output-name)
+                        (let ((missing-output
+                               (any (match-lambda
+                                      ((name . output)
+                                       (if (string=? name missing-output-name)
+                                           output
+                                           #f)))
+                                    (derivation-outputs
+                                     (read-derivation-from-file derivation)))))
+                          (unless missing-output
+                            (raise-exception
+                             (make-exception
+                              (make-exception-with-message
+                               "unknown missing output")
+                              (make-exception-with-irritants
+                               missing-output-name))))
+
+                          (submit-one-output missing-output-name
+                                             missing-output))
+
+                        (attempt-submit-build-result)))
+               (raise-exception
+                (make-exception
+                 (make-exception-with-message
+                  "unrecognised error from coordinator")
+                 (make-exception-with-irritants
+                  details)))))))
+      (lambda ()
+        (submit-build-result
+         coordinator-uri uuid password build-id
+         `((result   . success)
+           (end_time . ,(strftime "%F %T" end-time))
+           (outputs  . ,(list->vector output-details)))))
+      #:unwind? #t))
+
+  (define (submit-one-output output-name output)
+    (simple-format #t "submitting output ~A\n"
+                   (derivation-output-path output))
+    (submit-output coordinator-uri uuid password
+                   build-id output-name
+                   (derivation-output-path output)))
+
   (simple-format #t "build ~A successful, reporting to coordinator\n"
                  build-id)
-  (let ((output-details
-         (map
-          (match-lambda
-            ((output-name . output)
-             (simple-format #t "submitting output ~A\n"
-                            (derivation-output-path output))
-             (submit-output coordinator-uri uuid password
-                            build-id output-name
-                            (derivation-output-path output))
-
-             (let ((path-info (with-store store
-                                (query-path-info
-                                 store
-                                 (derivation-output-path output)))))
-               `((name       . ,output-name)
-                 (hash       . ,(bytevector->nix-base32-string
-                                 (path-info-hash path-info)))
-                 (size       . ,(path-info-nar-size path-info))
-                 (references . ,(list->vector
-                                 (map basename
-                                      (path-info-references path-info))))))))
-
-          (derivation-outputs (read-derivation-from-file derivation)))))
-
-    (simple-format #t "finished submitting outputs, reporting result\n")
-    (submit-build-result
-     coordinator-uri uuid password build-id
-     `((result   . success)
-       (end_time . ,(strftime "%F %T" end-time))
-       (outputs  . ,(list->vector output-details))))))
+
+  (for-each (match-lambda
+              ((output-name . output)
+               (submit-one-output output-name output)))
+            (derivation-outputs (read-derivation-from-file derivation)))
+
+  (simple-format #t "finished submitting outputs, reporting result\n")
+  (attempt-submit-build-result))