From debbugs-submit-bounces@debbugs.gnu.org Sun Jan 09 14:10:33 2022 Received: (at 53144) by debbugs.gnu.org; 9 Jan 2022 19:10:34 +0000 Received: from localhost ([127.0.0.1]:51328 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n6daL-0007ku-CD for submit@debbugs.gnu.org; Sun, 09 Jan 2022 14:10:33 -0500 Received: from xavier.telenet-ops.be ([195.130.132.52]:49144) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n6daA-0007iQ-Np for 53144@debbugs.gnu.org; Sun, 09 Jan 2022 14:10:25 -0500 Received: from localhost.localdomain ([188.188.180.65]) by xavier.telenet-ops.be with bizsmtp id gjAG2600J1R3YAc01jANsT; Sun, 09 Jan 2022 20:10:22 +0100 From: Maxime Devos To: 53144@debbugs.gnu.org Subject: [PATCH 11/13] git: Support resolving references without cloning. Date: Sun, 9 Jan 2022 19:10:13 +0000 Message-Id: <20220109191015.33058-11-maximedevos@telenet.be> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220109191015.33058-1-maximedevos@telenet.be> References: <20220109191015.33058-1-maximedevos@telenet.be> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r22; t=1641755422; bh=upQS00ODOcvEJm2qGuFwgCEsZwJgFPknkrfDPqc8QiQ=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=Xm4bycv9tbecohAyHZ1gSCYSsuOzaP3BHnCF9y+43shFHCfpOno5Wq7XzOkD1Bd3C gcIXrANTHLJtoee3rlxbL7+pNdWwrfjN5L2laaKEo0V5jMKEKyFWOjPUGJQX2kZeb+ ymrKik4XHHMoBhZsWn0mvXDTwihp1w+S4LWWwbv1SxQNMXoJebO66DQH52JqbzTHlO /ocoXjvvwcKbvV543GlY1KCRrH12BD/Fr3EN03dUqL0nB9CbjXz+pxP7r5rPvMYrPr zhk4lPE8jhA2w6SNkIJjm7QjKrfC08ZgtKBIqYDlHtmj7D+4XSHh5XADY5pfhWtpF0 ER9pgQ6eVvOhg== X-Spam-Score: 1.3 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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"): [...] Content analysis details: (1.3 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.7 RCVD_IN_DNSWL_LOW RBL: Sender listed at https://www.dnswl.org/, low trust [195.130.132.52 listed in list.dnswl.org] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: yoctocell.xyz (xyz)] -0.0 SPF_PASS SPF: sender matches SPF record 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail provider (maximedevos[at]telenet.be) X-Debbugs-Envelope-To: 53144 Cc: Maxime Devos X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.3 (/) * 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(-) diff --git a/guix/git.scm b/guix/git.scm index 43e85a5026..1c07eba584 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -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)))))) ;;; diff --git a/tests/git.scm b/tests/git.scm index d0646bbc85..f8eaf9e93b 100644 --- a/tests/git.scm +++ b/tests/git.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2020 Ludovic Courtès -;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2022 Maxime Devos ;;; ;;; 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") -- 2.34.0