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.

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