all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH v2 1/7] guix: git: Support shallow git clones if a tag is available
@ 2015-08-18  8:03 Andy Wingo
  2015-08-18  8:05 ` [PATCH v2 2/7] gnu: elogind: Update to version 219.5 Andy Wingo
                   ` (5 more replies)
  0 siblings, 6 replies; 21+ messages in thread
From: Andy Wingo @ 2015-08-18  8:03 UTC (permalink / raw)
  To: guix-devel

* 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"))))
 
-- 
2.4.3

^ permalink raw reply related	[flat|nested] 21+ messages in thread
end of thread, other threads:[~2015-08-28  9:10 UTC | newest]

Thread overview: 21+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-08-18  8:03 [PATCH v2 1/7] guix: git: Support shallow git clones if a tag is available Andy Wingo
2015-08-18  8:05 ` [PATCH v2 2/7] gnu: elogind: Update to version 219.5 Andy Wingo
2015-08-25 14:46   ` Ludovic Courtès
2015-08-18  8:22 ` [PATCH v2 3/7] gnu: Allow OS configurations to add PAM session modules Andy Wingo
2015-08-25 14:55   ` Ludovic Courtès
2015-08-25 16:00     ` Andy Wingo
2015-08-25 21:39       ` Ludovic Courtès
2015-08-26  7:21         ` Andy Wingo
2015-08-26  7:36           ` 宋文武
2015-08-28  9:04           ` Ludovic Courtès
2015-08-18  9:39 ` [PATCH v2 4/7] gnu: polkit: Use elogind for seat management Andy Wingo
2015-08-25 14:56   ` Ludovic Courtès
2015-08-25 16:00     ` Andy Wingo
2015-08-18  9:54 ` [PATCH v2 5/7] gnu: colord: Add libcap input Andy Wingo
2015-08-25 15:03   ` Ludovic Courtès
2015-08-25 16:01     ` Andy Wingo
2015-08-25 21:40       ` Ludovic Courtès
2015-08-18  9:56 ` [PATCH v2 6/7] gnu: Add elogind service Andy Wingo
2015-08-25 15:04   ` Ludovic Courtès
2015-08-18  9:57 ` [PATCH v2 7/7] gnu: Add polkit service Andy Wingo
2015-08-25 15:05   ` Ludovic Courtès

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.