summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-06-27 23:04:48 +0200
committerLudovic Courtès <ludo@gnu.org>2014-06-27 23:04:48 +0200
commit6750877f46e684688075674c6e342895a24a52c9 (patch)
tree5c59e1144ec4f8c6ca51e62e1747f557b286b716
parent20b1d19e10a788768c67d0d8256527791ce579c8 (diff)
git-download: Support recursive clones.
* guix/git-download.scm (<git-reference>)[recursive?]: New field. (git-fetch): Add 'inputs' variable. Add it to the #:inputs argument of 'build-expression->derivation'. Augment builder with call to 'set-path-environment-variable', and pass #:recursive? to 'git-fetch'. * guix/build/git.scm (git-fetch): Add #:recursive? parameter. Pass --recursive when RECURSIVE? is true, and delete all the '.git' files.
-rw-r--r--guix/build/git.scm33
-rw-r--r--guix/git-download.scm31
2 files changed, 48 insertions, 16 deletions
diff --git a/guix/build/git.scm b/guix/build/git.scm
index 68b132265b..121f07a7fa 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -28,23 +28,32 @@
;;; Code:
(define* (git-fetch url commit directory
- #:key (git-command "git"))
+ #:key (git-command "git") recursive?)
"Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit
-identifier. Return #t on success, #f otherwise."
+identifier. When RECURSIVE? is true, all the sub-modules of URL are fetched,
+recursively. Return #t on success, #f otherwise."
;; Disable TLS certificate verification. The hash of the checkout is known
;; in advance anyway.
(setenv "GIT_SSL_NO_VERIFY" "true")
- (and (zero? (system* git-command "clone" url directory))
- (with-directory-excursion directory
- (system* git-command "tag" "-l")
- (and (zero? (system* git-command "checkout" commit))
- (begin
- ;; The contents of '.git' vary as a function of the current
- ;; status of the Git repo. Since we want a fixed output, this
- ;; directory needs to be taken out.
- (delete-file-recursively ".git")
- #t)))))
+ (let ((args `("clone" ,@(if recursive? '("--recursive") '())
+ ,url ,directory)))
+ (and (zero? (apply system* git-command args))
+ (with-directory-excursion directory
+ (system* git-command "tag" "-l")
+ (and (zero? (system* git-command "checkout" commit))
+ (begin
+ ;; The contents of '.git' vary as a function of the current
+ ;; status of the Git repo. Since we want a fixed output, this
+ ;; directory needs to be taken out.
+ (delete-file-recursively ".git")
+
+ (when recursive?
+ ;; In sub-modules, '.git' is a flat file, not a directory,
+ ;; so we can use 'find-files' here.
+ (for-each delete-file-recursively
+ (find-files directory "^\\.git$")))
+ #t))))))
;;; git.scm ends here
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 5e0a6a21dc..43d190db54 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -20,11 +20,13 @@
#:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix packages)
+ #:autoload (guix build-system gnu) (standard-inputs)
#:use-module (ice-9 match)
#:export (git-reference
git-reference?
git-reference-url
git-reference-commit
+ git-reference-recursive?
git-fetch))
@@ -39,8 +41,10 @@
(define-record-type* <git-reference>
git-reference make-git-reference
git-reference?
- (url git-reference-url)
- (commit git-reference-commit))
+ (url git-reference-url)
+ (commit git-reference-commit)
+ (recursive? git-reference-recursive? ; whether to recurse into sub-modules
+ (default #f)))
(define* (git-fetch store ref hash-algo hash
#:optional name
@@ -67,18 +71,37 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if
(git (module-ref distro 'git)))
(package-derivation store git system)))))
+ (define inputs
+ ;; When doing 'git clone --recursive', we need sed, grep, etc. to be
+ ;; available so that 'git submodule' works.
+ (if (git-reference-recursive? ref)
+ (standard-inputs (%current-system))
+ '()))
+
(let* ((command (string-append (derivation->output-path git-for-build)
"/bin/git"))
(builder `(begin
- (use-modules (guix build git))
+ (use-modules (guix build git)
+ (guix build utils)
+ (ice-9 match))
+
+ ;; The 'git submodule' commands expects Coreutils, sed,
+ ;; grep, etc. to be in $PATH.
+ (set-path-environment-variable "PATH" '("bin")
+ (match %build-inputs
+ (((names . dirs) ...)
+ dirs)))
+
(git-fetch ',(git-reference-url ref)
',(git-reference-commit ref)
%output
+ #:recursive? ',(git-reference-recursive? ref)
#:git-command ',command))))
(build-expression->derivation store (or name "git-checkout") builder
#:system system
#:local-build? #t
- #:inputs `(("git" ,git-for-build))
+ #:inputs `(("git" ,git-for-build)
+ ,@inputs)
#:hash-algo hash-algo
#:hash hash
#:recursive? #t