aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-05-05 09:13:45 +0100
committerChristopher Baines <mail@cbaines.net>2020-05-05 09:13:45 +0100
commitbbf1c54399884df10ed225540f9e1579bdffc9f1 (patch)
treedaac6024e938f63505031898ced96f78babedd06
parent07dab00ea794d31e36d37847c6a601f64d7d5d68 (diff)
downloadbuild-coordinator-bbf1c54399884df10ed225540f9e1579bdffc9f1.tar
build-coordinator-bbf1c54399884df10ed225540f9e1579bdffc9f1.tar.gz
Better guard against build setup issues
I've seen an agent miss dependencies, so this should help guard against that.
-rw-r--r--guix-build-coordinator/agent.scm45
1 files changed, 28 insertions, 17 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 9db7e10..d54573e 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -22,6 +22,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (ice-9 match)
+ #:use-module (ice-9 exceptions)
#:use-module (rnrs bytevectors)
#:use-module (web http)
#:use-module (guix store)
@@ -104,23 +105,33 @@
#f))))
missing-paths))))
- (if (member #f path-substitutes)
- (fold (lambda (file substitute-available? result)
- (if substitute-available?
- result
- (cons file result)))
- '()
- missing-paths
- path-substitutes)
- (begin
- ;; Download the substitutes
- (with-store store
- (set-build-options store
- #:substitute-urls substitute-urls)
-
- (build-things store missing-paths))
-
- '()))))
+ (if (null? missing-paths)
+ '()
+ (if (member #f path-substitutes)
+ (fold (lambda (file substitute-available? result)
+ (if substitute-available?
+ result
+ (cons file result)))
+ '()
+ missing-paths
+ path-substitutes)
+ (begin
+ ;; Download the substitutes
+ (with-store store
+ (set-build-options store
+ #:substitute-urls substitute-urls)
+
+ (build-things store missing-paths))
+
+ ;; Double check everything is actually present.
+ (let ((missing-files (remove file-exists? output-paths)))
+ (unless (null? missing-files)
+ (raise-exception
+ (make-exception-with-message
+ (simple-format #f "failed to fetch substitutes for: ~A"
+ output-paths)))))
+
+ '())))))
(define (delete-outputs derivation)
(let* ((outputs (derivation-outputs derivation))