02/04: guix download: Add '--mirrors'.

[Ludovic Courtès]

civodul pushed a commit to branch wip-oob-download
in repository guix.

commit 51ba19b2b78d4be92a5e283708385340e7f55500
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 13 23:39:26 2016 +0100

    guix download: Add '--mirrors'.
    
    * guix/download.scm (download-to-store): Add #:mirrors and honor it.
    * guix/scripts/download.scm (download-to-file)
    (download-to-store*): Likewise.
    * guix/scripts/download.scm (%default-options): Add 'mirrors'.
    (show-help, %options): Add '--mirrors'.
    (guix-download): Pass 'mirrors' value from OPTS to FETCH.
    * doc/guix.texi (Invoking guix download): Document it.
---
 doc/guix.texi             |    5 +++++
 guix/download.scm         |    3 ++-
 guix/scripts/download.scm |   24 +++++++++++++++++++-----
 3 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ccb9bb2..b41a454 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4840,6 +4840,11 @@ URL, which makes you vulnerable to ``man-in-the-middle'' 
attacks.
 @itemx -o @var{file}
 Save the downloaded file to @var{file} instead of adding it to the
 store.
+
address@hidden address@hidden
+Read from @var{file} an association list describing supported values and
+their list of mirrors for @code{mirror://} URIs.  This option is
+primarily meant for internal consumption.
 @end table
 
 @node Invoking guix hash
diff --git a/guix/download.scm b/guix/download.scm
index 0c27505..9a07566 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -435,6 +435,7 @@ own.  This helper makes it easier to deal with \"tar 
bombs\"."
 
 (define* (download-to-store store url #:optional (name (basename url))
                             #:key (log (current-error-port)) recursive?
+                            (mirrors %mirrors)
                             (verify-certificate? #t))
   "Download from URL to STORE, either under NAME or URL's basename if
 omitted.  Write progress reports to LOG.  RECURSIVE? has the same effect as
@@ -451,7 +452,7 @@ whether or not to validate HTTPS server certificates."
          (let ((result
                 (parameterize ((current-output-port log))
                   (build:url-fetch url temp
-                                   #:mirrors %mirrors
+                                   #:mirrors mirrors
                                    #:verify-certificate?
                                    verify-certificate?))))
            (close port)
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index dffff79..8b6bdaa 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -42,25 +42,30 @@
 ;;; Command-line options.
 ;;;
 
-(define (download-to-file url file)
+(define* (download-to-file url file #:key (mirrors %mirrors))
   "Download the file at URI to FILE.  Return FILE."
   (let ((uri (string->uri url)))
     (match (uri-scheme uri)
       ((or 'file #f)
        (copy-file (uri-path uri) file))
       (_
-       (url-fetch url file)))
+       (url-fetch url file #:mirrors mirrors)))
     file))
 
-(define* (download-to-store* url #:key (verify-certificate? #t))
+(define* (download-to-store* url
+                             #:key
+                             (verify-certificate? #t)
+                             (mirrors %mirrors))
   (with-store store
     (download-to-store store url
+                       #:mirrors mirrors
                        #:verify-certificate? verify-certificate?)))
 
 (define %default-options
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)
     (verify-certificate? . #t)
+    (mirrors . ,%mirrors)
     (download-proc . ,download-to-store*)))
 
 (define (show-help)
@@ -77,6 +82,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 
'base16'
                          do not validate the certificate of HTTPS servers "))
   (format #f (_ "
   -o, --output=FILE      download to FILE"))
+  (format #f (_ "
+      --mirrors=FILE     read the list of mirrors from FILE"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -105,11 +112,17 @@ Supported formats: 'nix-base32' (default), 'base32', and 
'base16'
         (option '("no-check-certificate") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verify-certificate? #f result)))
+        (option '("mirrors") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'mirrors
+                              (call-with-input-file arg read)
+                              result)))
         (option '(#\o "output") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'download-proc
-                              (lambda* (url #:key verify-certificate?)
-                                (download-to-file url arg))
+                              (lambda* (url #:key mirrors verify-certificate?)
+                                (download-to-file url arg
+                                                  #:mirrors mirrors))
                               (alist-delete 'download result))))
 
         (option '(#\h "help") #f #f
@@ -149,6 +162,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 
'base16'
            (path  (parameterize ((current-terminal-columns
                                   (terminal-columns)))
                     (fetch arg
+                           #:mirrors (assq-ref opts 'mirrors)
                            #:verify-certificate?
                            (assq-ref opts 'verify-certificate?))))
            (hash  (call-with-input-file