~ruther/guix-local: substitute-binary: Quietly handle 404s when fetching narinfos.

19ee8c7dc5b601783b7cdfcd61a8147bc374c727 — Ludovic Courtès 12 years ago 4a06f0e

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.

patch browse .tar.gz

1 files changed, 12 insertions(+), 8 deletions(-)

M guix/scripts/substitute-binary.scm

M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +12 -8

@@ 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) "/"