Ensure that successful builds have the outputs and log file

Present on the coordinator.

2 files changed, 66 insertions, 12 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 7d96054..7d61ab4 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -22,6 +22,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 exceptions)
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 binary-ports)
   #:use-module (system repl error-handling)
@@ -205,15 +206,29 @@ port. Also, the port used can be changed by passing the --port option.\n"
        (let ((agent-id-for-build
               (datastore-agent-for-build datastore uuid)))
          (if (authenticated? agent-id-for-build request)
-             (begin
-               (handle-build-result datastore hook-channel
-                                    agent-id-for-build uuid
-                                    (json-string->scm (utf8->string body)))
-               ;; Trigger build allocation, as the result of this build could
-               ;; change the allocation
-               (trigger-build-allocation)
-               (render-json
-                "message received"))
+             (with-exception-handler
+                 (lambda (exn)
+                   (simple-format (current-error-port)
+                                  "exception: ~A\n"
+                                  exn)
+                   (render-json
+                    `((error . ,(exception-message exn)))
+                    #:code 500))        ; TODO better code
+               (lambda ()
+                 (with-exception-handler
+                     (lambda (exn)
+                       (backtrace)
+                       (raise-exception exn))
+                   (lambda ()
+                     (handle-build-result datastore hook-channel
+                                          agent-id-for-build uuid
+                                          (json-string->scm (utf8->string body)))
+                     ;; Trigger build allocation, as the result of this build
+                     ;; could change the allocation
+                     (trigger-build-allocation)
+                     (render-json
+                      "message received"))))
+               #:unwind? #t)
              (render-json
               "access denied"
               #:code 403))))
@@ -415,7 +430,11 @@ port. Also, the port used can be changed by passing the --port option.\n"
                  #:body (scm->json-string result)
                  #:headers
                  `((Authorization . ,auth-value)))))
-    (json-string->scm (utf8->string body))))
+    (let ((message
+           (json-string->scm (utf8->string body))))
+      (if (>= (response-code response) 400)
+          (error message)
+          message))))
 
 (define (report-setup-failure coordinator-uri agent-uuid password
                               build-id report)
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index f641ca8..14fbd5d 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -20,8 +20,11 @@
 
 (define-module (guix-build-coordinator coordinator)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 exceptions)
   #:use-module (gcrypt random)
   #:use-module (fibers channels)
   #:use-module (guix derivations)
@@ -202,19 +205,51 @@
                    (basename output)
                    ".nar.lz")))
 
-(define (build-log-file-location datastore build-id format)
+(define (build-log-file-directory build-id)
   (string-append (%config 'build-logs-dir) "/"
-                 build-id "/"
+                 build-id))
+
+(define (build-log-file-location datastore build-id format)
+  (string-append (build-log-file-directory build-id) "/"
                  (cond
                   ((string=? format "bzip2") "log.bz2")
                   ((string=? format "gzip")  "log.gz")
                   (else
                    (error "unknown log format" format)))))
 
+(define (build-log-file-exists? build-id)
+  (let ((potential-files
+         (scandir (build-log-file-directory build-id)
+                  (negate (cut member <> '("." ".."))))))
+    (match potential-files
+      ((file) file)
+      (() #f)
+      (#f #f)                           ; directory doesn't exist
+      (files (error
+              (simple-format #f "found multiple files for ~A: ~A"
+                             build-id files))))))
+
 (define (handle-build-result datastore hook-channel
                              agent-id build-id result-json)
   (let* ((result (assoc-ref result-json "result"))
          (success? (string=? result "success")))
+    (when success?
+      (unless (build-log-file-exists? build-id)
+        (raise-exception
+         (make-exception-with-message "missing build log file")))
+
+      (for-each
+       (lambda (output)
+         (let ((output-location
+                (build-output-file-location datastore build-id
+                                            (assq-ref output 'name))))
+           (unless (file-exists? output-location)
+             (raise-exception
+              (make-exception-with-message
+               (simple-format #f "missing output ~A"
+                              (assq-ref output 'name)))))))
+       (datastore-list-build-outputs datastore build-id)))
+
     (datastore-store-build-result datastore
                                   build-id
                                   agent-id