GNU bug report logs - #30450
[PATCH] git-download: Fetch only the required commit, if possible.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 30450 in the body.
You can then email your comments to 30450 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: guix-patches <at> gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [PATCH] git-download: Fetch only the required commit, if possible.
Date: Wed, 14 Feb 2018 00:54:01 +0100

* guix/build/git.scm (git-fetch): Fetch only the required commit, if possible.
---
 guix/build/git.scm | 43 +++++++++++++++++++++++--------------------
 1 file changed, 23 insertions(+), 20 deletions(-)

diff --git a/guix/build/git.scm b/guix/build/git.scm
index c1af545a7..14d415a6f 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -37,28 +37,31 @@ recursively.  Return #t on success, #f otherwise."
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  ;; We cannot use "git clone --recursive" since the following "git checkout"
-  ;; effectively removes sub-module checkouts as of Git 2.6.3.
-  (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
-                (when recursive?
-                  ;; Now is the time to fetch sub-modules.
-                  (unless (zero? (system* git-command "submodule" "update"
+  (mkdir-p directory)
+
+  (with-directory-excursion directory
+    (invoke git-command "init")
+    (invoke git-command "remote" "add" "origin" url)
+    (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+        (invoke git-command "checkout" "FETCH_HEAD")
+        (begin
+          (invoke git-command "fetch" "origin")
+          (invoke git-command "checkout" commit)))
+    (when recursive?
+      ;; Now is the time to fetch sub-modules.
+      (unless (zero? (system* git-command "submodule" "update"
                                           "--init" "--recursive"))
-                    (error "failed to fetch sub-modules" url))
+        (error "failed to fetch sub-modules" url))
 
-                  ;; 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$")))
+      ;; 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$")))
 
-                ;; 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)))))
+      ;; 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))
 
 ;;; git.scm ends here

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.