summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/git-download.scm72
-rw-r--r--tests/builders.scm29
2 files changed, 91 insertions, 10 deletions
diff --git a/guix/git-download.scm b/guix/git-download.scm
index f1f19397c6..5d5d73dc6b 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -27,6 +27,7 @@
#: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 @@
(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 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
#: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 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
#: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.
diff --git a/tests/builders.scm b/tests/builders.scm
index 0b5577c7a3..619caa5f31 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -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 @@
#: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 @@
(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))