summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-16 17:44:50 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-16 18:19:55 +0100
commit05ceb8dcaf480a47cddf94ac979070b76df6556c (patch)
tree8e1bc2c8f513e1052762c50f4d05a7170f30e92f
parentf9aefa2d5fb3f6aad25a907939ee872c828b33d0 (diff)
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'.
-rw-r--r--guix/download.scm156
1 files changed, 112 insertions, 44 deletions
diff --git a/guix/download.scm b/guix/download.scm
index 0c275053c5..34ebd45370 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -309,27 +309,61 @@
(let ((module (resolve-interface '(gnu packages tls))))
(module-ref module 'gnutls)))
-(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.
+(define built-in-builders*
+ (let ((cache (make-weak-key-hash-table)))
+ (lambda ()
+ "Return, as a monadic value, the list of built-in builders supported by
+the daemon."
+ (lambda (store)
+ ;; Memoize the result to avoid repeated RPCs.
+ (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
-interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
+(define raw-derivation
+ (store-lift derivation))
-Alternately, when URL starts with file://, return the corresponding file name
-in the store."
- (define file-name
- (match url
- ((head _ ...)
- (basename head))
- (_
- (basename url))))
+(define* (built-in-download file-name url
+ #:key system hash-algo hash
+ mirrors content-addressed-mirrors
+ (guile 'unused))
+ "Download FILE-NAME from URL using the built-in 'download' builder.
+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?
;; True if any of the URLs need TLS support.
(let ((https? (cut string-prefix? "https://" <>)))
@@ -366,47 +400,81 @@ in the store."
read))))
(url-fetch (value-from-environment "guix download url")
#$output
- #:mirrors (call-with-input-file #$%mirror-file read)
+ #:mirrors (call-with-input-file #$mirrors read)
;; Content-addressed mirrors.
#:hashes
(value-from-environment "guix download hashes")
#:content-addressed-mirrors
- (primitive-load #$%content-addressed-mirror-file)
+ (primitive-load #$content-addressed-mirrors)
;; No need to validate certificates since we know the
;; hash of the expected result.
#: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))))
(if (or (and (string? url) (not uri))
(and uri (memq (uri-scheme uri) '(#f file))))
(interned-file (if uri (uri-path uri) url)
(or name file-name))
- (mlet %store-monad ((guile (package->derivation guile system)))
- (gexp->derivation (or name 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)))))
+ (mlet* %store-monad ((builtins (built-in-builders*))
+ (download -> (if (member "download" builtins)
+ built-in-download
+ in-band-download)))
+ (download (or name file-name) url
+ #:guile guile
+ #:system system
+ #:hash-algo hash-algo
+ #:hash hash
+ #:mirrors %mirror-file
+ #:content-addressed-mirrors
+ %content-addressed-mirror-file)))))
(define* (url-fetch/tarbomb url hash-algo hash
#:optional name