@@ -62,6 +62,7 @@ (define-module (guix git)
commit-relation
remote-refs
+ lookup-reference
git-checkout
git-checkout?
@@ -628,6 +629,22 @@ (define (commit-relation old new)
;;; Remote operations.
;;;
+;; TODO: it would be nice to use 'remote-create-detached' here,
+;; but that procedure isn't in any released version of guile-git yet.
+(define (call-with-detached-remote url proc)
+ "Call PROC with a remote for URL. The remote is closed after PROC returns."
+ (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-values ((result (proc remote)))
+ ;; Wait until we're finished with the repository before closing it.
+ (remote-disconnect remote)
+ (repository-close! repository)
+ (apply values result))))))
+
(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."
@@ -649,19 +666,33 @@ (define (remote-head->ref remote)
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))))))
+ (call-with-detached-remote
+ url
+ (lambda (remote)
+ (define remote-heads (remote-ls remote))
+ (filter-map remote-head->ref remote-heads)))))
+
+(define* (lookup-reference url reference-name)
+ "Lookup the reference named REFERENCE-NAME advertised at the Git repository
+at URL and return the commit string. If the reference was not found, return
+#false instead."
+ (define (oid->commit oid)
+ (define str (oid->string oid))
+ ;; FIXME: why is the result of oid->string prefixed by 8 zeroes
+ ;; when remote-ls is used? To make hash collisions harder, it would
+ ;; be nice if the commit was not abbreviated.
+ (if (string-prefix? "00000000" str)
+ (string-drop str 8)
+ str))
+ (define (match? remote-head)
+ (string=? reference-name (remote-head-name remote-head)))
+ (with-libgit2
+ (call-with-detached-remote
+ url
+ (lambda (remote)
+ (define remote-heads (remote-ls remote))
+ (define head (find match? remote-heads))
+ (and=> head (compose oid->commit remote-head-oid))))))
;;;
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -189,4 +190,23 @@ (define-module (test-git)
(tag "v1.1" "Release 1.1"))
(remote-refs directory #:tags? #t)))
+(test-equal "lookup-reference: branch and HEAD"
+ '(#true #true)
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (branch "a-branch")
+ (add "b.txt" "B")
+ (commit "Second commit"))
+ (with-repository directory repository
+ ;; See 'oid->commit' in (guix git) for why not string=?.
+ (list (string-prefix?
+ (lookup-reference directory "refs/heads/a-branch")
+ (oid->string
+ (commit-id (find-commit repository "First commit"))))
+ (string-prefix?
+ (lookup-reference directory "HEAD")
+ (oid->string
+ (commit-id (find-commit repository "Second commit"))))))))
+
(test-end "git")
* guix/git.scm (remote-refs): Split off some logic to ... (call-with-detached-remote): ... this new procedure. (lookup-reference): New procedure. * tests/git.scm ("lookup-reference: branch and HEAD"): New test. --- guix/git.scm | 57 +++++++++++++++++++++++++++++++++++++++------------ tests/git.scm | 22 +++++++++++++++++++- 2 files changed, 65 insertions(+), 14 deletions(-)