aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-10-24 17:33:10 +0100
committerChristopher Baines <mail@cbaines.net>2020-10-24 17:54:05 +0100
commit0df7fce1f2746fadfe3f9aa82826b48c84b3eab2 (patch)
tree8410b161e1ec47a7cb41ff141b937a453b2b3a5e /guix-build-coordinator
parent3d8548d6a0b7a64b77fe9afe6059c9fb9ab62106 (diff)
downloadbuild-coordinator-0df7fce1f2746fadfe3f9aa82826b48c84b3eab2.tar
build-coordinator-0df7fce1f2746fadfe3f9aa82826b48c84b3eab2.tar.gz
Improve missing inputs behaviour
When a substitute is found for a direct input, but it can't be fetched, this is probably because something it referenced isn't available. Therefore, look through the references recursively and collect up the store items that aren't available locally or via a substitute. Send this list to the coordinator so that it can schedule builds.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/agent.scm28
-rw-r--r--guix-build-coordinator/utils.scm25
2 files changed, 49 insertions, 4 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index dcee91f..bb8d84b 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -134,7 +134,7 @@
derivation-substitute-urls
non-derivation-substitute-urls
derivation-name)
- (define (find-missing-inputs inputs)
+ (define (find-missing-inputs derivation inputs)
(let* ((output-paths
(append-map derivation-input-output-paths inputs))
(missing-paths
@@ -194,10 +194,30 @@
(begin
(simple-format
(current-error-port)
- "error: failed to fetch substitutes for: ~A\n"
+ "warning: failed to fetch substitutes for: ~A\n"
missing-files)
- missing-files))))))))
+ (let ((unavailable-outputs
+ (delete-duplicates
+ (append-map
+ (lambda (missing-output)
+ (find-missing-substitutes-for-output
+ store
+ non-derivation-substitute-urls
+ missing-output))
+ missing-files))))
+
+ (simple-format
+ (current-error-port)
+ "warning: the following outputs are missing:\n~A\n"
+ (string-join
+ (map (lambda (output)
+ (string-append
+ " - " output))
+ unavailable-outputs)
+ "\n"))
+
+ unavailable-outputs)))))))))
(define (delete-outputs derivation)
(let* ((outputs (derivation-outputs derivation))
@@ -234,7 +254,7 @@
(match (delete-outputs derivation)
(#t
(let ((missing-inputs
- (find-missing-inputs (derivation-inputs derivation))))
+ (find-missing-inputs derivation (derivation-inputs derivation))))
(if (null? missing-inputs)
'((result . success))
`((result . failure)
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index ef26d3a..c6f1b44 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -36,6 +36,7 @@
call-with-streaming-http-request
make-chunked-input-port*
+ find-missing-substitutes-for-output
has-substiutes-no-cache?
substitute-derivation
@@ -256,6 +257,30 @@ upcoming chunk."
(values response
body))))))))
+(define (find-missing-substitutes-for-output store substitute-urls output)
+ (if (valid-path? store output)
+ '()
+ (let ((narinfo
+ (any (lambda (substitute-url)
+ (let ((result (lookup-narinfos substitute-url (list output))))
+ (if (null? result)
+ #f
+ (first result))))
+ substitute-urls)))
+ (if narinfo
+ (append-map
+ (lambda (reference)
+ (let ((referenced-output
+ (string-append (%store-prefix) "/" reference)))
+ (peek "REF" referenced-output)
+ (if (string=? referenced-output output)
+ '()
+ (find-missing-substitutes-for-output store
+ substitute-urls
+ referenced-output))))
+ (narinfo-references narinfo))
+ (list output)))))
+
(define (has-substiutes-no-cache? substitute-urls file)
(define %narinfo-cache-directory
(if (zero? (getuid))