diff options
-rw-r--r-- | guix-build-coordinator/agent.scm | 19 | ||||
-rw-r--r-- | guix-build-coordinator/utils.scm | 38 |
2 files changed, 51 insertions, 6 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 518b02c..9db7e10 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -90,12 +90,19 @@ (remove file-exists? output-paths)) (path-substitutes (with-store store - (set-build-options store - #:substitute-urls substitute-urls) - - (map (lambda (file) - (has-substitutes? store file)) - missing-paths)))) + (set-build-options store #:substitute-urls substitute-urls) + + (map (lambda (file) + (and + (has-substiutes-no-cache? substitute-urls file) + (if (has-substitutes? store file) + #t + (begin + (simple-format + #t "warning: a substitute should be available for ~A, but the daemon claims it's not\n" + file) + #f)))) + missing-paths)))) (if (member #f path-substitutes) (fold (lambda (file substitute-available? result) diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 585e33b..445c90e 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -1,6 +1,8 @@ (define-module (guix-build-coordinator utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-60) + #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 threads) @@ -18,9 +20,12 @@ #:use-module (fibers) #:use-module (fibers channels) #:use-module (guix pki) + #:use-module (guix utils) + #:use-module (guix config) #:use-module (guix store) #:use-module (guix status) #:use-module (guix base64) + #:use-module (guix scripts substitute) #:export (make-worker-thread-channel call-with-worker-thread @@ -30,6 +35,8 @@ call-with-streaming-http-request make-chunked-input-port* + has-substiutes-no-cache? + substitute-derivation narinfo-string)) @@ -276,6 +283,37 @@ upcoming chunk." (values response body)))))) +(define (has-substiutes-no-cache? substitute-urls file) + (define %narinfo-cache-directory + (if (zero? (getuid)) + (or (and=> (getenv "XDG_CACHE_HOME") + (cut string-append <> "/guix/substitute")) + (string-append %state-directory "/substitute/cache")) + (string-append (cache-directory #:ensure? #f) "/substitute"))) + + ;; Because there's no control over the caching of 404 lookups, and I'd + ;; rather not reach inside and monkey patch the Guix code, just delete any + ;; cache files + (let ((hash-part (store-path-hash-part file)) + (directories + (scandir %narinfo-cache-directory + (lambda (s) (= (string-length s) 52))))) + + (for-each (lambda (directory) + (let ((cache-file + (string-append + %narinfo-cache-directory "/" + directory "/" hash-part))) + (when (file-exists? cache-file) + (delete-file cache-file)))) + directories)) + + (let ((narinfos + (append-map (lambda (substitute-url) + (lookup-narinfos substitute-url (list file))) + substitute-urls))) + (not (null? (peek narinfos))))) + (define* (substitute-derivation derivation-name #:key substitute-urls) (catch #t |