From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id iO4UAc5tO2EGHwAAgWs5BA (envelope-from ) for ; Fri, 10 Sep 2021 16:38:06 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id MJqJOM1tO2EZMwAA1q6Kng (envelope-from ) for ; Fri, 10 Sep 2021 14:38:05 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 4635E9D17 for ; Fri, 10 Sep 2021 16:38:05 +0200 (CEST) Received: from localhost ([::1]:55116 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mOhfI-0001YD-Ce for larch@yhetil.org; Fri, 10 Sep 2021 10:38:04 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43022) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mOhdL-00083d-Dj for bug-guix@gnu.org; Fri, 10 Sep 2021 10:36:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55627) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mOhdL-0007fu-6f for bug-guix@gnu.org; Fri, 10 Sep 2021 10:36:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mOhdL-0000fB-42 for bug-guix@gnu.org; Fri, 10 Sep 2021 10:36:03 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#44187: [PATCH 2/3] git: 'update-cached-checkout' can fall back to SWH when cloning. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Fri, 10 Sep 2021 14:36:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 44187 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 44187@debbugs.gnu.org Received: via spool by 44187-submit@debbugs.gnu.org id=B44187.16312845142472 (code B ref 44187); Fri, 10 Sep 2021 14:36:03 +0000 Received: (at 44187) by debbugs.gnu.org; 10 Sep 2021 14:35:14 +0000 Received: from localhost ([127.0.0.1]:38937 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mOhcX-0000dj-Hn for submit@debbugs.gnu.org; Fri, 10 Sep 2021 10:35:13 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53766) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mOhcQ-0000ca-M5 for 44187@debbugs.gnu.org; Fri, 10 Sep 2021 10:35:07 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47280) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mOhcL-0006hG-0v; Fri, 10 Sep 2021 10:35:01 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=47222 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mOhcK-0006Ir-JJ; Fri, 10 Sep 2021 10:35:00 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Fri, 10 Sep 2021 16:34:14 +0200 Message-Id: <20210910143415.14783-3-ludo@gnu.org> X-Mailer: git-send-email 2.33.0 In-Reply-To: <20210910143415.14783-1-ludo@gnu.org> References: <87pn0dk61v.fsf@gnu.org> <20210910143415.14783-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1631284685; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=mP3iNsOUVGSO8eH5ZXvDhM7rmbJC6vLfmkEHQXOrkdM=; b=fqrmeBBxveXDTCaYqUSniM+YIQrGs0kjwrP0qa1H2VMZ3OUQCdtcUjmIlFTVtPBhsvAf78 9Xe9Tv3jxCPksOQ4eZIghPnI7NrF7fgYpBA/BhWtKUQb4iIzmCZ87GbjsdJCWZqJH52tF7 jV18xEUgzG/Ft59zYlpWVrK8PFCv+UZasn3IVWpenI3JsYsHa0EP/voHIjyR+og6NGMocV cJMN02uGe+dC9q/C4WV/uXouqforUXoFUaMQYwwxx9Q/8HkO9f1x3mfIa6QLLN2/gqDBB/ sXgSa4/YXwp8op8V0WIiqimbRJn1TDa7gTe6qiIt5CJR3vp/ugjGLfHg/RUgVw== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1631284685; a=rsa-sha256; cv=none; b=VxRrpG3bVzgA7TbuIfV9GuCTdhdhavo2erpZSmKDsjKEy+y3X3Fowh9rleX4yOGF6KAHx5 2JALej0cHy4pvWykr59DS/hFgumhIB38LJ+L6h31Gy+n2eZjdS1w8XihWiJ/OAaJBeMOqP eZR0KMfIu/o0W8/OR2jYNPeQdhqik5aLyD6NQICxQrq9jix8WZ2TNPMuD66E0unzwjtPq7 LcuEeFReP2AqDsL4ea0vLYKG1OpM3f1Dg2CTd6ttsmNA1gpSoRs9WGKYMv1r0Jv75wA9HZ cEvL2oQ4auht96nbIck+mQlnid+J7uB9/XvSq2RkOB4OAOSMQUbhOBIjKbN6nQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Migadu-Spam-Score: -0.41 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Migadu-Queue-Id: 4635E9D17 X-Spam-Score: -0.41 X-Migadu-Scanner: scn0.migadu.com X-TUID: dx4eyjD0C0E6 From: Ludovic Courtès Fixes . Reported by zimoun . * guix/git.scm (GITERR_HTTP): New variable. (clone-from-swh, clone/swh-fallback): New procedures. (update-cached-checkout): Use 'clone/swh-fallback' instead of 'clone*'. --- guix/git.scm | 42 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) diff --git a/guix/git.scm b/guix/git.scm index acc48fd12f..377e09888a 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -36,6 +36,7 @@ #:use-module (guix sets) #:use-module ((guix diagnostics) #:select (leave)) #:use-module (guix progress) + #:autoload (guix swh) (swh-download) #:use-module (rnrs bytevectors) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -180,6 +181,13 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables." (lambda args (make-fetch-options auth-method))))) +(define GITERR_HTTP + ;; Guile-Git <= 0.5.2 lacks this constant. + (let ((errors (resolve-interface '(git errors)))) + (if (module-defined? errors 'GITERR_HTTP) + (module-ref errors 'GITERR_HTTP) + 34))) + (define (clone* url directory) "Clone git repository at URL into DIRECTORY. Upon failure, make sure no empty directory is left behind." @@ -342,6 +350,38 @@ definitely available in REPOSITORY, false otherwise." (_ #f))) +(define (clone-from-swh url tag-or-commit output) + "Attempt to clone TAG-OR-COMMIT (a string), which originates from URL, using +a copy archived at Software Heritage." + (call-with-temporary-directory + (lambda (bare) + (and (swh-download url tag-or-commit bare + #:archive-type 'git-bare) + (let ((repository (clone* bare output))) + (remote-set-url! repository "origin" url) + repository))))) + +(define (clone/swh-fallback url ref cache-directory) + "Like 'clone', but fallback to Software Heritage if the repository cannot be +found at URL." + (define (inaccessible-url-error? err) + (let ((class (git-error-class err)) + (code (git-error-code err))) + (or (= class GITERR_HTTP) ;404 or similar + (= class GITERR_NET)))) ;unknown host, etc. + + (catch 'git-error + (lambda () + (clone* url cache-directory)) + (lambda (key err) + (match ref + (((or 'commit 'tag-or-commit) . commit) + (if (inaccessible-url-error? err) + (or (clone-from-swh url commit cache-directory) + (throw key err)) + (throw key err))) + (_ (throw key err)))))) + (define cached-checkout-expiration ;; Return the expiration time procedure for a cached checkout. ;; TODO: Honor $GUIX_GIT_CACHE_EXPIRATION. @@ -408,7 +448,7 @@ it unchanged." (let* ((cache-exists? (openable-repository? cache-directory)) (repository (if cache-exists? (repository-open cache-directory) - (clone* url cache-directory)))) + (clone/swh-fallback url ref cache-directory)))) ;; Only fetch remote if it has not been cloned just before. (when (and cache-exists? (not (reference-available? repository ref))) -- 2.33.0