summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-19 22:26:08 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-19 22:26:08 +0100
commit19ee8c7dc5b601783b7cdfcd61a8147bc374c727 (patch)
treee2207c7226a34118fee4ef5104a385cc294121f5
parent4a06f0ef2b9d06ab206edd179e53e152d305a95a (diff)
downloadguix-19ee8c7dc5b601783b7cdfcd61a8147bc374c727.tar.gz
substitute-binary: Quietly handle 404s when fetching narinfos.
* guix/scripts/substitute-binary.scm (fetch): Add #:quiet-404?
  parameter.  Upon &http-get-error, re-raise C if the QUIET-404? is
  true and the code is 404.
  (fetch-narinfo): Pass #:quiet-404? #t.
-rwxr-xr-xguix/scripts/substitute-binary.scm20
1 files changed, 12 insertions, 8 deletions
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 54f4aaa6c0..7ac12ddef2 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -125,9 +125,10 @@ again."
         (sigaction SIGALRM SIG_DFL)
         (apply values result)))))
 
-(define* (fetch uri #:key (buffered? #t) (timeout? #t))
+(define* (fetch uri #:key (buffered? #t) (timeout? #t) (quiet-404? #f))
   "Return a binary input port to URI and the number of bytes it's expected to
-provide."
+provide.  If QUIET-404? is true, HTTP 404 error conditions are passed through
+to the caller without emitting an error message."
   (case (uri-scheme uri)
     ((file)
      (let ((port (open-file (uri-path uri)
@@ -135,10 +136,12 @@ provide."
        (values port (stat:size (stat port)))))
     ((http)
      (guard (c ((http-get-error? c)
-                (leave (_ "download from '~a' failed: ~a, ~s~%")
-                       (uri->string (http-get-error-uri c))
-                       (http-get-error-code c)
-                       (http-get-error-reason c))))
+                (let ((code (http-get-error-code c)))
+                  (if (and (= code 404) quiet-404?)
+                      (raise c)
+                      (leave (_ "download from '~a' failed: ~a, ~s~%")
+                             (uri->string (http-get-error-uri c))
+                             code (http-get-error-reason c))))))
        ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once.  So
        ;; honor TIMEOUT? to disable the timeout when fetching a nar.
        ;;
@@ -275,8 +278,9 @@ reading PORT."
   "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
   (define (download url)
     ;; Download the .narinfo from URL, and return its contents as a list of
-    ;; key/value pairs.
-    (false-if-exception (fetch (string->uri url))))
+    ;; key/value pairs.  Don't emit an error message upon 404.
+    (false-if-exception (fetch (string->uri url)
+                               #:quiet-404? #t)))
 
   (and (string=? (cache-store-directory cache) (%store-prefix))
        (and=> (download (string-append (cache-url cache) "/"