diff options
author | Xinglu Chen <public@yoctocell.xyz> | 2021-09-17 10:04:49 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-09-18 19:37:45 +0200 |
commit | 59ee10754eddddb99e4a80b9e18aa12ed1b3d77a (patch) | |
tree | 0e5b7e9961218577b7b4f8dcf682f8fec3403cc9 /guix/git.scm | |
parent | 6597f80839142cd341cbf6cee2f34eaf4de14533 (diff) |
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>
Diffstat (limited to 'guix/git.scm')
-rw-r--r-- | guix/git.scm | 41 |
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)))))) ;;; |