diff options
| -rw-r--r-- | guix-build-coordinator/agent.scm | 28 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 25 |
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)) |