aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/download.scm26
-rw-r--r--guix/download.scm42
2 files changed, 58 insertions, 10 deletions
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)
diff --git a/guix/download.scm b/guix/download.scm
index 88f285dc0a..ff0bef3c1f 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -210,6 +210,22 @@
;; 'object->string'.
(plain-file "mirrors" (object->string %mirrors)))
+(define %content-addressed-mirrors
+ ;; List of content-addressed mirrors. Each mirror is represented as a
+ ;; procedure that takes an algorithm (symbol) and a hash (bytevector), and
+ ;; returns a URL or #f.
+ ;; TODO: Add more.
+ '(list (lambda (algo hash)
+ ;; 'tarballs.nixos.org' supports several algorithms.
+ (string-append "http://tarballs.nixos.org/"
+ (symbol->string algo) "/"
+ (bytevector->nix-base32-string hash)))))
+
+(define %content-addressed-mirror-file
+ ;; Content-addressed mirrors stored in a file.
+ (plain-file "content-addressed-mirrors"
+ (object->string %content-addressed-mirrors)))
+
(define (gnutls-package)
"Return the default GnuTLS package."
(let ((module (resolve-interface '(gnu packages tls))))
@@ -258,12 +274,21 @@ in the store."
%load-path)))
#~#t)
- (use-modules (guix build download))
+ (use-modules (guix build download)
+ (guix base32))
+
+ (let ((value-from-environment (lambda (variable)
+ (call-with-input-string
+ (getenv variable)
+ read))))
+ (url-fetch (value-from-environment "guix download url")
+ #$output
+ #:mirrors (call-with-input-file #$%mirror-file read)
- (url-fetch (call-with-input-string (getenv "guix download url")
- read)
- #$output
- #:mirrors (call-with-input-file #$%mirror-file read))))
+ ;; Content-addressed mirrors.
+ #:hashes (value-from-environment "guix download hashes")
+ #:content-addressed-mirrors
+ (primitive-load #$%content-addressed-mirror-file)))))
(let ((uri (and (string? url) (string->uri url))))
(if (or (and (string? url) (not uri))
@@ -278,14 +303,17 @@ in the store."
#:hash hash
#:modules '((guix build download)
(guix build utils)
- (guix ftp-client))
+ (guix ftp-client)
+ (guix base32))
;; Use environment variables and a fixed script
;; name so there's only one script in store for
;; all the downloads.
#:script-name "download"
#:env-vars
- `(("guix download url" . ,(object->string url)))
+ `(("guix download url" . ,(object->string url))
+ ("guix download hashes"
+ . ,(object->string `((,hash-algo . ,hash)))))
;; Honor the user's proxy settings.
#:leaked-env-vars '("http_proxy" "https_proxy")