From e89225ea04c03020c03b0d3b20ddc201e593f8db Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 16 Apr 2020 21:40:43 +0100
Subject: Add better error handling in to the agent

So that it reports issues to the coordinator, rather than just crashing.
---
 guix-build-coordinator/agent.scm | 67 ++++++++++++++++++++++++++++------------
 1 file changed, 48 insertions(+), 19 deletions(-)

(limited to 'guix-build-coordinator/agent.scm')

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index e514373..4e4a991 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -46,9 +46,13 @@
                     (let ((pre-build-status (pre-build-process derivation-name)))
                       (if (eq? (assq-ref pre-build-status 'result) 'success)
                           (let ((result (perform-build derivation-name)))
-                            (post-build uuid coordinator-uri password
-                                        (assoc-ref build "uuid")
-                                        derivation-name))
+                            (if result
+                                (post-build uuid coordinator-uri password
+                                            (assoc-ref build "uuid")
+                                            derivation-name)
+                                (submit-build-result coordinator-uri uuid password
+                                                     (assoc-ref build "uuid")
+                                                     '((result . failure)))))
                           (begin
                             (simple-format #t "failure: ~A\n" pre-build-status)
                             (report-setup-failure coordinator-uri uuid password
@@ -85,33 +89,58 @@
 
             '()))))
 
+  (define (delete-outputs derivation)
+    (let* ((outputs (derivation-outputs derivation))
+           (output-file-names
+            (map derivation-output-path (map cdr outputs))))
+      (if (any file-exists? output-file-names)
+          (catch
+            #t
+            (lambda ()
+              (with-store store
+                (delete-paths store output-file-names))
+              #t)
+            (lambda (key args)
+              (simple-format (current-error-port)
+                             "error: delete-outputs: ~A ~A\n"
+                             key args)
+              #f))
+          #t)))
+
   (let ((derivation
          (if (file-exists? derivation-name)
              (read-derivation-from-file derivation-name)
              (and (substitute-derivation derivation-name)
                   (read-derivation-from-file derivation-name)))))
-
-    (let* ((outputs (derivation-outputs derivation))
-           (output-file-names
-            (map derivation-output-path (map cdr outputs))))
-      (when (any file-exists? output-file-names)
-        (with-store store
-          (delete-paths store output-file-names)))
-
-      (let ((missing-inputs
-             (find-missing-inputs (derivation-inputs derivation))))
-        (if (null? missing-inputs)
-            '((result . success))
-            `((result         . failure)
-              (failure_reason . missing_inputs)
-              (missing_inputs . ,(list->vector missing-inputs))))))))
+    (match (delete-outputs derivation)
+      (#t
+       (let ((missing-inputs
+              (find-missing-inputs (derivation-inputs derivation))))
+         (if (null? missing-inputs)
+             '((result . success))
+             `((result         . failure)
+               (failure_reason . missing_inputs)
+               (missing_inputs . ,(list->vector missing-inputs))))))
+      (failure
+       '((result         . failure)
+         (failure_reason . could_not_delete_outputs))))))
 
 (define (perform-build derivation-name)
   (with-store store
     (set-build-options store
                        #:use-substitutes? #f)
 
-    (build-things store (list derivation-name))))
+    (catch #t
+      (lambda ()
+        (build-things store (list derivation-name))
+
+        #t)
+      (lambda (key . args)
+        (simple-format (current-error-port)
+                       "error: build: ~A ~A\n"
+                       key args)
+
+        #f))))
 
 (define (post-build uuid coordinator-uri password
                     build-id derivation)
-- 
cgit v1.2.3