diff options
| -rw-r--r-- | guix/build/git.scm | 33 | ||||
| -rw-r--r-- | guix/git-download.scm | 31 |
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 |