diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-06-04 09:43:38 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-06-04 09:43:38 +0200 |
commit | ae3b6bb0f4dc1f69ecb629c9b7ad34588d646039 (patch) | |
tree | 27e3ce6b0bd70da02d003ddd07e7743951246f35 | |
parent | bdbb6fbb1999f7bb8bed6e0ca8e50197d58a00f7 (diff) | |
download | guix-ae3b6bb0f4dc1f69ecb629c9b7ad34588d646039.tar.gz |
substitute-binary: Don't cache .narinfo lookups when lacking networking.
* guix/scripts/substitute-binary.scm (lookup-narinfo): Don't cache NARINFO when CACHE is #f.
-rwxr-xr-x | guix/scripts/substitute-binary.scm | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 088a41a15c..13c382877b 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -236,8 +236,8 @@ reading PORT." (define (fetch-narinfo cache path) "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH." (define (download url) - ;; Download the `nix-cache-info' from URL, and return its contents as an - ;; list of key/value pairs. + ;; Download the .narinfo from URL, and return its contents as a list of + ;; key/value pairs. (false-if-exception (fetch (string->uri url)))) (and (string=? (cache-store-directory cache) (%store-prefix)) @@ -288,11 +288,15 @@ check what it has." (values #f #f))))) (if valid? cached ; including negative caches - (let ((narinfo (and=> (force cache) - (cut fetch-narinfo <> path)))) - (with-atomic-file-output cache-file - (lambda (out) - (write (cache-entry narinfo) out))) + (let* ((cache (force cache)) + (narinfo (and cache (fetch-narinfo cache path)))) + ;; Cache NARINFO only when CACHE was actually accessible. This + ;; avoids caching negative hits when in fact we just lacked network + ;; access. + (when cache + (with-atomic-file-output cache-file + (lambda (out) + (write (cache-entry narinfo) out)))) narinfo)))) (define (remove-expired-cached-narinfos) @@ -457,4 +461,9 @@ indefinitely." (("--version") (show-version-and-exit "guix substitute-binary"))))) + +;;; Local Variable: +;;; eval: (put 'with-atomic-file-output 'scheme-indent-function 1) +;;; End: + ;;; substitute-binary.scm ends here |