mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
git-download: Use “builtin:git-download” when available.
Fixes <https://issues.guix.gnu.org/63331>. Longer-term this will remove Git from the derivation graph when its sole use is to perform a checkout for a fixed-output derivation, thereby breaking dependency cycles that can arise in these situations. * guix/git-download.scm (git-fetch): Rename to… (git-fetch/in-band): … this. Deal with GIT or GUILE being #f. (git-fetch/built-in, built-in-builders*, git-fetch): New procedures. * tests/builders.scm ("git-fetch, file URI"): New test.
This commit is contained in:
Ludovic Courtès
parent
c4a1d69a69
commit
13b0cf85eb
2 changed files with 91 additions and 10 deletions
|
|
@ -27,6 +27,7 @@ (define-module (guix git-download)
|
|||
#:use-module (guix records)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix modules)
|
||||
#:use-module ((guix derivations) #:select (raw-derivation))
|
||||
#:autoload (guix build-system gnu) (standard-packages)
|
||||
#:autoload (guix download) (%download-fallback-test)
|
||||
#:autoload (git bindings) (libgit2-init!)
|
||||
|
|
@ -78,15 +79,19 @@ (define (git-package)
|
|||
(let ((distro (resolve-interface '(gnu packages version-control))))
|
||||
(module-ref distro 'git-minimal)))
|
||||
|
||||
(define* (git-fetch ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system)) (guile (default-guile))
|
||||
(git (git-package)))
|
||||
"Return a fixed-output derivation that fetches REF, a <git-reference>
|
||||
object. The output is expected to have recursive hash HASH of type
|
||||
HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
|
||||
(define* (git-fetch/in-band ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system))
|
||||
(guile (default-guile))
|
||||
(git (git-package)))
|
||||
"Return a fixed-output derivation that performs a Git checkout of REF, using
|
||||
GIT and GUILE (thus, said derivation depends on GIT and GUILE).
|
||||
|
||||
This method is deprecated in favor of the \"builtin:git-download\" builder.
|
||||
It will be removed when versions of guix-daemon implementing
|
||||
\"builtin:git-download\" will be sufficiently widespread."
|
||||
(define inputs
|
||||
`(("git" ,git)
|
||||
`(("git" ,(or git (git-package)))
|
||||
|
||||
;; When doing 'git clone --recursive', we need sed, grep, etc. to be
|
||||
;; available so that 'git submodule' works.
|
||||
|
|
@ -154,7 +159,8 @@ (define recursive?
|
|||
#:recursive? recursive?
|
||||
#:git-command "git")))))
|
||||
|
||||
(mlet %store-monad ((guile (package->derivation guile system)))
|
||||
(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
|
||||
|
|
@ -181,6 +187,54 @@ (define recursive?
|
|||
#:recursive? #t
|
||||
#:guile-for-build guile)))
|
||||
|
||||
(define* (git-fetch/built-in ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system)))
|
||||
"Return a fixed-output derivation that performs a Git checkout of REF, using
|
||||
the \"builtin:git-download\" derivation builder.
|
||||
|
||||
This is an \"out-of-band\" download in that the returned derivation does not
|
||||
explicitly depend on Git, Guile, etc. Instead, the daemon performs the
|
||||
download by itself using its own dependencies."
|
||||
(raw-derivation (or name "git-checkout") "builtin:git-download" '()
|
||||
#:system system
|
||||
#:hash-algo hash-algo
|
||||
#:hash hash
|
||||
#:recursive? #t
|
||||
#:env-vars
|
||||
`(("url" . ,(object->string
|
||||
(match (%download-fallback-test)
|
||||
('content-addressed-mirrors
|
||||
"https://example.org/does-not-exist")
|
||||
(_
|
||||
(git-reference-url ref)))))
|
||||
("commit" . ,(git-reference-commit ref))
|
||||
("recursive?" . ,(object->string
|
||||
(git-reference-recursive? ref))))
|
||||
#:leaked-env-vars '("http_proxy" "https_proxy"
|
||||
"LC_ALL" "LC_MESSAGES" "LANG"
|
||||
"COLUMNS")
|
||||
#:local-build? #t))
|
||||
|
||||
(define built-in-builders*
|
||||
(store-lift built-in-builders))
|
||||
|
||||
(define* (git-fetch ref hash-algo hash
|
||||
#:optional name
|
||||
#:key (system (%current-system))
|
||||
guile git)
|
||||
"Return a fixed-output derivation that fetches REF, a <git-reference>
|
||||
object. The output is expected to have recursive hash HASH of type
|
||||
HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
|
||||
(mlet %store-monad ((builtins (built-in-builders*)))
|
||||
(if (member "git-download" builtins)
|
||||
(git-fetch/built-in ref hash-algo hash name
|
||||
#:system system)
|
||||
(git-fetch/in-band ref hash-algo hash name
|
||||
#:system system
|
||||
#:guile guile
|
||||
#:git git))))
|
||||
|
||||
(define (git-version version revision commit)
|
||||
"Return the version string for packages using git-download."
|
||||
;; git-version is almost exclusively executed while modules are being loaded.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012-2015, 2018-2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
|
@ -20,6 +20,7 @@
|
|||
|
||||
(define-module (tests builders)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix build gnu-build-system)
|
||||
|
|
@ -31,9 +32,12 @@ (define-module (tests builders)
|
|||
#:use-module (guix base32)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (gcrypt hash)
|
||||
#:use-module ((guix hash) #:select (file-hash*))
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix tests git)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module ((ice-9 ftw) #:select (scandir))
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (srfi srfi-1)
|
||||
|
|
@ -84,6 +88,29 @@ (define url-fetch*
|
|||
(and (file-exists? out)
|
||||
(valid-path? %store out))))
|
||||
|
||||
(test-equal "git-fetch, file URI"
|
||||
'("." ".." "a.txt" "b.scm")
|
||||
(let ((nonce (random-text)))
|
||||
(with-temporary-git-repository directory
|
||||
`((add "a.txt" ,nonce)
|
||||
(add "b.scm" "#t")
|
||||
(commit "Commit.")
|
||||
(tag "v1.0.0" "The tag."))
|
||||
(run-with-store %store
|
||||
(mlet* %store-monad ((hash
|
||||
-> (file-hash* directory
|
||||
#:algorithm (hash-algorithm sha256)
|
||||
#:recursive? #t))
|
||||
(drv (git-fetch
|
||||
(git-reference
|
||||
(url (string-append "file://" directory))
|
||||
(commit "v1.0.0"))
|
||||
'sha256 hash
|
||||
"git-fetch-test")))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list drv))
|
||||
(return (scandir (derivation->output-path drv)))))))))
|
||||
|
||||
(test-assert "gnu-build-system"
|
||||
(build-system? gnu-build-system))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue