wingo pushed a commit to branch wip-pam-elogind in repository guix. commit c7dd700e6c50589e7e2b0fea33b8d6185983135f Author: Andy Wingo <wi...@pobox.com> Date: Tue Aug 18 10:03:06 2015 +0200
guix: git: Support shallow git clones if a tag is available * guix/build/git.scm (git-fetch): Instead of cloning the remote repo, use the lower-level "init" / "fetch" / "checkout" operations. This lets us make a shallow checkout if we are checking out a tag. * guix/git-download.scm (<git-reference>): Add tag field. (git-fetch): Support git references with tags but no commits. --- guix/build/git.scm | 58 +++++++++++++++++++++++++++++++++---------------- guix/git-download.scm | 10 ++++++- 2 files changed, 47 insertions(+), 21 deletions(-) diff --git a/guix/build/git.scm b/guix/build/git.scm index 121f07a..1af547f 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -28,32 +28,52 @@ ;;; Code: (define* (git-fetch url commit directory - #:key (git-command "git") recursive?) + #:key tag (git-command "git") recursive?) "Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit 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") - (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") + (mkdir directory) + (with-directory-excursion directory + (and (zero? (system* git-command "init")) + (zero? (system* git-command "remote" "add" "origin" url)) + (cond + ;; If there's a tag, do a shallow fetch. Otherwise we do a full + ;; fetch. + (tag + (and (zero? (system* git-command "fetch" "--depth=1" "origin" tag)) + ;; Either there is no commit specified, in which case we are + ;; good, or there is a commit and it is the same as the tag, + ;; in which case we're still good, or there's a commit and + ;; it's under the tag so we have to unshallow the checkout and + ;; try again. + (if commit + (or (zero? (system* git-command "checkout" commit)) + (and (zero? (system* git-command "fetch" "--unshallow")) + (zero? (system* git-command "checkout" commit)))) + (zero? (system* git-command "checkout" "FETCH_HEAD"))))) + (else + ;; Fall back to a full fetch. In that case print available tags. + (and (zero? (system* git-command "fetch" "origin")) + (zero? (system* git-command "tag" "-l")) + (zero? (system* git-command "checkout" commit))))) + (or (not recursive?) + (zero? (system* git-command + "submodule" "update" "--init" "--recursive"))) + (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)))))) + (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 0f2218c..43bc466 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -28,6 +28,7 @@ git-reference? git-reference-url git-reference-commit + git-reference-tag git-reference-recursive? git-fetch)) @@ -44,7 +45,8 @@ git-reference make-git-reference git-reference? (url git-reference-url) - (commit git-reference-commit) + (commit git-reference-commit (default #f)) + (tag git-reference-tag (default #f)) (recursive? git-reference-recursive? ; whether to recurse into sub-modules (default #f))) @@ -81,8 +83,12 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." dirs))) (git-fetch '#$(git-reference-url ref) - '#$(git-reference-commit ref) + (or '#$(git-reference-commit ref) + '#$(git-reference-tag ref)) #$output + ;; FIXME: Pass #:tag when fixed daemons are widely + ;; deployed. + ;; #:tag '#$(git-reference-tag ref) #:recursive? '#$(git-reference-recursive? ref) #:git-command (string-append #+git "/bin/git"))))