mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
download: Honor ‘GUIX_DOWNLOAD_METHODS’ environment variable.
This replaces ‘GUIX_DOWNLOAD_FALLBACK_TEST’ and allows you to test various download methods, like so: GUIX_DOWNLOAD_METHODS=nar guix build guile-gcrypt -S --check GUIX_DOWNLOAD_METHODS=disarchive guix build hello -S --check * guix/build/download.scm (%download-methods): New variable. (download-method-enabled?): New procedure. (url-fetch): Define ‘initial-uris’; honor ‘download-method-enabled?’. Call ‘disarchive-fetch/any’ only when the 'disarchive method is enabled. * guix/build/git.scm (git-fetch-with-fallback): Honor ‘download-method-enabled?’. * guix/download.scm (%download-methods): New variable. (%download-fallback-test): Remove. (built-in-download): Add #:download-methods parameter and honor it. (url-fetch*): Pass #:content-addressed-mirrors and #:disarchive-mirrors unconditionally. * guix/git-download.scm (git-fetch/in-band*): Pass “git url” unconditionally. (git-fetch/built-in): Likewise. Pass “download-methods”. * guix/bzr-download.scm (bzr-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. * guix/cvs-download.scm (cvs-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. * guix/hg-download.scm (hg-fetch): Honor ‘download-method-enabled?’. Pass #:env-vars to ‘gexp->derivation’. * guix/scripts/perform-download.scm (perform-download): Honor “download-methods” from DRV. Parameterize ‘%download-methods’ before calling ‘url-fetch’. (perform-git-download): Likewise. * guix/svn-download.scm (svn-fetch): Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. (svn-multi-fetch): Likewise. Change-Id: Ia3402e17f0303dfa964bdc761265efe8a1dd69ab
This commit is contained in:
parent
abd0cca2a9
commit
2f441fc738
9 changed files with 230 additions and 154 deletions
|
@ -21,7 +21,7 @@
|
|||
#:use-module (guix scripts)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module ((guix store) #:select (derivation-path? store-path?))
|
||||
#:autoload (guix build download) (url-fetch)
|
||||
#:autoload (guix build download) (%download-methods url-fetch)
|
||||
#:autoload (guix build git) (git-fetch-with-fallback)
|
||||
#:autoload (guix config) (%git)
|
||||
#:use-module (ice-9 match)
|
||||
|
@ -55,7 +55,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
|
|||
(executable "executable")
|
||||
(mirrors "mirrors")
|
||||
(content-addressed-mirrors "content-addressed-mirrors")
|
||||
(disarchive-mirrors "disarchive-mirrors"))
|
||||
(disarchive-mirrors "disarchive-mirrors")
|
||||
(download-methods "download-methods"))
|
||||
(unless url
|
||||
(leave (G_ "~a: missing URL~%") (derivation-file-name drv)))
|
||||
|
||||
|
@ -64,26 +65,30 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
|
|||
(algo (derivation-output-hash-algo drv-output))
|
||||
(hash (derivation-output-hash drv-output)))
|
||||
;; We're invoked by the daemon, which gives us write access to OUTPUT.
|
||||
(when (url-fetch url output
|
||||
#:print-build-trace? print-build-trace?
|
||||
#:mirrors (if mirrors
|
||||
(call-with-input-file mirrors read)
|
||||
'())
|
||||
#:content-addressed-mirrors
|
||||
(if content-addressed-mirrors
|
||||
(call-with-input-file content-addressed-mirrors
|
||||
(lambda (port)
|
||||
(eval (read port) %user-module)))
|
||||
'())
|
||||
#:disarchive-mirrors
|
||||
(if disarchive-mirrors
|
||||
(call-with-input-file disarchive-mirrors read)
|
||||
'())
|
||||
#:hashes `((,algo . ,hash))
|
||||
(when (parameterize ((%download-methods
|
||||
(and download-methods
|
||||
(call-with-input-string download-methods
|
||||
read))))
|
||||
(url-fetch url output
|
||||
#:print-build-trace? print-build-trace?
|
||||
#:mirrors (if mirrors
|
||||
(call-with-input-file mirrors read)
|
||||
'())
|
||||
#:content-addressed-mirrors
|
||||
(if content-addressed-mirrors
|
||||
(call-with-input-file content-addressed-mirrors
|
||||
(lambda (port)
|
||||
(eval (read port) %user-module)))
|
||||
'())
|
||||
#:disarchive-mirrors
|
||||
(if disarchive-mirrors
|
||||
(call-with-input-file disarchive-mirrors read)
|
||||
'())
|
||||
#:hashes `((,algo . ,hash))
|
||||
|
||||
;; Since DRV's output hash is known, X.509 certificate
|
||||
;; validation is pointless.
|
||||
#:verify-certificate? #f)
|
||||
;; Since DRV's output hash is known, X.509 certificate
|
||||
;; validation is pointless.
|
||||
#:verify-certificate? #f))
|
||||
(when (and executable (string=? executable "1"))
|
||||
(chmod output #o755))))))
|
||||
|
||||
|
@ -96,7 +101,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
|
|||
'bmRepair' builds."
|
||||
(derivation-let drv ((url "url")
|
||||
(commit "commit")
|
||||
(recursive? "recursive?"))
|
||||
(recursive? "recursive?")
|
||||
(download-methods "download-methods"))
|
||||
(unless url
|
||||
(leave (G_ "~a: missing Git URL~%") (derivation-file-name drv)))
|
||||
(unless commit
|
||||
|
@ -114,14 +120,18 @@ Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
|
|||
;; on ambient authority, hence the PATH value below.
|
||||
(setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin")
|
||||
|
||||
;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are
|
||||
;; different, hence the #:item argument below.
|
||||
(git-fetch-with-fallback url commit output
|
||||
#:hash hash
|
||||
#:hash-algorithm algo
|
||||
#:recursive? recursive?
|
||||
#:item (derivation-output-path drv-output)
|
||||
#:git-command %git))))
|
||||
(parameterize ((%download-methods
|
||||
(and download-methods
|
||||
(call-with-input-string download-methods
|
||||
read))))
|
||||
;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are
|
||||
;; different, hence the #:item argument below.
|
||||
(git-fetch-with-fallback url commit output
|
||||
#:hash hash
|
||||
#:hash-algorithm algo
|
||||
#:recursive? recursive?
|
||||
#:item (derivation-output-path drv-output)
|
||||
#:git-command %git)))))
|
||||
|
||||
(define (assert-low-privileges)
|
||||
(when (zero? (getuid))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue