From 0b0973034711e15b52702c0aec0c653dfd41928c Mon Sep 17 00:00:00 2001
Message-Id: <0b0973034711e15b52702c0aec0c653dfd41928c.1630800771.git.iskarian@mgsn.dev>
From: Sarah Morgensen <iskarian@mgsn.dev>
Date: Fri, 3 Sep 2021 22:40:02 -0700
Subject: [PATCH] git: Add 'ls-remote-refs'.

---
 guix/git.scm        | 33 +++++++++++++++++++++++++++++++
 guix/import/git.scm | 47 ++++++++++-----------------------------------
 2 files changed, 43 insertions(+), 37 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..b784fd6d20 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -56,6 +56,8 @@
             commit-difference
             commit-relation
 
+            ls-remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+
+;;
+;;; Remote operations.
+;;;
+
+(define* (ls-remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and ref?
+         (or (not tags?) (tag? ref))))
+
+  (with-libgit2
+   (with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+        (remote-disconnect remote)
+        (repository-close! repository)
+
+        (filter include? (map remote-head-name (remote-ls remote))))))))
 
 
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 9a654c1972..097a2f70bc 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -17,7 +17,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix import git)
-  #:use-module (git)
   #:use-module (guix build utils)
   #:use-module (guix diagnostics)
   #:use-module (guix git)
@@ -126,40 +125,15 @@ char-set."
 
 ;;; Updater
 
-(define (get-remote url git-uri)
-  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
-  (let* ((checkout (update-cached-checkout url
-                                           #:recursive?
-                                           (git-reference-recursive? git-uri)))
-         (repository (repository-open checkout)))
-    (remote-lookup repository "origin")))
-
-(define (get-latest-tag remote)
-  "Given a Git REMOTE, return that latest tag available."
-  (remote-connect remote)
-
-  (define tags
-    (sort-tags
-     (map (lambda (tag)
-            (string-drop tag (string-length "refs/tags/")))
-          (filter (lambda (ref)
-                    ;; Every tag has two refs:
-                    ;;
-                    ;; * refs/tags/1.2.3^{}
-                    ;; * refs/tags/1.2.3
-                    ;;
-                    ;; remove the one with the trailing ^{}
-                    (and (not (string-suffix? "^{}" ref))
-                         (string-prefix? "refs/tags/" ref)))
-                  (map (lambda (remote-head)
-                         (remote-head-name remote-head))
-                       (remote-ls remote))))))
-
-  (remote-disconnect remote)
-
-  (if (null? tags)
-      (git-no-tags-error)
-      (last tags)))
+(define (get-latest-tag url)
+  "Return the latest tag available from the Git repository at URL."
+  (let ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                   (ls-remote-refs url #:tags? #t))))
+
+    (if (null? tags)
+        (git-no-tags-error)
+        (last (sort-tags tags)))))
+
 
 (define (latest-git-tag-version package tag-prefix tag-suffix
                                 tag-version-delimiter)
@@ -177,8 +151,7 @@ properties of PACKAGE, returns the latest version of PACKAGE."
     (let* ((source (package-source package))
            (git-uri (origin-uri source))
            (url (git-reference-url (origin-uri source)))
-           (remote (get-remote url git-uri))
-           (latest-tag (get-latest-tag remote)))
+           (latest-tag (get-latest-tag url)))
       (get-version package
                    latest-tag
                    #:prefix tag-prefix

base-commit: 522a3bf99cbc21a9093f63280b9508cd69b94ff0
prerequisite-patch-id: c60e771d96884a78a014e145723562a619c1a0e0
-- 
2.32.0