1 files changed, 38 insertions, 0 deletions
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