import: Add 'generic-git' updater.

* guix/git.scm (ls-remote-refs): New procedure.
* tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* tests/import-git.scm: New test file.
* Makefile.am (MODULES, SCM_TESTS): Register the new files.

Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

1 files changed, 41 insertions, 0 deletions

diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..bbff4fc890 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -57,6 +57,8 @@
             commit-difference
             commit-relation
 
+            remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -571,6 +573,45 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+
+;;
+;;; Remote operations.
+;;;
+
+(define* (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? ref)
+         (or (not tags?) (tag? ref))))
+
+  (define (remote-head->ref remote)
+    (let ((name (remote-head-name remote)))
+      (and (include? name)
+           name)))
+
+  (with-libgit2
+   (call-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)
+
+        (let* ((remote-heads (remote-ls remote))
+               (refs (filter-map remote-head->ref remote-heads)))
+          ;; Wait until we're finished with the repository before closing it.
+          (remote-disconnect remote)
+          (repository-close! repository)
+          refs))))))
 
 
 ;;;