git-download: Reduce builder duplication.
Rather than creating a different builder in the store for every different
download (by hash), remove the hash from the builder and pass it in via an
environment variable. This means that when git-fetch is used by two different
package sources, the derivations will still differ but the builder will be
shared.
It used to be this way, but changed with
264fdbcaff. I noticed this through looking at
the same problem with svn-multi-fetch.
To try and make the effects of introducing variance in to the builder script
more obvious, separate it out in to it's own procedure, so that it's clearer
when there's new data going in that could cause variance.
* guix/git-download.scm (git-fetch/in-band*): Extract out builder script,
include hash in the derivation as an environment variable and update the
comment to be more directive.
(git-fetch-builder): New procedure.
Change-Id: I59c9fc445667c0e7dc44bcb706818300c394a1e5
master
Christopher Baines
parent
275f279891
commit
0daa72e34d
|
|
@ -48,6 +48,7 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:export (git-reference
|
||||
git-reference?
|
||||
git-reference-url
|
||||
|
|
@ -86,20 +87,13 @@
|
|||
(let ((distro (resolve-interface '(gnu packages version-control))))
|
||||
(module-ref distro 'git-lfs)))
|
||||
|
||||
(define* (git-fetch/in-band* ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system))
|
||||
(guile (default-guile))
|
||||
(git (git-package))
|
||||
git-lfs)
|
||||
"Shared implementation code for git-fetch/in-band & friends. Refer to their
|
||||
respective documentation."
|
||||
(define (git-fetch-builder git git-lfs git-ref-recursive? hash-algo)
|
||||
(define inputs
|
||||
`(,(or git (git-package))
|
||||
,@(if git-lfs
|
||||
(list git-lfs)
|
||||
'())
|
||||
,@(if (git-reference-recursive? ref)
|
||||
,@(if git-ref-recursive?
|
||||
;; TODO: remove (standard-packages) after
|
||||
;; 48e528a26f9c019eeaccf5e3de3126aa02c98d3b is merged into master;
|
||||
;; currently when doing 'git clone --recursive', we need sed, grep,
|
||||
|
|
@ -132,7 +126,6 @@ respective documentation."
|
|||
(source-module-closure '((guix build git)
|
||||
(guix build utils)))))
|
||||
|
||||
(define build
|
||||
(with-imported-modules modules
|
||||
(with-extensions (list guile-json gnutls ;for (guix swh)
|
||||
guile-lzlib)
|
||||
|
|
@ -140,7 +133,8 @@ respective documentation."
|
|||
(use-modules (guix build git)
|
||||
((guix build utils)
|
||||
#:select (set-path-environment-variable))
|
||||
(ice-9 match))
|
||||
(ice-9 match)
|
||||
(rnrs bytevectors))
|
||||
|
||||
(define lfs?
|
||||
(call-with-input-string (getenv "git lfs?") read))
|
||||
|
|
@ -165,26 +159,49 @@ respective documentation."
|
|||
|
||||
(git-fetch-with-fallback (getenv "git url") (getenv "git commit")
|
||||
#$output
|
||||
#:hash #$hash
|
||||
#:hash (u8-list->bytevector
|
||||
(map
|
||||
string->number
|
||||
(string-split (getenv "hash") #\,)))
|
||||
#:hash-algorithm '#$hash-algo
|
||||
#:lfs? lfs?
|
||||
#:recursive? recursive?
|
||||
#:git-command "git")))))
|
||||
|
||||
(define* (git-fetch/in-band* ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system))
|
||||
(guile (default-guile))
|
||||
(git (git-package))
|
||||
git-lfs)
|
||||
"Shared implementation code for git-fetch/in-band & friends. Refer to their
|
||||
respective documentation."
|
||||
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
|
||||
system)))
|
||||
(gexp->derivation (or name "git-checkout") build
|
||||
|
||||
;; Use environment variables and a fixed script name so
|
||||
;; there's only one script in store for all the
|
||||
;; downloads.
|
||||
(gexp->derivation (or name "git-checkout")
|
||||
;; Avoid the builder differing for every single use as
|
||||
;; having less builder is more efficient for computing
|
||||
;; derivations.
|
||||
;;
|
||||
;; Don't pass package specific data in to the following
|
||||
;; procedure, use #:env-vars below instead.
|
||||
(git-fetch-builder git git-lfs
|
||||
(git-reference-recursive? ref)
|
||||
hash-algo)
|
||||
#:script-name "git-download"
|
||||
#:env-vars
|
||||
`(("git url" . ,(git-reference-url ref))
|
||||
("git commit" . ,(git-reference-commit ref))
|
||||
("git recursive?" . ,(object->string
|
||||
(git-reference-recursive? ref)))
|
||||
("git lfs?" . ,(if git-lfs "#t" "#f")))
|
||||
("git lfs?" . ,(if git-lfs "#t" "#f"))
|
||||
;; To avoid pulling in (guix base32) in the builder
|
||||
;; script, use bytevector->u8-list from (rnrs
|
||||
;; bytevectors)
|
||||
("hash" . ,(string-join
|
||||
(map number->string
|
||||
(bytevector->u8-list hash))
|
||||
",")))
|
||||
#:leaked-env-vars '("http_proxy" "https_proxy"
|
||||
"LC_ALL" "LC_MESSAGES" "LANG"
|
||||
"COLUMNS")
|
||||
|
|
|
|||
Reference in New Issue