me
/
guix
Archived
1
0
Fork 0
Code

download: Use the built-in 'download' builder when available. 

Fixes <http://bugs.gnu.org/22774>.
Reported by Christopher W Carpenter.

* guix/download.scm (built-in-builders*, raw-derivation)
(built-in-download): New procedures.
(in-band-download): New procedure, with code formerly in 'url-fetch'.
(url-fetch): Call 'built-in-builders*' and dispatch between
'built-in-download' and 'in-band-download'.
master
Ludovic Courtès 2016-11-16 17:44:50 +01:00
parent f9aefa2d5f
commit 05ceb8dcaf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 112 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
guix/download.scm
View File

@ -309,27 +309,61 @@
(let ((module (resolve-interface '(gnu packages tls)))) (let ((module (resolve-interface '(gnu packages tls))))
(module-ref module 'gnutls))) (module-ref module 'gnutls)))
(define* (url-fetch url hash-algo hash (define built-in-builders*
#:optional name (let ((cache (make-weak-key-hash-table)))
#:key (system (%current-system)) (lambda ()
(guile (default-guile))) "Return, as a monadic value, the list of built-in builders supported by
"Return a fixed-output derivation that fetches URL (a string, or a list of the daemon."
strings denoting alternate URLs), which is expected to have hash HASH of type (lambda (store)
HASH-ALGO (a symbol). By default, the file name is the base name of URL; ;; Memoize the result to avoid repeated RPCs.
optionally, NAME can specify a different file name. (values (or (hashq-ref cache store)
(let ((result (built-in-builders store)))
(hashq-set! cache store result)
result))
store)))))
When one of the URL starts with mirror://, then its host part is (define raw-derivation
interpreted as the name of a mirror scheme, taken from %MIRROR-FILE. (store-lift derivation))
Alternately, when URL starts with file://, return the corresponding file name (define* (built-in-download file-name url
in the store." #:key system hash-algo hash
(define file-name mirrors content-addressed-mirrors
(match url (guile 'unused))
((head _ ...) "Download FILE-NAME from URL using the built-in 'download' builder.
(basename head))
(_
(basename url))))
This is an \"out-of-band\" download in that the returned derivation does not
explicitly depend on Guile, GnuTLS, etc. Instead, the daemon performs the
download by itself using its own dependencies."
(mlet %store-monad ((mirrors (lower-object mirrors))
(content-addressed-mirrors
(lower-object content-addressed-mirrors)))
(raw-derivation file-name "builtin:download" '()
#:system system
#:hash-algo hash-algo
#:hash hash
#:inputs `((,mirrors)
(,content-addressed-mirrors))
;; Honor the user's proxy and locale settings.
#:leaked-env-vars '("http_proxy" "https_proxy"
"LC_ALL" "LC_MESSAGES" "LANG"
"COLUMNS")
#:env-vars `(("url" . ,(object->string url))
("mirrors" . ,mirrors)
("content-addressed-mirrors"
. ,content-addressed-mirrors)))))
(define* (in-band-download file-name url
#:key system hash-algo hash
mirrors content-addressed-mirrors
guile)
"Download FILE-NAME from URL using a normal, \"in-band\" fixed-output
derivation.
This is now deprecated since it has the drawback of causing bootstrapping
issues: we may need to build GnuTLS just to be able to download the source of
GnuTLS itself and its dependencies. See <http://bugs.gnu.org/22774>."
(define need-gnutls? (define need-gnutls?
;; True if any of the URLs need TLS support. ;; True if any of the URLs need TLS support.
(let ((https? (cut string-prefix? "https://" <>))) (let ((https? (cut string-prefix? "https://" <>)))
@ -366,47 +400,81 @@ in the store."
read)))) read))))
(url-fetch (value-from-environment "guix download url") (url-fetch (value-from-environment "guix download url")
#$output #$output
#:mirrors (call-with-input-file #$%mirror-file read) #:mirrors (call-with-input-file #$mirrors read)
;; Content-addressed mirrors. ;; Content-addressed mirrors.
#:hashes #:hashes
(value-from-environment "guix download hashes") (value-from-environment "guix download hashes")
#:content-addressed-mirrors #:content-addressed-mirrors
(primitive-load #$%content-addressed-mirror-file) (primitive-load #$content-addressed-mirrors)
;; No need to validate certificates since we know the ;; No need to validate certificates since we know the
;; hash of the expected result. ;; hash of the expected result.
#:verify-certificate? #f))))) #:verify-certificate? #f)))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation file-name builder
#:guile-for-build guile
#:system system
#:hash-algo hash-algo
#:hash hash
;; 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 hashes"
. ,(object->string `((,hash-algo . ,hash)))))
;; Honor the user's proxy settings.
#:leaked-env-vars '("http_proxy" "https_proxy")
;; In general, offloading downloads is not a good
;; idea. Daemons before 0.8.3 would also
;; interpret this as "do not substitute" (see
;; <https://bugs.gnu.org/18747>.)
#:local-build? #t)))
(define* (url-fetch url hash-algo hash
#:optional name
#:key (system (%current-system))
(guile (default-guile)))
"Return a fixed-output derivation that fetches URL (a string, or a list of
strings denoting alternate URLs), which is expected to have hash HASH of type
HASH-ALGO (a symbol). By default, the file name is the base name of URL;
optionally, NAME can specify a different file name.
When one of the URL starts with mirror://, then its host part is
interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
Alternately, when URL starts with file://, return the corresponding file name
in the store."
(define file-name
(match url
((head _ ...)
(basename head))
(_
(basename url))))
(let ((uri (and (string? url) (string->uri url)))) (let ((uri (and (string? url) (string->uri url))))
(if (or (and (string? url) (not uri)) (if (or (and (string? url) (not uri))
(and uri (memq (uri-scheme uri) '(#f file)))) (and uri (memq (uri-scheme uri) '(#f file))))
(interned-file (if uri (uri-path uri) url) (interned-file (if uri (uri-path uri) url)
(or name file-name)) (or name file-name))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet* %store-monad ((builtins (built-in-builders*))
(gexp->derivation (or name file-name) builder (download -> (if (member "download" builtins)
#:guile-for-build guile built-in-download
#:system system in-band-download)))
#:hash-algo hash-algo (download (or name file-name) url
#:hash hash #:guile guile
#:system system
;; Use environment variables and a fixed script #:hash-algo hash-algo
;; name so there's only one script in store for #:hash hash
;; all the downloads. #:mirrors %mirror-file
#:script-name "download" #:content-addressed-mirrors
#:env-vars %content-addressed-mirror-file)))))
`(("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")
;; In general, offloading downloads is not a good
;; idea. Daemons before 0.8.3 would also
;; interpret this as "do not substitute" (see
;; <https://bugs.gnu.org/18747>.)
#:local-build? #t)))))
(define* (url-fetch/tarbomb url hash-algo hash (define* (url-fetch/tarbomb url hash-algo hash
#:optional name #:optional name