From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:57957) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i9cuC-0002Ii-3d for guix-patches@gnu.org; Sun, 15 Sep 2019 18:22:04 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i9cuB-00078K-1E for guix-patches@gnu.org; Sun, 15 Sep 2019 18:22:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:40022) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1i9cuA-00078A-Ue for guix-patches@gnu.org; Sun, 15 Sep 2019 18:22:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1i9cuA-0007gc-PH for guix-patches@gnu.org; Sun, 15 Sep 2019 18:22:02 -0400 Subject: [bug#37413] [PATCH 2/9] git: 'update-cached-checkout' avoids network access when unnecessary. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Mon, 16 Sep 2019 00:20:59 +0200 Message-Id: <20190915222106.4463-2-ludo@gnu.org> In-Reply-To: <20190915222106.4463-1-ludo@gnu.org> References: <20190915222106.4463-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 37413@debbugs.gnu.org * guix/git.scm (reference-available?): New procedure. (update-cached-checkout): Avoid call to 'remote-fetch' when REPOSITORY already contains REF. --- guix/git.scm | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/guix/git.scm b/guix/git.scm index de98fed40c..92a7353b5a 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -220,6 +220,21 @@ dynamic extent of EXP." (G_ "Support for submodules is missing; \ please upgrade Guile-Git.~%")))) +(define (reference-available? repository ref) + "Return true if REF, a reference such as '(commit . \"cabba9e\"), is +definitely available in REPOSITORY, false otherwise." + (match ref + (('commit . commit) + (catch 'git-error + (lambda () + (->bool (commit-lookup repository (string->oid commit)))) + (lambda (key error . rest) + (if (= GIT_ENOTFOUND (git-error-code error)) + #f + (apply throw key error rest))))) + (_ + #f))) + (define* (update-cached-checkout url #:key (ref '(branch . "master")) @@ -254,7 +269,8 @@ When RECURSIVE? is true, check out submodules as well, if any." (repository-open cache-directory) (clone* url cache-directory)))) ;; Only fetch remote if it has not been cloned just before. - (when cache-exists? + (when (and cache-exists? + (not (reference-available? repository ref))) (remote-fetch (remote-lookup repository "origin"))) (when recursive? (update-submodules repository #:log-port log-port)) -- 2.23.0