From cd436bf05a8344acf4462f3602e7d360821a902a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 14 May 2016 17:37:47 +0200
Subject: download: Support content-addressed mirrors.

* guix/download.scm (%content-addressed-mirrors)
(%content-addressed-mirror-file): New variables.
* guix/download.scm (url-fetch)[builder]: Define
'value-from-environment.  Pass #:hashes and
 #:content-addressed-mirrors to 'url-fetch'.
Define "guix download hashes" environment variable.
* guix/build/download.scm (url-fetch): Add #:content-addressed-mirrors
and #:hashes.
[content-addressed-urls]: New variable.
Use it.
---
 guix/build/download.scm | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

(limited to 'guix/build/download.scm')

diff --git a/guix/build/download.scm b/guix/build/download.scm
index fec4cec3e8..824e1c354a 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -605,10 +605,22 @@ Return a list of URIs."
     (else
      (list uri))))
 
-(define* (url-fetch url file #:key (mirrors '()))
+(define* (url-fetch url file
+                    #:key
+                    (mirrors '()) (content-addressed-mirrors '())
+                    (hashes '()))
   "Fetch FILE from URL; URL may be either a single string, or a list of
 string denoting alternate URLs for FILE.  Return #f on failure, and FILE
-on success."
+on success.
+
+When MIRRORS is defined, it must be an alist of mirrors; it is used to resolve
+'mirror://' URIs.
+
+HASHES must be a list of algorithm/hash pairs, where each algorithm is a
+symbol such as 'sha256 and each hash is a bytevector.
+CONTENT-ADDRESSED-MIRRORS must be a list of procedures that, given a hash
+algorithm and a hash, return a URL where the specified data can be retrieved
+or #f."
   (define uri
     (append-map (cut maybe-expand-mirrors <> mirrors)
                 (match url
@@ -628,13 +640,21 @@ on success."
                uri)
        #f)))
 
+  (define content-addressed-urls
+    (append-map (lambda (make-url)
+                  (filter-map (match-lambda
+                                ((hash-algo . hash)
+                                 (make-url hash-algo hash)))
+                              hashes))
+                content-addressed-mirrors))
+
   ;; Make this unbuffered so 'progress-proc' works as expected.  _IOLBF means
   ;; '\n', not '\r', so it's not appropriate here.
   (setvbuf (current-output-port) _IONBF)
 
   (setvbuf (current-error-port) _IOLBF)
 
-  (let try ((uri uri))
+  (let try ((uri (append uri content-addressed-urls)))
     (match uri
       ((uri tail ...)
        (or (fetch uri file)
-- 
cgit v1.2.3