From unknown Fri Jul 18 15:28:04 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#69328 <69328@debbugs.gnu.org> To: bug#69328 <69328@debbugs.gnu.org> Subject: Status: [PATCH 00/12] Better source code recovery from SWH Reply-To: bug#69328 <69328@debbugs.gnu.org> Date: Fri, 18 Jul 2025 22:28:04 +0000 retitle 69328 [PATCH 00/12] Better source code recovery from SWH reassign 69328 guix-patches submitter 69328 Ludovic Court=C3=A8s severity 69328 normal tag 69328 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 09:45:18 2024 Received: (at submit) by debbugs.gnu.org; 23 Feb 2024 14:45:18 +0000 Received: from localhost ([127.0.0.1]:42770 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdWnd-0006hh-SO for submit@debbugs.gnu.org; Fri, 23 Feb 2024 09:45:18 -0500 Received: from lists.gnu.org ([209.51.188.17]:38556) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdWna-0006gk-Iv for submit@debbugs.gnu.org; Fri, 23 Feb 2024 09:45:15 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdWSC-0004EU-3j for guix-patches@gnu.org; Fri, 23 Feb 2024 09:23:08 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdWSA-0007Zm-RT; Fri, 23 Feb 2024 09:23:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=RPGOiBrxEfUUfBzRAXv9ylZUKOoCgdm9L8nF7Xr/38c=; b=GiwDIiG4O22zCN Cn+REMys7WfxdstKkaphttTIVak591Omk4OjU2Ez87Xy0NEjRHZxBbsi2X/c2f5FeWkt3x6/WLaB2 yGZV9Hkls6XRCWUhAPGBQQ/hKVQ+juDYzoDo2yF55a1CGagG1u6tgcXRgQ5UCwej12LSD0A9fDKXK hF3QyN5xLCSfszb9wHwW7WSP8XTwJto5j4xOxhLpLlY9IFq0kmJY5DgKwA3pveRr1crdOP3jQieYr 4T1ls1pEhNwX+8w6yLDXustMyOlfo694rieDbGM4CXrgkDlV186fuilLkjpRMDMJQzxxD5u/SoCrz m4Fu/Dqzmap6Ky3mJohg==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: guix-patches@gnu.org Subject: [PATCH 00/12] Better source code recovery from SWH Date: Fri, 23 Feb 2024 15:22:51 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: submit Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Hello Guix! This patch series improves source code recovery from SWH, as a followup to . It does several things: • ‘guix lint -c archival’ now emits save requests for VCSes other than Git. • Fix . • Allow content-addressed recovery of Mercurial and Subversion checkouts. • Allow Bazaar recovery using ‘download-nar’ (I didn’t bother with SWH). • Have all these things honor the ‘GUIX_DOWNLOAD_SEQUENCE’ environment variable. You can try the various methods like this: GUIX_DOWNLOAD_SEQUENCE=nar ./pre-inst-env guix build -S apl --check GUIX_DOWNLOAD_SEQUENCE=swh ./pre-inst-env guix build -S guile-wisp --check GUIX_DOWNLOAD_SEQUENCE=swh ./pre-inst-env guix build -S guile-gcrypt --check In the last case, note that you must be running guix-daemon for the checkout since that uses “builtin:git-download”, which is implemented on the server side. There’s a few caveats: • Mercurial SWH fallback almost works, but not quite, due to this SWH bug: . • Right now, no Subversion checkout has the nar-sha256 ExtID at SWH for unclear reasons, so retrieving the source of ‘apl’ (say) from SWH doesn’t work yet. • Multi-directory Subversion downloads (‘svn-multi-fetch’) is not supported yet. For that we’ll need to arrange with our SWH friends so they compute nar-sha256 ExtIDs for combined directories (and we’ll have to include that info in ‘sources.json’). Feedback welcome! Ludo’. Ludovic Courtès (12): lint: Switch to SRFI-71. lint: archival: Fix crash in non-Git case. lint: archival: Trigger “Save Code Now” for VCSes other than Git. swh: Add ‘type’ field to . swh: ‘origin-visits’ takes an optional ‘max’ parameter. swh: ‘lookup-origin-revision’ handles branches pointing to directories. hg-download: Use ‘swh-download-directory-by-nar-hash’. svn-download: Use ‘swh-download-directory-by-nar-hash’. bzr-download: Implement nar fallback. download-nar: Distinguish ‘output’ and ‘item’ parameter. perform-download: Allow use of ‘download-nar’ for ‘--check’ builds. download: Honor ‘GUIX_DOWNLOAD_SEQUENCE’ environment variable. guix/build/bzr.scm | 3 +- guix/build/download-nar.scm | 12 +-- guix/build/download.scm | 50 +++++++--- guix/build/git.scm | 27 ++++-- guix/bzr-download.scm | 57 ++++++++--- guix/cvs-download.scm | 24 +++-- guix/download.scm | 53 ++++------- guix/git-download.scm | 20 ++-- guix/hg-download.scm | 36 ++++--- guix/lint.scm | 151 +++++++++++++++++++----------- guix/scripts/perform-download.scm | 65 +++++++------ guix/svn-download.scm | 84 +++++++++++------ guix/swh.scm | 71 ++++++++------ tests/lint.scm | 20 ++++ tests/swh.scm | 74 +++++++++++++++ 15 files changed, 501 insertions(+), 246 deletions(-) base-commit: ffcce77ec488e3c89401ad77fafa65fcd9e9f5be -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:20 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:20 +0000 Received: from localhost ([127.0.0.1]:49223 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnY-00024h-Jp for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:20 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52664) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnP-00021e-8W for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:11 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmz-00078n-S6; Fri, 23 Feb 2024 10:48:41 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=G6BugkD26wUOoZWh1+LBXLc9ti+OqXPrxU6iVh4uZ90=; b=Ta5G23yX07hQHt1QmIF9 qz9UL9ztrOrGqfnPCxfkbI1eodCFFVMZaS/HY0RotJOP1MGhOVunnynhMpepr1DsgNEJhDHTZx/r/ qef0JfMb6T0qvnd46wAjgy9Cnk33RJtj9n0DWmoqR0DIIZKXUUpP9nJgTLoQv1J/80dBGmdgOimgs p2mEf4eC0S3MwIyozB3uEWml3s0Q+FitdsCIwcOiCrdn1F2WWwJlhI9RTyLaBWorWWeDqCxrn/iiq XqKZ1Vy24nqQ57bBmHZjSeKLIPvqloUVs4RLJpDc5C/GMQboS+8NEykod1mu+N9NNLWzGvfRRfiVA XG39Ix3ZSwLotQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 09/12] bzr-download: Implement nar fallback. Date: Fri, 23 Feb 2024 16:48:13 +0100 Message-ID: <4e0514fe0f56873a54c4d79245813274a01cbb5b.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/bzr-download.scm (bzr-fetch)[guile-json, guile-lzlib, guile-gnutls]: New variables. [build]: Add ‘with-extensions’ and import more modules. Invoke ‘download-nar’ when ‘bzr-fetch’ returns #f. * guix/build/bzr.scm (bzr-fetch): Actually return #t on success. Change-Id: Id5d4ebd0f9ddc3c44b6456d3b46c0000cc7b9997 --- guix/build/bzr.scm | 3 ++- guix/bzr-download.scm | 43 ++++++++++++++++++++++++++++++++----------- 2 files changed, 34 insertions(+), 12 deletions(-) diff --git a/guix/build/bzr.scm b/guix/build/bzr.scm index a0f5e15880..dede5e031a 100644 --- a/guix/build/bzr.scm +++ b/guix/build/bzr.scm @@ -37,6 +37,7 @@ (define* (bzr-fetch url revision directory (invoke bzr-command "-Ossl.cert_reqs=none" "checkout" "--lightweight" "-r" revision url directory) (with-directory-excursion directory - (delete-file-recursively ".bzr"))) + (delete-file-recursively ".bzr")) + #t) ;;; bzr.scm ends here diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm index d97f84838e..01c12fd54d 100644 --- a/guix/bzr-download.scm +++ b/guix/bzr-download.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2022 Maxim Cournoyer +;;; Copyright © 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,20 +52,40 @@ (define (bzr-package) (module-ref distro 'breezy))) (define* (bzr-fetch ref hash-algo hash - #:optional name - #:key (system (%current-system)) (guile (default-guile)) - (bzr (bzr-package))) + #:optional name + #:key (system (%current-system)) (guile (default-guile)) + (bzr (bzr-package))) "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." + (define guile-json + (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4)) + + (define guile-lzlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib)) + + (define guile-gnutls + (module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls)) + (define build - (with-imported-modules (source-module-closure - '((guix build bzr))) - #~(begin - (use-modules (guix build bzr)) - (bzr-fetch - (getenv "bzr url") (getenv "bzr reference") #$output - #:bzr-command (string-append #+bzr "/bin/brz"))))) + (with-extensions (list guile-gnutls guile-lzlib guile-json) + (with-imported-modules (source-module-closure + '((guix build bzr) + (guix build utils) + (guix build download-nar))) + #~(begin + (use-modules (guix build bzr) + (guix build download-nar) + (guix build utils) + (srfi srfi-34)) + + (or (guard (c ((invoke-error? c) + (report-invoke-error c) + #f)) + (bzr-fetch (getenv "bzr url") (getenv "bzr reference") + #$output + #:bzr-command (string-append #+bzr "/bin/brz"))) + (download-nar #$output)))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "bzr-branch") build @@ -79,7 +100,7 @@ (define* (bzr-fetch ref hash-algo hash "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") #:system system - #:local-build? #t ;don't offload repo branching + #:local-build? #t ;don't offload repo branching #:hash-algo hash-algo #:hash hash #:recursive? #t -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:22 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:22 +0000 Received: from localhost ([127.0.0.1]:49225 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnc-00025F-CD for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52698) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnP-000225-6h for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:12 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmw-00077r-A4; Fri, 23 Feb 2024 10:48:38 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Hucc6WJuBhVi+/2k46omilZnN1Sg3HuEcy/BKiZe2OU=; b=Gl/wa1tyUSWfaz4b2IJ2 DleR22k5hIhi8YgDRV/0OkAZafL7iQLTXGU8izUgg63zCbL5wYlWiXz1mCUpnV5095BW8eXkVgR4t mcNL0HsqyVwKmERYTax+nhqffFYKQnChj5GmcZxLmreTX2X0gweV4nVb4ku08bSHitQl4YqlSREmc s34JA3XqOI9m8MzF3kptiUcCl0i7KM4WUN4J0jK42S51VYnBr/YjQ0oqpD/a2ypLa10zgCN67F69/ CcCN8ZYR7Y9DhC+I6jKGnlSv5tsRXxj/swyLwTfRbMkigqdizED6TSn8uZXgRhKlFfPpN3xs1xpph iCCr21Zzeo1qoA==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 05/12] =?UTF-8?q?swh:=20=E2=80=98origin-visits=E2=80=99=20?= =?UTF-8?q?takes=20an=20optional=20=E2=80=98max=E2=80=99=20parameter.?= Date: Fri, 23 Feb 2024 16:48:09 +0100 Message-ID: <61e6c1cb658fb29ec0a55aca5b57f65597c4ac41.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/swh.scm (origin-visits): Add optional ‘max’ parameter and honor it. Change-Id: I642d7d4b0672b68fb5c7ce2b49161307e13d3c95 --- guix/swh.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/guix/swh.scm b/guix/swh.scm index 83f67423c8..14c65f6806 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -474,10 +474,11 @@ (define* (lookup-directory-by-nar-hash hash #:optional (algorithm 'sha256)) hash) external-id-target)) -(define (origin-visits origin) - "Return the list of visits of ORIGIN, a record as returned by -'lookup-origin'." - (call (swh-url (origin-visits-url origin)) +(define* (origin-visits origin #:optional (max 10)) + "Return the list of the up to MAX latest visits of ORIGIN, a record as +returned by 'lookup-origin'." + (call (string-append (swh-url (origin-visits-url origin)) + "?per_page=" (number->string max)) (lambda (port) (map json->visit (vector->list (json->scm port)))))) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:26 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:26 +0000 Received: from localhost ([127.0.0.1]:49229 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXne-00025Y-9j for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:25 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52678) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnQ-00021h-TU for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:15 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXn1-00079G-Ns; Fri, 23 Feb 2024 10:48:43 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Xd3ynKgR2neJ0oh4LY9MYvQqEdzV/095+EAdboz2Jv8=; b=gaybBXieY41rlaAQ9G6h GdPX8y8RukHmZyRe9ccr20cSBNIjHGJUWy/zsyF+GRO/EwsMXwECMT5r96LLSFIiLT9+zc+ZSSccP ki+rrEpfhpkP7Z/aewBp3Cn2i8EhcJ5wcXS4BWnaBiQ/nCnGcscZtHHMI0zjLj2Iuj4gNqNTiLsc5 bZODqxh44zPD/4bEsI9Cy2Dn3SDE9kD11IJ52EGt8wK8Nc6DW5z8hWxL59I62NdbWF7Kx+84nO1Ge R+9ajt3cspX6zyv4nfe2nIYJnUydYcBf9j0bd866xpp3ORAdMYsNwgRriZzwkqUddm4Cq63+pCaPa cW121hwXBsqpPQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 11/12] =?UTF-8?q?perform-download:=20Allow=20use=20of=20?= =?UTF-8?q?=E2=80=98download-nar=E2=80=99=20for=20=E2=80=98--check?= =?UTF-8?q?=E2=80=99=20builds.?= Date: Fri, 23 Feb 2024 16:48:15 +0100 Message-ID: <25d47583dc9bf21ef918ae400de80fa58e09602c.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Previously, the nar fallback would always fail on ‘--check’ build because the output directory in that case is different from the store file name. This change fixes that. * guix/build/git.scm (git-fetch-with-fallback): Add #:item parameter and pass it to ‘download-nar’. * guix/scripts/perform-download.scm (perform-git-download): Pass #:item to ‘git-fetch-with-fallback’. Change-Id: I30fc948718e99574005150bba5215a51ef153c49 --- guix/build/git.scm | 14 ++++++++------ guix/scripts/perform-download.scm | 3 +++ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/guix/build/git.scm b/guix/build/git.scm index 4c69365a7b..a135026fae 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -92,19 +92,21 @@ (define* (git-fetch url commit directory (define* (git-fetch-with-fallback url commit directory - #:key (git-command "git") + #:key (item directory) + (git-command "git") hash hash-algorithm lfs? recursive?) "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to -alternative methods when fetching from URL fails: attempt to download a nar, -and if that also fails, download from the Software Heritage archive. When -HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of -the directory of interested and are used as its content address at SWH." +alternative methods when fetching from URL fails: attempt to download a nar +for ITEM, and if that also fails, download from the Software Heritage archive. +When HASH and HASH-ALGORITHM are provided, they are interpreted as the nar +hash of the directory of interested and are used as its content address at +SWH." (or (git-fetch url commit directory #:lfs? lfs? #:recursive? recursive? #:git-command git-command) - (download-nar directory) + (download-nar item directory) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index e7eb3b2a1f..b96959a09e 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -114,10 +114,13 @@ (define* (perform-git-download drv output ;; on ambient authority, hence the PATH value below. (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") + ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are + ;; different, hence the #:item argument below. (git-fetch-with-fallback url commit output #:hash hash #:hash-algorithm algo #:recursive? recursive? + #:item (derivation-output-path drv-output) #:git-command %git)))) (define (assert-low-privileges) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:26 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:26 +0000 Received: from localhost ([127.0.0.1]:49233 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXni-000269-2y for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:26 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52694) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnS-00021r-6B for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:16 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXn0-00078w-R6; Fri, 23 Feb 2024 10:48:42 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=r1S7QRxOSIfz/tH9fyNFWCjkYdbX+9xm2B1kmVqebQ0=; b=V6sg8oxMFGm0aCgPVRPc lID+XCzOJ4lD4UEvvA/aiQ5ZxB6r/Ja+pIYT3onwKTR5eLzIHlj3WG9x8URFzJj8r026v8LTyOKqj IfLDnjbZT7tqVHYHWpi7lgTfDiDX3Of0aGumCz22hEnKMCnTGNwyYq/2xiP1OYEd+eGabToJ9Wa05 8idnXDPL43Knf7sga2UV1vfh5S9ACnmAVrSaaXAWyF/JsWB5ZLrX8pTGVh8V3pCeI+caxEXwCt/H/ 0NAuf6WGkSB6Hb624VHYiKAOdvXgSQy8/IHSeYbpW49vmRx8uUj/0WYFHW35iG+YZac6hlmUvM5L0 zau8XL1IamMLmQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 10/12] =?UTF-8?q?download-nar:=20Distinguish=20=E2=80=98ou?= =?UTF-8?q?tput=E2=80=99=20and=20=E2=80=98item=E2=80=99=20parameter.?= Date: Fri, 23 Feb 2024 16:48:14 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This is useful when running a ‘--check’ build, where the output file name differs from the store file name we are trying to restore. * guix/build/download-nar.scm (download-nar): Add ‘output’ parameter and distinguish it from ‘item’. Change-Id: I42219b6d4c8fd1ed506720301384efc1aa351561 --- guix/build/download-nar.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 3ba121b7fb..f26ad28cd0 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2019, 2020 Ludovic Courtès +;;; Copyright © 2017, 2019, 2020, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,9 +57,9 @@ (define (restore-lzipped-nar port item size) (restore-file decompressed-port item)))) -(define (download-nar item) - "Download and extract the normalized archive for ITEM. Return #t on -success, #f otherwise." +(define* (download-nar item #:optional (output item)) + "Download and extract to OUTPUT the normalized archive for ITEM, a store +item. Return #t on success, #f otherwise." ;; Let progress reports go through. (setvbuf (current-error-port) 'none) (setvbuf (current-output-port) 'none) @@ -96,10 +96,10 @@ (define (download-nar item) #:download-size size))) (if (string-contains url "/lzip") (restore-lzipped-nar port-with-progress - item + output size) (restore-file port-with-progress - item))) + output))) (newline) #t)))) (() -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:29 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:29 +0000 Received: from localhost ([127.0.0.1]:49235 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXni-00026I-P7 for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:29 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52700) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnT-00022c-Dd for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:16 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXn3-00079Q-OE; Fri, 23 Feb 2024 10:48:45 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=7dHj5UY6RilYr0GvtapnfIYz21sM8sdq4MjGZ2AXJ9k=; b=Aphfp3JtVa9BE+FaxwpZ O8BfXvvoyRiDCY/VhNdHy4gLWK1E8uB6g9t7sobqFx2pEtePXPD+HV7rTmE3cxQSRzCO0RSfcGjCY yrM2qHVmo3DMx6LMP+ij/fpYO1L4ohUTp6uJ+vmxvNih83kAEaq2aYBeRPl0sYYWTpNJJNVSvsSK1 M4dtHMGVNq9S75mXi+Tj6csjgzKJOf6g7m4gy1oufDXhqhIyU6GoJMhkMEwKeCMgcxHtFCpFG9vSH ZaH5KNLyoSfCYbzIWapP4sbb/SyQwbXB+YSl6KQk8XqFZw4bVhV0j4xKHn6uWqyJkl8d22ZabA4Sp sUORwgpEGk99Ow==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 12/12] =?UTF-8?q?download:=20Honor=20=E2=80=98GUIX=5FDOWNL?= =?UTF-8?q?OAD=5FSEQUENCE=E2=80=99=20environment=20variable.?= Date: Fri, 23 Feb 2024 16:48:16 +0100 Message-ID: <0eafb9b6a14808552c10a4d9d44eef1ec69897f9.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This replaces ‘GUIX_DOWNLOAD_FALLBACK_TEST’ and allows you to test various download methods, like so: GUIX_DOWNLOAD_SEQUENCE=nar guix build guile-gcrypt -S --check GUIX_DOWNLOAD_SEQUENCE=disarchive guix build hello -S --check * guix/build/download.scm (%download-sequence): New variable. (download-method-enabled?): New procedure. (url-fetch): Define ‘initial-uris’; honor ‘download-method-enabled?’. Call ‘disarchive-fetch/any’ only when the 'disarchive method is enabled. * guix/build/git.scm (git-fetch-with-fallback): Honor ‘download-method-enabled?’. * guix/download.scm (%download-sequence): New variable. (%download-fallback-test): Remove. (built-in-download): Add #:download-sequence parameter and honor it. (url-fetch*): Pass #:content-addressed-mirrors and #:disarchive-mirrors unconditionally. * guix/git-download.scm (git-fetch/in-band*): Pass “git url” unconditionally. (git-fetch/built-in): Likewise. Pass “download-sequence”. * guix/bzr-download.scm (bzr-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_SEQUENCE’ to #:env-vars. * guix/cvs-download.scm (cvs-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_SEQUENCE’ to #:env-vars. * guix/hg-download.scm (hg-fetch): Honor ‘download-method-enabled?’. Pass #:env-vars to ‘gexp->derivation’. * guix/scripts/perform-download.scm (perform-download): Honor “download-sequence” from DRV. Parameterize ‘%download-sequence’ before calling ‘url-fetch’. (perform-git-download): Likewise. * guix/svn-download.scm (svn-fetch): Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_SEQUENCE’ to #:env-vars. (svn-multi-fetch): Likewise. Change-Id: Ia3402e17f0303dfa964bdc761265efe8a1dd69ab --- guix/build/download.scm | 50 ++++++++++++++----- guix/build/git.scm | 15 ++++-- guix/bzr-download.scm | 28 +++++++---- guix/cvs-download.scm | 24 +++++++--- guix/download.scm | 53 ++++++++------------ guix/git-download.scm | 20 ++++---- guix/hg-download.scm | 36 +++++++++----- guix/scripts/perform-download.scm | 68 ++++++++++++++------------ guix/svn-download.scm | 80 +++++++++++++++++++------------ 9 files changed, 224 insertions(+), 150 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index db0a39084b..4155a66c1c 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès +;;; Copyright © 2012-2022, 2024 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; Copyright © 2021 Timothy Sample @@ -40,7 +40,10 @@ (define-module (guix build download) #:autoload (guix swh) (swh-download-directory %verify-swh-certificate?) #:use-module (ice-9 match) #:use-module (ice-9 format) - #:export (open-socket-for-uri + #:export (%download-sequence + download-method-enabled? + + open-socket-for-uri open-connection-for-uri http-fetch %x509-certificate-directory @@ -622,6 +625,20 @@ (define-syntax-rule (false-if-exception* body ...) (lambda (key . args) (print-exception (current-error-port) #f key args)))) +(define %download-sequence + ;; Either #f (the default) or a list of symbols denoting the sequence of + ;; download methods to be used--e.g., '(swh nar upstream). + (make-parameter + (and=> (getenv "GUIX_DOWNLOAD_SEQUENCE") + (lambda (str) + (map string->symbol (string-tokenize str)))))) + +(define (download-method-enabled? method) + "Return true if METHOD (a symbol such as 'swh) is enabled as part of the +download fallback sequence." + (or (not (%download-sequence)) + (memq method (%download-sequence)))) + (define (uri-vicinity dir file) "Concatenate DIR, slash, and FILE, keeping only one slash in between. This is required by some HTTP servers." @@ -788,18 +805,28 @@ (define* (url-fetch url file hashes))) disarchive-mirrors)) + (define initial-uris + (append (if (download-method-enabled? 'upstream) + uri + '()) + (if (download-method-enabled? 'content-addressed-mirrors) + content-addressed-uris + '()) + (if (download-method-enabled? 'internet-archive) + (match uri + ((first . _) + (or (and=> (internet-archive-uri first) list) + '())) + (() '())) + '()))) + ;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; means '\n', not '\r', so it's not appropriate here. (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'line) - (let try ((uri (append uri content-addressed-uris - (match uri - ((first . _) - (or (and=> (internet-archive-uri first) list) - '())) - (() '()))))) + (let try ((uri initial-uris)) (match uri ((uri tail ...) (or (fetch uri file) @@ -807,9 +834,10 @@ (define* (url-fetch url file (() ;; If we are looking for a software archive, one last thing we ;; can try is to use Disarchive to assemble it. - (or (disarchive-fetch/any disarchive-uris file - #:verify-certificate? verify-certificate? - #:timeout timeout) + (or (and (download-method-enabled? 'disarchive) + (disarchive-fetch/any disarchive-uris file + #:verify-certificate? verify-certificate? + #:timeout timeout)) (begin (format (current-error-port) "failed to download ~s from ~s~%" file url) diff --git a/guix/build/git.scm b/guix/build/git.scm index a135026fae..62877394bb 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -19,6 +19,8 @@ (define-module (guix build git) #:use-module (guix build utils) + #:use-module ((guix build download) + #:select (download-method-enabled?)) #:autoload (guix build download-nar) (download-nar) #:autoload (guix swh) (%verify-swh-certificate? swh-download @@ -102,17 +104,20 @@ (define* (git-fetch-with-fallback url commit directory When HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of the directory of interested and are used as its content address at SWH." - (or (git-fetch url commit directory - #:lfs? lfs? - #:recursive? recursive? - #:git-command git-command) - (download-nar item directory) + (or (and (download-method-enabled? 'upstream) + (git-fetch url commit directory + #:lfs? lfs? + #:recursive? recursive? + #:git-command git-command)) + (and (download-method-enabled? 'nar) + (download-nar item directory)) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending ;; on nss-certs--we're authenticating the checkout anyway. ;; XXX: Currently recursive checkouts are not supported. (and (not recursive?) + (download-method-enabled? 'swh) (parameterize ((%verify-swh-certificate? #f)) (format (current-error-port) "Trying to download from Software Heritage...~%") diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm index 01c12fd54d..ae8ab8d50e 100644 --- a/guix/bzr-download.scm +++ b/guix/bzr-download.scm @@ -24,7 +24,7 @@ (define-module (guix bzr-download) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) - + #:use-module (ice-9 match) #:export (bzr-reference bzr-reference? bzr-reference-url @@ -72,20 +72,26 @@ (define* (bzr-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build bzr) (guix build utils) + (guix build download) (guix build download-nar))) #~(begin (use-modules (guix build bzr) (guix build download-nar) + ((guix build download) + #:select (download-method-enabled?)) (guix build utils) (srfi srfi-34)) - (or (guard (c ((invoke-error? c) - (report-invoke-error c) - #f)) - (bzr-fetch (getenv "bzr url") (getenv "bzr reference") - #$output - #:bzr-command (string-append #+bzr "/bin/brz"))) - (download-nar #$output)))))) + (or (and (download-method-enabled? 'upstream) + (guard (c ((invoke-error? c) + (report-invoke-error c) + #f)) + (bzr-fetch (getenv "bzr url") (getenv "bzr reference") + #$output + #:bzr-command + (string-append #+bzr "/bin/brz")))) + (and (download-method-enabled? 'nar) + (download-nar #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "bzr-branch") build @@ -95,7 +101,11 @@ (define* (bzr-fetch ref hash-algo hash #:script-name "bzr-download" #:env-vars `(("bzr url" . ,(bzr-reference-url ref)) - ("bzr reference" . ,(bzr-reference-revision ref))) + ("bzr reference" . ,(bzr-reference-revision ref)) + ,@(match (getenv "GUIX_DOWNLOAD_SEQUENCE") + (#f '()) + (value + `(("GUIX_DOWNLOAD_SEQUENCE" . ,value))))) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index c0c526b9db..356c4e9cef 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2015 Mark H Weaver ;;; @@ -73,6 +73,7 @@ (define* (cvs-fetch ref hash-algo hash (define modules (delete '(guix config) (source-module-closure '((guix build cvs) + (guix build download) (guix build download-nar))))) (define build (with-imported-modules modules @@ -80,20 +81,29 @@ (define* (cvs-fetch ref hash-algo hash guile-lzlib) #~(begin (use-modules (guix build cvs) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar)) - (or (cvs-fetch '#$(cvs-reference-root-directory ref) - '#$(cvs-reference-module ref) - '#$(cvs-reference-revision ref) - #$output - #:cvs-command (string-append #+cvs "/bin/cvs")) - (download-nar #$output)))))) + (or (and (download-method-enabled? 'upstream) + (cvs-fetch '#$(cvs-reference-root-directory ref) + '#$(cvs-reference-module ref) + '#$(cvs-reference-revision ref) + #$output + #:cvs-command + #+(file-append cvs "/bin/cvs"))) + (and (download-method-enabled? 'nar) + (download-nar #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") + #:env-vars (match (getenv "GUIX_DOWNLOAD_SEQUENCE") + (#f '()) + (value + `(("GUIX_DOWNLOAD_SEQUENCE" . ,value)))) #:system system #:hash-algo hash-algo #:hash hash diff --git a/guix/download.scm b/guix/download.scm index 21d02ab203..38621a4803 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2021, 2024 Ludovic Courtès ;;; Copyright © 2013, 2014, 2015 Andreas Enge ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2016 Alex Griffin @@ -35,9 +35,9 @@ (define-module (guix download) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (%mirrors + #:export (%download-sequence + %mirrors %disarchive-mirrors - %download-fallback-test (url-fetch* . url-fetch) url-fetch/executable url-fetch/tarbomb @@ -434,10 +434,19 @@ (define %no-disarchive-mirrors-file (define built-in-builders* (store-lift built-in-builders)) +(define %download-sequence + ;; Either #f (the default) or a list of symbols denoting the sequence of + ;; download methods to be used--e.g., '(swh nar upstream). + (make-parameter + (and=> (getenv "GUIX_DOWNLOAD_SEQUENCE") + (lambda (str) + (map string->symbol (string-tokenize str)))))) + (define* (built-in-download file-name url #:key system hash-algo hash mirrors content-addressed-mirrors disarchive-mirrors + (download-sequence (%download-sequence)) executable? (guile 'unused)) "Download FILE-NAME from URL using the built-in 'download' builder. When @@ -471,6 +480,11 @@ (define* (built-in-download file-name url ("disarchive-mirrors" . ,disarchive-mirrors) ,@(if executable? '(("executable" . "1")) + '()) + ,@(if download-sequence + `(("download-sequence" + . ,(object->string + download-sequence))) '())) ;; Do not offload this derivation because we cannot be @@ -479,24 +493,6 @@ (define* (built-in-download file-name url ;; for that built-in is widespread. #:local-build? #t))) -(define %download-fallback-test - ;; Define whether to test one of the download fallback mechanism. Possible - ;; values are: - ;; - ;; - #f, to use the normal download methods, not trying to exercise the - ;; fallback mechanism; - ;; - ;; - 'none, to disable all the fallback mechanisms; - ;; - ;; - 'content-addressed-mirrors, to purposefully attempt to download from - ;; a content-addressed mirror; - ;; - ;; - 'disarchive-mirrors, to download from Disarchive + Software Heritage. - ;; - ;; This is meant to be used for testing purposes. - (make-parameter (and=> (getenv "GUIX_DOWNLOAD_FALLBACK_TEST") - string->symbol))) - (define* (url-fetch* url hash-algo hash #:optional name #:key (system (%current-system)) @@ -532,10 +528,7 @@ (define* (url-fetch* url hash-algo hash (unless (member "download" builtins) (error "'guix-daemon' is too old, please upgrade" builtins)) - (built-in-download (or name file-name) - (match (%download-fallback-test) - ((or #f 'none) url) - (_ "https://example.org/does-not-exist")) + (built-in-download (or name file-name) url #:guile guile #:system system #:hash-algo hash-algo @@ -543,15 +536,9 @@ (define* (url-fetch* url hash-algo hash #:executable? executable? #:mirrors %mirror-file #:content-addressed-mirrors - (match (%download-fallback-test) - ((or #f 'content-addressed-mirrors) - %content-addressed-mirror-file) - (_ %no-mirrors-file)) + %content-addressed-mirror-file #:disarchive-mirrors - (match (%download-fallback-test) - ((or #f 'disarchive-mirrors) - %disarchive-mirror-file) - (_ %no-disarchive-mirrors-file))))))) + %disarchive-mirror-file))))) (define* (url-fetch/executable url hash-algo hash #:optional name diff --git a/guix/git-download.scm b/guix/git-download.scm index aadcbd234c..6f82712999 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -29,8 +29,8 @@ (define-module (guix git-download) #:use-module (guix packages) #:use-module (guix modules) #:use-module ((guix derivations) #:select (raw-derivation)) + #:autoload (guix download) (%download-sequence) #:autoload (guix build-system gnu) (standard-packages) - #:autoload (guix download) (%download-fallback-test) #:autoload (git bindings) (libgit2-init!) #:autoload (git repository) (repository-open repository-close! @@ -180,11 +180,7 @@ (define* (git-fetch/in-band* ref hash-algo hash ;; downloads. #:script-name "git-download" #:env-vars - `(("git url" . ,(match (%download-fallback-test) - ('content-addressed-mirrors - "https://example.org/does-not-exist") - (_ - (git-reference-url ref)))) + `(("git url" . ,(git-reference-url ref)) ("git commit" . ,(git-reference-commit ref)) ("git recursive?" . ,(object->string (git-reference-recursive? ref))) @@ -246,14 +242,14 @@ (define* (git-fetch/built-in ref hash-algo hash #:recursive? #t #:env-vars `(("url" . ,(object->string - (match (%download-fallback-test) - ('content-addressed-mirrors - "https://example.org/does-not-exist") - (_ - (git-reference-url ref))))) + (git-reference-url ref))) ("commit" . ,(git-reference-commit ref)) ("recursive?" . ,(object->string - (git-reference-recursive? ref)))) + (git-reference-recursive? ref))) + ,@(if (%download-sequence) + `(("download-sequence" + . ,(object->string (%download-sequence)))) + '())) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") diff --git a/guix/hg-download.scm b/guix/hg-download.scm index dd28d9c244..d49732ba63 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -84,6 +84,7 @@ (define* (hg-fetch ref hash-algo hash (define modules (delete '(guix config) (source-module-closure '((guix build hg) + (guix build download) (guix build download-nar) (guix swh))))) @@ -94,6 +95,8 @@ (define* (hg-fetch ref hash-algo hash #~(begin (use-modules (guix build hg) (guix build utils) ;for `set-path-environment-variable' + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (ice-9 match)) @@ -106,28 +109,35 @@ (define* (hg-fetch ref hash-algo hash (setvbuf (current-output-port) 'line) (setvbuf (current-error-port) 'line) - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output) + (or (and (download-method-enabled? 'upstream) + (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg"))) + (and (download-method-enabled? 'nar) + (download-nar #$output)) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending ;; on nss-certs--we're authenticating the checkout anyway. - (parameterize ((%verify-swh-certificate? #f)) - (format (current-error-port) - "Trying to download from Software Heritage...~%") - (or (swh-download-directory-by-nar-hash #$hash '#$hash-algo - #$output) - (swh-download #$(hg-reference-url ref) - #$(hg-reference-changeset ref) - #$output)))))))) + (and (download-method-enabled? 'swh) + (parameterize ((%verify-swh-certificate? #f)) + (format (current-error-port) + "Trying to download from Software Heritage...~%") + (or (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output) + (swh-download #$(hg-reference-url ref) + #$(hg-reference-changeset ref) + #$output))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") + #:env-vars (match (getenv "GUIX_DOWNLOAD_SEQUENCE") + (#f '()) + (value + `(("GUIX_DOWNLOAD_SEQUENCE" . ,value)))) #:system system #:local-build? #t ;don't offload repo cloning #:hash-algo hash-algo diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index b96959a09e..250b1c2b48 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -21,7 +21,7 @@ (define-module (guix scripts perform-download) #:use-module (guix scripts) #:use-module (guix derivations) #:use-module ((guix store) #:select (derivation-path? store-path?)) - #:autoload (guix build download) (url-fetch) + #:autoload (guix build download) (%download-sequence url-fetch) #:autoload (guix build git) (git-fetch-with-fallback) #:autoload (guix config) (%git) #:use-module (ice-9 match) @@ -55,7 +55,8 @@ (define* (perform-download drv output (executable "executable") (mirrors "mirrors") (content-addressed-mirrors "content-addressed-mirrors") - (disarchive-mirrors "disarchive-mirrors")) + (disarchive-mirrors "disarchive-mirrors") + (download-sequence "download-sequence")) (unless url (leave (G_ "~a: missing URL~%") (derivation-file-name drv))) @@ -64,26 +65,30 @@ (define* (perform-download drv output (algo (derivation-output-hash-algo drv-output)) (hash (derivation-output-hash drv-output))) ;; We're invoked by the daemon, which gives us write access to OUTPUT. - (when (url-fetch url output - #:print-build-trace? print-build-trace? - #:mirrors (if mirrors - (call-with-input-file mirrors read) - '()) - #:content-addressed-mirrors - (if content-addressed-mirrors - (call-with-input-file content-addressed-mirrors - (lambda (port) - (eval (read port) %user-module))) - '()) - #:disarchive-mirrors - (if disarchive-mirrors - (call-with-input-file disarchive-mirrors read) - '()) - #:hashes `((,algo . ,hash)) + (when (parameterize ((%download-sequence + (and download-sequence + (call-with-input-string download-sequence + read)))) + (url-fetch url output + #:print-build-trace? print-build-trace? + #:mirrors (if mirrors + (call-with-input-file mirrors read) + '()) + #:content-addressed-mirrors + (if content-addressed-mirrors + (call-with-input-file content-addressed-mirrors + (lambda (port) + (eval (read port) %user-module))) + '()) + #:disarchive-mirrors + (if disarchive-mirrors + (call-with-input-file disarchive-mirrors read) + '()) + #:hashes `((,algo . ,hash)) - ;; Since DRV's output hash is known, X.509 certificate - ;; validation is pointless. - #:verify-certificate? #f) + ;; Since DRV's output hash is known, X.509 certificate + ;; validation is pointless. + #:verify-certificate? #f)) (when (and executable (string=? executable "1")) (chmod output #o755)))))) @@ -96,7 +101,8 @@ (define* (perform-git-download drv output 'bmRepair' builds." (derivation-let drv ((url "url") (commit "commit") - (recursive? "recursive?")) + (recursive? "recursive?") + (download-sequence "download-sequence")) (unless url (leave (G_ "~a: missing Git URL~%") (derivation-file-name drv))) (unless commit @@ -114,14 +120,16 @@ (define* (perform-git-download drv output ;; on ambient authority, hence the PATH value below. (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") - ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are - ;; different, hence the #:item argument below. - (git-fetch-with-fallback url commit output - #:hash hash - #:hash-algorithm algo - #:recursive? recursive? - #:item (derivation-output-path drv-output) - #:git-command %git)))) + (parameterize ((%download-sequence + (and download-sequence + (call-with-input-string download-sequence + read)))) + (git-fetch-with-fallback url commit output + #:hash hash + #:hash-algorithm algo + #:recursive? recursive? + #:item (derivation-output-path drv-output) + #:git-command %git))))) (define (assert-low-privileges) (when (zero? (getuid)) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index ed1379a09e..beac7d34e3 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -93,6 +93,7 @@ (define* (svn-fetch ref hash-algo hash (define build (with-imported-modules (source-module-closure '((guix build svn) + (guix build download) (guix build download-nar) (guix build utils) (guix swh))) @@ -100,23 +101,28 @@ (define* (svn-fetch ref hash-algo hash guile-lzlib) #~(begin (use-modules (guix build svn) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (ice-9 match)) - (or (svn-fetch (getenv "svn url") - (string->number (getenv "svn revision")) - #$output - #:svn-command #+(file-append svn "/bin/svn") - #:recursive? (match (getenv "svn recursive?") - ("yes" #t) - (_ #f)) - #:user-name (getenv "svn user name") - #:password (getenv "svn password")) - (download-nar #$output) - (parameterize ((%verify-swh-certificate? #f)) - (swh-download-directory-by-nar-hash #$hash '#$hash-algo - #$output))))))) + (or (and (download-method-enabled? 'upstream) + (svn-fetch (getenv "svn url") + (string->number (getenv "svn revision")) + #$output + #:svn-command #+(file-append svn "/bin/svn") + #:recursive? (match (getenv "svn recursive?") + ("yes" #t) + (_ #f)) + #:user-name (getenv "svn user name") + #:password (getenv "svn password"))) + (and (download-method-enabled? 'nar) + (download-nar #$output)) + (and (download-method-enabled? 'swh) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output)))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -139,7 +145,11 @@ (define* (svn-fetch ref hash-algo hash ,@(if (svn-reference-password ref) `(("svn password" . ,(svn-reference-password ref))) - '())) + '()) + ,@(match (getenv "GUIX_DOWNLOAD_SEQUENCE") + (#f '()) + (value + `(("GUIX_DOWNLOAD_SEQUENCE" . ,value))))) #:system system #:hash-algo hash-algo @@ -178,6 +188,7 @@ (define* (svn-multi-fetch ref hash-algo hash (define build (with-imported-modules (source-module-closure '((guix build svn) + (guix build download) (guix build download-nar) (guix build utils) (guix swh))) @@ -186,6 +197,8 @@ (define* (svn-multi-fetch ref hash-algo hash #~(begin (use-modules (guix build svn) (guix build utils) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (srfi srfi-1) @@ -197,26 +210,29 @@ (define* (svn-multi-fetch ref hash-algo hash ;; single file. (unless (string-suffix? "/" location) (mkdir-p (string-append #$output "/" (dirname location)))) - (svn-fetch (string-append (getenv "svn url") "/" location) - (string->number (getenv "svn revision")) - (if (string-suffix? "/" location) - (string-append #$output "/" location) - (string-append #$output "/" (dirname location))) - #:svn-command #+(file-append svn "/bin/svn") - #:recursive? (match (getenv "svn recursive?") - ("yes" #t) - (_ #f)) - #:user-name (getenv "svn user name") - #:password (getenv "svn password"))) + (and (download-method-enabled? 'upstream) + (svn-fetch (string-append (getenv "svn url") "/" location) + (string->number (getenv "svn revision")) + (if (string-suffix? "/" location) + (string-append #$output "/" location) + (string-append #$output "/" (dirname location))) + #:svn-command #+(file-append svn "/bin/svn") + #:recursive? (match (getenv "svn recursive?") + ("yes" #t) + (_ #f)) + #:user-name (getenv "svn user name") + #:password (getenv "svn password")))) (call-with-input-string (getenv "svn locations") read)) (begin (when (file-exists? #$output) (delete-file-recursively #$output)) - (or (download-nar #$output) - (parameterize ((%verify-swh-certificate? #f)) - (swh-download-directory-by-nar-hash - #$hash '#$hash-algo #$output))))))))) + (or (and (download-method-enabled? 'nar) + (download-nar #$output)) + (and (download-method-enabled? 'swh) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output)))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -241,7 +257,11 @@ (define* (svn-multi-fetch ref hash-algo hash ,@(if (svn-multi-reference-password ref) `(("svn password" . ,(svn-multi-reference-password ref))) - '())) + '()) + ,@(match (getenv "GUIX_DOWNLOAD_SEQUENCE") + (#f '()) + (value + `(("GUIX_DOWNLOAD_SEQUENCE" . ,value))))) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:53 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:53 +0000 Received: from localhost ([127.0.0.1]:49267 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXo8-00028x-BC for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:53 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52664) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnT-00021e-Vf for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:17 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmy-00078d-VK; Fri, 23 Feb 2024 10:48:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=YG+rtnIuKx/Un+nAQdeNMWun03XC1rasPRf76idEaTg=; b=lW1QFcPwxKzEEsKc2CHu kYc8+TZEyuV15ulFlnQFBbIw+NnGnQtN+1B2BfBo8E/swRaFuNZ8QuvcG10XUcuJMI1Ks6SO4qB9J 1+rnRUYDzKMapy5L63hYXeyzJqLykQFjG1PuLStpqXAnL3GbW6CG333Da1LAlwMwuIPWzdr8RcyZ6 punHKPKMrkcYB+HS7giGWDLNOo3LsyZLUzmUOXY4hT3ZUUanE/LhhpYr70zzu4nIgx1ndDb/YF+co Kad2BaoH+7s0Rc9x2+kJMzSwfcWUYSXoYE3V3ik++nMVnOp55anaFtO8PSLaXW/8HOBPiOxjknAV4 O7J1B/0OuLNIDg==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 08/12] =?UTF-8?q?svn-download:=20Use=20=E2=80=98swh-downlo?= =?UTF-8?q?ad-directory-by-nar-hash=E2=80=99.?= Date: Fri, 23 Feb 2024 16:48:12 +0100 Message-ID: <39b18f26579e05e76613f0be62dd4d70860b4876.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes . * guix/svn-download.scm (svn-fetch)[build]: Add ‘swh-download-directory-by-nar-hash’ call as a last resort. Import (guix swh). * guix/svn-download.scm (svn-multi-fetch)[build]: Likewise. Change-Id: Ifcb9be1e9c2b05ce172c44e45dcf3a3ea6df8e76 --- guix/svn-download.scm | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index c6688908de..ed1379a09e 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2016, 2019, 2021-2023 Ludovic Courtès +;;; Copyright © 2014-2016, 2019, 2021-2024 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus ;;; @@ -94,12 +94,14 @@ (define* (svn-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build svn) (guix build download-nar) - (guix build utils))) + (guix build utils) + (guix swh))) (with-extensions (list guile-json guile-gnutls ;for (guix swh) guile-lzlib) #~(begin (use-modules (guix build svn) (guix build download-nar) + (guix swh) (ice-9 match)) (or (svn-fetch (getenv "svn url") @@ -111,7 +113,10 @@ (define* (svn-fetch ref hash-algo hash (_ #f)) #:user-name (getenv "svn user name") #:password (getenv "svn password")) - (download-nar #$output)))))) + (download-nar #$output) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -174,13 +179,15 @@ (define* (svn-multi-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build svn) (guix build download-nar) - (guix build utils))) + (guix build utils) + (guix swh))) (with-extensions (list guile-json guile-gnutls ;for (guix swh) guile-lzlib) #~(begin (use-modules (guix build svn) (guix build utils) (guix build download-nar) + (guix swh) (srfi srfi-1) (ice-9 match)) @@ -206,7 +213,10 @@ (define* (svn-multi-fetch ref hash-algo hash (begin (when (file-exists? #$output) (delete-file-recursively #$output)) - (download-nar #$output))))))) + (or (download-nar #$output) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:55 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:55 +0000 Received: from localhost ([127.0.0.1]:49270 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXo9-000294-JB for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:55 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52698) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnU-000225-7B for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:17 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmy-00078U-3K; Fri, 23 Feb 2024 10:48:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=tn7XnRlT0ne20UQYW6HkO1+8mS23Op5Nm/U0W5j/K4I=; b=CYBZ7IgZGeJYlCHHxeQP s0hSWx10JCpyssemYvhH1tPGowXpy8Ywqzzp6DOXUbf6gW/bZIQu6CXk9XhoGnCDaBXb5nuVXchTv OpiwAtP5uW5DJzZE251W/dmYIivmzrl9Piz62fsEKxptxt18JJs4B3inLGZDlpiATOsju4ZgWwqjS 88PZtVYSVycBg+HrAlojas8gi3zfgFKoocF08MybFA2Ys0aQ5vcXwl9PlqVIThDBsp7ROasKfUtw0 O0ZYIyxOCQ4HNsdvGzVdkBRZGLHvMuD8gdLZPkCHRvIIVY/9fy+VKC5l/EOSe6SCwtDBhzHk0VhTI kiYttEdavbHaIA==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 07/12] =?UTF-8?q?hg-download:=20Use=20=E2=80=98swh-downloa?= =?UTF-8?q?d-directory-by-nar-hash=E2=80=99.?= Date: Fri, 23 Feb 2024 16:48:11 +0100 Message-ID: <23d5acc774d3b0cff08026cad1a025248c6cc80b.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This allows content-addressed access to the checkout, which is preferable. * guix/hg-download.scm (hg-fetch): Add call to ‘swh-download-directory-by-nar-hash’ before ‘swh-download’ call. Change-Id: I2afc8badc1f8bb2c8bdd3a47abbb72d455d93e64 --- guix/hg-download.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 6d02de47e4..dd28d9c244 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès ;;; Copyright © 2016 Ricardo Wurmus ;;; Copyright © 2021 Xinglu Chen ;;; @@ -117,9 +117,11 @@ (define* (hg-fetch ref hash-algo hash (parameterize ((%verify-swh-certificate? #f)) (format (current-error-port) "Trying to download from Software Heritage...~%") - (swh-download #$(hg-reference-url ref) - #$(hg-reference-changeset ref) - #$output))))))) + (or (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output) + (swh-download #$(hg-reference-url ref) + #$(hg-reference-changeset ref) + #$output)))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:49:59 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:49:59 +0000 Received: from localhost ([127.0.0.1]:49275 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXoB-00029M-IX for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:59 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52678) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnY-00021h-AL for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:19 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmu-00077X-Ij; Fri, 23 Feb 2024 10:48:36 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=J2NKJ/7s0Llg3irvfcBHgHZYrMwIa3sokuS2T42kAy8=; b=FnxrxNhRzNWrQoSwGTjf PP2MU1s0Pv5G1pDmYdgplQwmCRRP0X4hvE+vYCS8BXrtoIyQUHrtFkgpb+52EPYYwn043Q3rTExNr CvEoumbIK3pYKVoJcMPfF9O8iNwMMxeETpcePGcgCHfUAwxBOeQYHkDA5+LKSjToo1hUSx04QiP3b w0C3IygrxsMRoCc2uy5/IjPGI4kXT5toZ/fR8ZK/PGYU2Sy34Vtjz8XR5eutEiZju6cGKdz8Zmae5 TYbgc11ytvPqIj1ifRHzwSeG5fo+7nYMgzYk7Go1j3Y6ciV0c84UtNFtgY9f6ehbNQvB6Xb7Ki5HI xpMfaOJbWafbzQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 03/12] =?UTF-8?q?lint:=20archival:=20Trigger=20=E2=80=9CSa?= =?UTF-8?q?ve=20Code=20Now=E2=80=9D=20for=20VCSes=20other=20than=20Git.?= Date: Fri, 23 Feb 2024 16:48:07 +0100 Message-ID: <38211161ee2bf6fbaab40362ebd654dc1cbad986.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) From: Ludovic Courtès Until now, ‘save-origin’ would be called only when given a . With this change, ‘save-origin’ gets called for other version control systems as well. * guix/lint.scm (swh-response->warning): New procedure, formerly in ‘check-archival’. (vcs-origin, save-package-source): New procedures. (check-archival)[response->warning]: Remove. Call ‘save-package-source’ in both the Git and the non-Git cases. * tests/lint.scm ("archival: missing svn revision"): New test. Change-Id: I535e4ec89488faf83bfa544d5e4935fa73ef54fb --- guix/lint.scm | 140 +++++++++++++++++++++++++++++++------------------ tests/lint.scm | 20 +++++++ 2 files changed, 109 insertions(+), 51 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index ad84048660..68d532968d 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -67,6 +67,10 @@ (define-module (guix lint) svn-multi-reference-url svn-multi-reference-user-name svn-multi-reference-password) + #:autoload (guix hg-download) (hg-reference? + hg-reference-url) + #:autoload (guix bzr-download) (bzr-reference? + bzr-reference-url) #:use-module (guix import stackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -1632,6 +1636,69 @@ (define (lookup-disarchive-spec hash) (extract-swh-id spec))))) %disarchive-mirrors)) +(define (swh-response->warning package url method response) + "Given RESPONSE, the response of METHOD on URL, return a suitable warning +list for PACKAGE." + (if (request-rate-limit-reached? url method) + (list (make-warning package + (G_ "Software Heritage rate limit reached; \ +try again later") + #:field 'source)) + (list (make-warning package + (G_ "'~a' returned ~a") + (list url (response-code response)) + #:field 'source)))) + +(define (vcs-origin origin) + "Return two values: the URL and type (a string) of the version-control used +for ORIGIN. Return #f and #f if ORIGIN is not a version-control checkout." + (match (and=> origin origin-uri) + ((? git-reference? ref) + (values (git-reference-url ref) "git")) + ((? svn-reference? ref) + (values (svn-reference-url ref) "svn")) + ((? svn-multi-reference? ref) + (values (svn-multi-reference-url ref) "svn")) + ((? hg-reference? ref) + (values (hg-reference-url ref) "hg")) + ((? bzr-reference? ref) + (values (bzr-reference-url ref) "bzr")) + ;; XXX: Not sure what to do with the weird CVS URIs (:pserver: etc.). + (_ + (values #f #f)))) + +(define (save-package-source package) + "Attempt to save the source of PACKAGE on SWH. Return a list of warnings." + (let* ((origin (package-source package)) + (url type (if origin (vcs-origin origin) (values #f #f)))) + (cond ((and url type) + (catch 'swh-error + (lambda () + (save-origin url type) + (list (make-warning + package + ;; TRANSLATORS: "Software Heritage" is a proper noun that + ;; must remain untranslated. See + ;; . + (G_ "scheduled Software Heritage archival") + #:field 'source))) + (lambda (key url method response . _) + (cond ((= 429 (response-code response)) + (list (make-warning + package + (G_ "archival rate limit exceeded; \ +try again later") + #:field 'source))) + (else + (swh-response->warning package url method response)))))) + ((not origin) + '()) + (else + (list (make-warning + package + (G_ "source code cannot be archived") + #:field 'source)))))) + (define (check-archival package) "Check whether PACKAGE's source code is archived on Software Heritage. If it's not, and if its source code is a VCS snapshot, then send a \"save\" @@ -1640,17 +1707,6 @@ (define (check-archival package) Software Heritage imposes limits on the request rate per client IP address. This checker prints a notice and stops doing anything once that limit has been reached." - (define (response->warning url method response) - (if (request-rate-limit-reached? url method) - (list (make-warning package - (G_ "Software Heritage rate limit reached; \ -try again later") - #:field 'source)) - (list (make-warning package - (G_ "'~a' returned ~a") - (list url (response-code response)) - #:field 'source)))) - (define skip-key (gensym "skip-archival-check")) (define (skip-when-limit-reached url method) @@ -1685,28 +1741,8 @@ (define (check-archival package) '()) (#f ;; Revision is missing from the archive, attempt to save it. - (catch 'swh-error - (lambda () - (save-origin (git-reference-url reference) "git") - (list (make-warning - package - ;; TRANSLATORS: "Software Heritage" is a proper noun - ;; that must remain untranslated. See - ;; . - (G_ "scheduled Software Heritage archival") - #:field 'source))) - (lambda (key url method response . _) - (cond ((= 429 (response-code response)) - (list (make-warning - package - (G_ "archival rate limit exceeded; \ -try again later") - #:field 'source))) - (else - (response->warning url method response)))))))) + (save-package-source package)))) ((? origin? origin) - ;; Since "save" origins are not supported for non-VCS source, all - ;; we can do is tell whether a given tarball is available or not. (if (and=> (origin-hash origin) ;XXX: for ungoogled-chromium content-hash-value) ;& icecat (let ((hash (origin-hash origin))) @@ -1715,26 +1751,28 @@ (define (check-archival package) (symbol->string (content-hash-algorithm hash)))) (#f - ;; If SWH doesn't have HASH as is, it may be because it's - ;; a hand-crafted tarball. In that case, check whether - ;; the Disarchive database has an entry for that tarball. - (match (lookup-disarchive-spec hash) - (#f - (list (make-warning package - (G_ "source not archived on Software \ + ;; If ORIGIN is a version-control checkout, save it now. + ;; If not, check whether HASH is in the Disarchive + ;; database ("Save Code Now" does not accept tarballs). + (if (vcs-origin origin) + (save-package-source package) + (match (lookup-disarchive-spec hash) + (#f + (list (make-warning package + (G_ "source not archived on Software \ Heritage and missing from the Disarchive database") - #:field 'source))) - (directory-ids - (match (find (lambda (id) - (not (lookup-directory id))) - directory-ids) - (#f '()) - (id - (list (make-warning package - (G_ "\ + #:field 'source))) + (directory-ids + (match (find (lambda (id) + (not (lookup-directory id))) + directory-ids) + (#f '()) + (id + (list (make-warning package + (G_ "\ Disarchive entry refers to non-existent SWH directory '~a'") - (list id) - #:field 'source))))))) + (list id) + #:field 'source)))))))) ((? content?) '()) ((? string? swhid) @@ -1749,7 +1787,7 @@ (define (check-archival package) #:field 'source))))) (match-lambda* (('swh-error url method response) - (response->warning url method response)) + (swh-response->warning package url method response)) ((key . args) (if (eq? key skip-key) '() diff --git a/tests/lint.scm b/tests/lint.scm index 87213fcc78..95d82d7490 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1407,6 +1407,26 @@ (define (package-with-phase-changes changes) (check-archival (dummy-package "x" (source origin))))))) (warning-contains? "scheduled" warnings))) +(test-assert "archival: missing svn revision" + (let* ((origin (origin + (method svn-fetch) + (uri (svn-reference + (url "http://example.org/svn/foo") + (revision "1234"))) + (sha256 (make-bytevector 32)))) + ;; https://archive.softwareheritage.org/api/1/origin/save/ + (save "{ \"origin_url\": \"http://example.org/svn/foo\", + \"save_request_date\": \"2014-11-17T22:09:38+01:00\", + \"save_request_status\": \"accepted\", + \"save_task_status\": \"scheduled\" }") + (warnings (with-http-server `((404 "No extid.") ;lookup-directory-by-nar-hash + (404 "No revision.") ;lookup-revision + (404 "No origin.") ;lookup-origin + (200 ,save)) ;save-origin + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin))))))) + (warning-contains? "scheduled" warnings))) + (test-equal "archival: revision available" '() (let* ((origin (origin -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:54:41 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:54:41 +0000 Received: from localhost ([127.0.0.1]:49620 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXsk-0002PA-PY for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:54:41 -0500 Received: from eggs.gnu.org ([209.51.188.92]:48830) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXse-0002OY-9I for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:54:37 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXsA-00086q-DH; Fri, 23 Feb 2024 10:54:02 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=l0vMBEjcenQdIY3HrUrHuZMK16q317LRoWbANLQfTsM=; b=Dz8uGAI33sFu6F7dJmwb DMP3IUhwWIQ6/MC/CZUsNuZOSFRlMMHX32knIKzpazHmlPr5e+FD5K8wide/rvSHkSNegKajCzesA CVIijGZtY1IpS0wGWkCg/Y2LULnJbJhd9Ai9uc04GuRxS//hKGPT1L11ZJfFvIDz/mWCmGoYTtyXp Zk81aRh+hv2aZXyCG2bB7ymtj9aGoDhbj8zN2UlLDm3cytBtaagm8gKo3QbqijHd9lhvwAneNSDFy egYJi1vTYmWY9uJOC1DWKyCWJbWWg7Od16GNmf6Mlbzzwetjn5IkinsXjTlZb31hd0NzpmncsmC6E uz318EHd1MmJDQ==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: Re: [bug#69328] [PATCH 00/12] Better source code recovery from SWH In-Reply-To: ("Ludovic =?utf-8?Q?Court?= =?utf-8?Q?=C3=A8s=22's?= message of "Fri, 23 Feb 2024 15:22:51 +0100") References: Date: Fri, 23 Feb 2024 16:53:58 +0100 Message-ID: <87bk87gort.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample 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: -3.3 (---) I forgot to Cc: you Timothy, but you may have useful feedback to give on this series: . (Should we create a =E2=80=98source-code-archival=E2=80=99 team?) From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:55:30 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:55:31 +0000 Received: from localhost ([127.0.0.1]:49672 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXtZ-0002S4-7Y for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:55:30 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52664) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnM-00021e-J1 for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:06 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmt-000773-0K; Fri, 23 Feb 2024 10:48:35 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=jE72jc8CNzz9m9Fcp3dz6S+FjFst2TTCXkUasSQYmuc=; b=ZyN0DU3CbErSf7ObEa8o 08RQZ6LH4OlFoTzXCD3Fab33C2Sxk/2B2SRr1DHOxgdOXi1cGng1FCb0Kb8oTriZuzRTe0euTDKGG OxkAd0hHXC5lkreObUaKUkP/wh1+c5CC3s9BIn9QfnZs9tAohT50THyXvnsbLxdji3tw52nMXmkmd yfM8GgrHLbXYHv376Z7JMEQ/6Vp7hd8w50N89dUqXe8kiDlCor+IN91lGg0vN38qK13NfT1RnOcXs GGRB0LOOUn4MK5rwtjlOeMa8hPLPamlKUmzTjxOf9hS8yqnZGXG2BWzGOzFeDezDbFBzphCjyCB+F irKI2W6Vy6bZ8g==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 01/12] lint: Switch to SRFI-71. Date: Fri, 23 Feb 2024 16:48:05 +0100 Message-ID: <1b2244ba8d74755eac44e84b35f9867a8585784e.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/lint.scm: Switch from SRFI-11 to SRFI-71. Change-Id: I62e6cd304ad73570bd12bd67f7051566205596bb --- guix/lint.scm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index c95de85e69..84df171045 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -84,10 +84,10 @@ (define-module (guix lint) #:use-module (srfi srfi-1) #:use-module (srfi srfi-6) ;Unicode string ports #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (ice-9 rdelim) #:export (check-description-style check-inputs-should-be-native @@ -823,8 +823,8 @@ (define* (probe-uri uri #:key timeout) ;; Return RESPONSE, unless the final response as we follow ;; redirects is not 200. (if location - (let-values (((status response2) - (loop location (cons location visited)))) + (let ((status response2 (loop location + (cons location visited)))) (case status ((http-response) (values 'http-response @@ -926,8 +926,7 @@ (define (tls-certificate-error-string args) (define (validate-uri uri package field) "Return #t if the given URI can be reached, otherwise return a warning for PACKAGE mentioning the FIELD." - (let-values (((status argument) - (probe-uri uri #:timeout 3))) ;wait at most 3 seconds + (let ((status argument (probe-uri uri #:timeout 3))) ;wait at most 3 seconds (case status ((http-response) (cond ((= 200 (response-code argument)) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:55:32 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:55:32 +0000 Received: from localhost ([127.0.0.1]:49676 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXta-0002SD-T1 for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:55:32 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52678) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnM-00021h-Oo for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:08 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmt-00077I-Mi; Fri, 23 Feb 2024 10:48:35 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=ElMxgUvcBIC1vFL13ue8a05OA3nKi/YwTK46N47dER0=; b=GzCL7TeftWwwA6aJ4gC8 +Zu7WYG6pLXWuXiV63CpCP/UG+kTY/GFOLfx/ki8MI/j0NY+6SyAhRYyXVt14/jl1qUCg/7QGS8HA Tkj5kENx9922O9sbLDvorKhyqdfKAGZUqL+1bIhv+xm8ZUxI8wvQMxh8u7LCRE9Y1GJBPh5I1IKf6 KU0A2ygNrzdMd1cljXPBzRSIxaIZvdsm5IR7j23P7VR0TgQsNyf79tYOfB0sLIw7qFLswcSzP87Ra vyXmICjctdGSDILTNZE1keouz3mKG+nybWZjd8GnatsnN6U6rYCkewnOoTLnGTRsLlPpHMpeYk0d+ vhOM27oy+spg4g==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 02/12] lint: archival: Fix crash in non-Git case. Date: Fri, 23 Feb 2024 16:48:06 +0100 Message-ID: <0f673f19854b1b4bab62e08d6ec336c7200b5857.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes a bug introduced in 29f3089c841f00144f24f5c32296aebf22d752cc where ‘guix lint -c archival guile-wisp’ (for instance) would crash with a match error because ‘lookup-by-nar-hash’ returns a string. * guix/lint.scm (check-archival): Add SWHID case in the non-Git case. Change-Id: I66fb060172d372041df47d90a14df168b0fa762d --- guix/lint.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/lint.scm b/guix/lint.scm index 84df171045..ad84048660 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1736,6 +1736,8 @@ (define (check-archival package) (list id) #:field 'source))))))) ((? content?) + '()) + ((? string? swhid) '()))) '())) ((? local-file?) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:55:34 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:55:34 +0000 Received: from localhost ([127.0.0.1]:49680 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXtc-0002SS-JI for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:55:34 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52694) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnO-00021r-AE for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:09 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmv-00077g-E3; Fri, 23 Feb 2024 10:48:37 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=DPOCVet0L6oI0b2IYdoDO4DlH2KPp7cO49mpfaGWTlA=; b=E4Eqa/R15MWruFRi8zAA afmWCOay+IWqUDvCPrtJXSBc5Ig4+qC+0qoma7m5FT6G5/2mnwzd6OEJCIO1TG4uqiV5hp9r0bCTA /W52cJML1r7gCu2Wf9bVj6J7ZUI6BaIsupjhFFNPEU8CZC56hLMJYbw89jURC/G6tUd/oXPZgbEYs u7nIThYnuOKv97MaFEW5eyoYCLOax+AG6rK1Js1XMVNxjPc5tf3h2w9cb7a7F9dNxA9TbhxAEgeFj JUnxj/+uQX/mDWG36oEx0TcM6jf17e+GlOl2JwWgC/GHczowW04XF09KvBThFkFwSuEnB4PQe6tLy MMUcpZhP1j7bCw==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 04/12] =?UTF-8?q?swh:=20Add=20=E2=80=98type=E2=80=99=20fie?= =?UTF-8?q?ld=20to=20.?= Date: Fri, 23 Feb 2024 16:48:08 +0100 Message-ID: <7c992a535832f71d9624741cedd5095d2bd3b4ba.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/swh.scm ()[type]: New field. Change-Id: I7677984c7daef38d8f3c3bef19723fa0efb035ba --- guix/swh.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/swh.scm b/guix/swh.scm index 04cecd854c..83f67423c8 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -54,6 +54,7 @@ (define-module (guix swh) visit-snapshot-url visit-status visit-number + visit-type visit-snapshot snapshot? @@ -312,6 +313,7 @@ (define-json-mapping make-visit visit? (url visit-url "origin_visit_url") (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f (status visit-status "status" string->symbol) ;'full | 'partial | 'ongoing + (type visit-type "type" string->symbol) ;'git | 'git-checkout | ... (number visit-number "visit")) ;; -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Fri Feb 23 10:55:36 2024 Received: (at 69328) by debbugs.gnu.org; 23 Feb 2024 15:55:36 +0000 Received: from localhost ([127.0.0.1]:49684 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXte-0002Sd-Ky for submit@debbugs.gnu.org; Fri, 23 Feb 2024 10:55:36 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52700) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rdXnQ-00022c-4H for 69328@debbugs.gnu.org; Fri, 23 Feb 2024 10:49:11 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rdXmx-00078A-7D; Fri, 23 Feb 2024 10:48:39 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=sPOsCgLubkee2GGfJt8QIFvys49VqYkuvP8nxBPM+r0=; b=F1dZEuK/npoc1QJWcq65 cy6xQh+ywZ/DN8NpMmxeq1rd5OL3WSuHs1xCBca3TTO3HVMg7QlqaY1+oWRgtzYswMuJuoQPCC57s 4L/T9aN2noAGqBThUmotmoKP+xNWs25WW1rfmEyrzlYtoBH8D6SjzuAPMit1GKy16KJVAJyhSuv38 fU5Hi2YgR7UXIme871HFWwSa6uZV9N+Pcetp6sEvpRlDhozQWbJRSTIF0grVPOXWLAFPSSTUW+e42 m3ihnMbBJNpHgdFkmcXnQzpvqF/iXPvkDorYwO/ASNPszYEj8E7xCina//KbQ3QfVMtPeMpx2vaBC b6TudGCWzI05Zg==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH 06/12] =?UTF-8?q?swh:=20=E2=80=98lookup-origin-revision?= =?UTF-8?q?=E2=80=99=20handles=20branches=20pointing=20to=20directories.?= Date: Fri, 23 Feb 2024 16:48:10 +0100 Message-ID: <59c8e6bb4f5aadd4a60c18b60665391a65b10b45.1708697539.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes . * guix/swh.scm (branch-target): Add clause for 'directory and 'alias. (lookup-origin-revision): Iterate over all the visits of ORIGIN instead of just the first one. Handle the case where ‘branch-target’ returns something other than a release or revision. * tests/swh.scm ("lookup-origin-revision"): New test. Change-Id: I7f636739a719908763bca1d3e7376341dd62e816 --- guix/swh.scm | 60 ++++++++++++++++++++++------------------- tests/swh.scm | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 27 deletions(-) diff --git a/guix/swh.scm b/guix/swh.scm index 14c65f6806..f602cd89d1 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -516,14 +516,20 @@ (define (lookup-snapshot-branch snapshot name) (_ #f))))) (define (branch-target branch) - "Return the target of BRANCH, either a or a ." + "Return the target of BRANCH: a , a , or the SWHID of a +directory." (match (branch-target-type branch) ('release (call (swh-url (branch-target-url branch)) json->release)) ('revision (call (swh-url (branch-target-url branch)) - json->revision)))) + json->revision)) + ((or 'directory 'alias) + (match (string-tokenize (branch-target-url branch) + (char-set-complement (char-set #\/))) + ((_ ... "directory" id) + (string-append "swh:1:dir:" id)))))) (define (lookup-origin-revision url tag) "Return a corresponding to the given TAG for the repository @@ -537,31 +543,31 @@ (define (lookup-origin-revision url tag) (match (lookup-origin url) (#f #f) (origin - (match (filter (lambda (visit) - ;; Return #f if (visit-snapshot VISIT) would return #f. - (and (visit-snapshot-url visit) - (eq? 'full (visit-status visit)))) - (origin-visits origin)) - ((visit . _) - (let ((snapshot (visit-snapshot visit))) - (match (and=> (find (lambda (branch) - (or - ;; Git specific. - (string=? (string-append "refs/tags/" tag) - (branch-name branch)) - ;; Hg specific. - (string=? tag - (branch-name branch)))) - (snapshot-branches snapshot)) - branch-target) - ((? release? release) - (release-target release)) - ((? revision? revision) - revision) - (#f ;tag not found - #f)))) - (() - #f))))) + (any (lambda (visit) + (and (visit-snapshot-url visit) + (eq? 'full (visit-status visit)) + (let ((snapshot (visit-snapshot visit))) + (match (and=> (find (lambda (branch) + (or + ;; Git specific. + (string=? (string-append "refs/tags/" tag) + (branch-name branch)) + ;; Hg specific. + (string=? tag + (branch-name branch)))) + (snapshot-branches snapshot)) + branch-target) + ((? release? release) + (release-target release)) + ((? revision? revision) + revision) + (_ + ;; Either the branch points to a directory rather than + ;; a revision (this is the case for visits of type + ;; 'git-checkout, 'hg-checkout, 'tarball-directory, + ;; etc.), or TAG was not found. + #f))))) + (origin-visits origin 30))))) (define (release-target release) "Return the revision that is the target of RELEASE." diff --git a/tests/swh.scm b/tests/swh.scm index e7ced6b50c..11dcbdddd8 100644 --- a/tests/swh.scm +++ b/tests/swh.scm @@ -109,6 +109,80 @@ (define-syntax-rule (with-json-result str exp ...) (directory-entry-length entry))) (lookup-directory "123")))) +(test-equal "lookup-origin-revision" + '("cd86c72084993d9ef26fc9e24b73cea612b8c97b" + "d173c707ee88e3c89401ad77fafa65fcd9e9f5be") + (let () + ;; Make sure that 'lookup-origin-revision' does the job, and in particular + ;; that it doesn't stop until it has found an actual revision: + ;; 'git-checkout visits point to directories instead of revisions. + ;; See . + (define visits + ;; Two visits of differing types: the first visit (type 'git-checkout') + ;; points to a directory, the second one (type 'git') points to a + ;; revision. + "[ { + \"origin\": \"https://example.org/repo.git\", + \"visit\": 1, + \"type\": \"git-checkout\", + \"date\": \"2020-05-17T21:43:45.422977+00:00\", + \"status\": \"full\", + \"metadata\": {}, + \"type\": \"git-checkout\", + \"origin_visit_url\": \"/visit/42\", + \"snapshot_url\": \"/snapshot/1\" + }, { + \"origin\": \"https://example.org/repo.git\", + \"visit\": 2, + \"type\": \"git\", + \"date\": \"2020-05-17T21:43:49.422977+00:00\", + \"status\": \"full\", + \"metadata\": {}, + \"type\": \"git\", + \"origin_visit_url\": \"/visit/41\", + \"snapshot_url\": \"/snapshot/2\" + } ]") + (define snapshot-for-git-checkout + "{ \"id\": 42, + \"branches\": { \"1.3.2\": { + \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\", + \"target_type\": \"directory\", + \"target_url\": \"/directory/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\" + }} + }") + (define snapshot-for-git + "{ \"id\": 42, + \"branches\": { \"1.3.2\": { + \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\", + \"target_type\": \"revision\", + \"target_url\": \"/revision/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\" + }} + }") + (define revision + "{ \"author\": {}, + \"committer\": {}, + \"committer_date\": \"2018-05-17T21:43:49.422977+00:00\", + \"date\": \"2018-05-17T21:43:49.422977+00:00\", + \"directory\": \"d173c707ee88e3c89401ad77fafa65fcd9e9f5be\", + \"directory_url\": \"/directory/d173c707ee88e3c89401ad77fafa65fcd9e9f5be\", + \"id\": \"cd86c72084993d9ef26fc9e24b73cea612b8c97b\", + \"merge\": false, + \"message\": \"Fix.\", + \"parents\": [], + \"type\": \"what type?\" + }") + + (with-http-server `((200 ,%origin) + (200 ,visits) + (200 ,snapshot-for-git-checkout) + (200 ,snapshot-for-git) + (200 ,revision)) + (parameterize ((%swh-base-url (%local-url))) + (let ((revision (lookup-origin-revision "https://example.org/repo.git" + "1.3.2"))) + (list (revision-id revision) + (revision-directory revision))))))) + (test-equal "lookup-directory-by-nar-hash" "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153" (with-json-result %external-id -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 02 23:54:02 2024 Received: (at 69328) by debbugs.gnu.org; 3 Mar 2024 04:54:02 +0000 Received: from localhost ([127.0.0.1]:39588 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rgdrO-0005re-2y for submit@debbugs.gnu.org; Sat, 02 Mar 2024 23:54:02 -0500 Received: from fout1-smtp.messagingengine.com ([103.168.172.144]:54691) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rgdrL-0005r6-1u for 69328@debbugs.gnu.org; Sat, 02 Mar 2024 23:53:59 -0500 Received: from compute7.internal (compute7.nyi.internal [10.202.2.48]) by mailfout.nyi.internal (Postfix) with ESMTP id 9F10E1380097; Sat, 2 Mar 2024 23:53:24 -0500 (EST) Received: from mailfrontend2 ([10.202.2.163]) by compute7.internal (MEProxy); Sat, 02 Mar 2024 23:53:24 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ngyro.com; h=cc :cc:content-transfer-encoding:content-type:content-type:date :date:from:from:in-reply-to:in-reply-to:message-id:mime-version :references:reply-to:subject:subject:to:to; s=fm2; t=1709441604; x=1709528004; bh=iQJ/dVoJbkvptnr5cC1Uhj+YJCocjjSSrdYe13+MS80=; b= K7tD9JsZ/hNX7T+Ox9qcrxaH5AervZvUaqEqjhRkHjHAyLvVWmKob7e+Pj5LJ0/B m42LBW1pKL4YCdxaS60ssK9+yWWzHs8+VryK9JLvByTv3DsC2U4rSc2CQUGAmNZ9 iJZJiLKwmjGqDO2HjS7CNYv3vt5EXSmRTGVeEwh5XbblcuLqCgqZSBVgkTPo/84f o8ulb/km403c/sDTDc054ByKATNF7DcZc7uLkMEBM05NWTFMsaABcsZBdr2+XDSd L32dwB4BAPGXY6z+f9u/5VX69JC1c4KzBtee3AsXpzOrU1xcKjFTxs+4KkSzPpnx b95jvjfLAHKylPSvr1UPPA== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-transfer-encoding :content-type:content-type:date:date:feedback-id:feedback-id :from:from:in-reply-to:in-reply-to:message-id:mime-version :references:reply-to:subject:subject:to:to:x-me-proxy:x-me-proxy :x-me-sender:x-me-sender:x-sasl-enc; s=fm1; t=1709441604; x= 1709528004; bh=iQJ/dVoJbkvptnr5cC1Uhj+YJCocjjSSrdYe13+MS80=; b=G 9bfGtMyJxsXLnMcu1mdJoP7uwGQ1S76tlQah/8G6EXOs0VSQ0wugBJ3jHbnOLLPZ vfKnwIwajvlZJy7YDK17zbSEEtclP/G+aBeLBs2PoQ3Y6Q8P1Z2a/IVtLr1hweWx skte28/+fm2jff52BrfQhTnnboErWiDMnjFWnF6J0WraoUAgBkh38E4/cxA8own1 9M5Oj/2aQSR+3CRF8QKzVXMuceiz6b9YRnK09sCj8XIFmHUjmPa7b1aCxdu6flWw wVAx0qoVKBu3S5QZRPgyz0bub+t1XkoHlX6+GyINAt2fx918iVEnT7mqFL654amh lf0ILEeQQRtYFXy6XBDrQ== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvledrheeggdejhecutefuodetggdotefrodftvf curfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfghnecu uegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmdenuc fjughrpefhvfevufgjfhffkfgfgggtgfesthhqredttderjeenucfhrhhomhepvfhimhho thhhhicuufgrmhhplhgvuceoshgrmhhplhgvthesnhhghihrohdrtghomheqnecuggftrf grthhtvghrnhepteeffffftedtleevkefgfeefveduheehtdffvdffhfdutefhfedvuddu jeelhfdvnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrghilhhfrhhomh epshgrmhhplhgvthesnhhghihrohdrtghomh X-ME-Proxy: Feedback-ID: i4721425c:Fastmail Received: by mail.messagingengine.com (Postfix) with ESMTPA; Sat, 2 Mar 2024 23:53:23 -0500 (EST) From: Timothy Sample To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#69328] [PATCH 12/12] download: Honor =?utf-8?Q?=E2=80=98GUIX=5FDOWNLOAD=5FSEQUENCE=E2=80=99?= environment variable. In-Reply-To: <0eafb9b6a14808552c10a4d9d44eef1ec69897f9.1708697539.git.ludo@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22's?= message of "Fri, 23 Feb 2024 16:48:16 +0100") References: <0eafb9b6a14808552c10a4d9d44eef1ec69897f9.1708697539.git.ludo@gnu.org> Date: Sat, 02 Mar 2024 22:53:21 -0600 Message-ID: <87jzmjkjb2.fsf@ngyro.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 69328 Cc: Josselin Poiret , Tobias Geerinckx-Rice , Simon Tournier , Mathieu Othacehe , 69328@debbugs.gnu.org, Ricardo Wurmus , Christopher Baines 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: -1.7 (-) Ludovic Court=C3=A8s writes: > diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-dow= nload.scm > index b96959a09e..250b1c2b48 100644 > --- a/guix/scripts/perform-download.scm > +++ b/guix/scripts/perform-download.scm > @@ -114,14 +120,16 @@ (define* (perform-git-download drv output > ;; on ambient authority, hence the PATH value below. > (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") >=20=20 > - ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are > - ;; different, hence the #:item argument below. > - (git-fetch-with-fallback url commit output > - #:hash hash > - #:hash-algorithm algo > - #:recursive? recursive? > - #:item (derivation-output-path drv-output) > - #:git-command %git)))) > + (parameterize ((%download-sequence > + (and download-sequence > + (call-with-input-string download-sequence > + read)))) > + (git-fetch-with-fallback url commit output > + #:hash hash > + #:hash-algorithm algo > + #:recursive? recursive? > + #:item (derivation-output-path drv-outp= ut) > + #:git-command %git))))) Did you mean to delete the comment here? From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 02 23:55:01 2024 Received: (at 69328) by debbugs.gnu.org; 3 Mar 2024 04:55:01 +0000 Received: from localhost ([127.0.0.1]:39592 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rgdsK-0005sy-KL for submit@debbugs.gnu.org; Sat, 02 Mar 2024 23:55:01 -0500 Received: from fhigh3-smtp.messagingengine.com ([103.168.172.154]:35883) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rgdsJ-0005sk-1P for 69328@debbugs.gnu.org; Sat, 02 Mar 2024 23:54:59 -0500 Received: from compute6.internal (compute6.nyi.internal [10.202.2.47]) by mailfhigh.nyi.internal (Postfix) with ESMTP id 1ECEA11400B1; Sat, 2 Mar 2024 23:54:25 -0500 (EST) Received: from mailfrontend2 ([10.202.2.163]) by compute6.internal (MEProxy); Sat, 02 Mar 2024 23:54:25 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ngyro.com; h=cc :cc:content-transfer-encoding:content-type:content-type:date :date:from:from:in-reply-to:in-reply-to:message-id:mime-version :references:reply-to:subject:subject:to:to; s=fm2; t=1709441665; x=1709528065; bh=KVwuEbMg6mzzlEu+noSuLHxZdPxX9VwO30OwAQA5Vm8=; b= SfNk6Fi47pbPltWkVQfuXSF0HOVkAbKrvmWTvlU9IzENPwep8bLQyqmli32qhT3H 4ge7lC0HKCHeNNqQHH7bxx89zbVd6AIIIhaYw4v7BCP6wDAUnUDnHfiUBLRNOR0L +CoiXO56bGHJ4yD/wx1j9VJZE2VbNK85JkAFYrTWBW+sJoJKkzxqAw6csPjPpNw2 fBI3FGDdfMsR/uVABaxqkFWFU3RylOxLL6uWZoegL2CXGbNrMdMkpTlhvRaD05mU EkC7LKO1m1R/LWnUhAcCjGNKgvbsoQUUmICRCL0jIpvuvk8bicaXQNgWGyn7DopS SU52G3zAPEVE2gu+3EDPjA== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-transfer-encoding :content-type:content-type:date:date:feedback-id:feedback-id :from:from:in-reply-to:in-reply-to:message-id:mime-version :references:reply-to:subject:subject:to:to:x-me-proxy:x-me-proxy :x-me-sender:x-me-sender:x-sasl-enc; s=fm1; t=1709441665; x= 1709528065; bh=KVwuEbMg6mzzlEu+noSuLHxZdPxX9VwO30OwAQA5Vm8=; b=a cJUL1nL75AVoOq4ZUjmHCV+ijBQ10jGeXDz1ySE0Te0b6RXM8T/+ePmTi0dMpFDT 1rU4HuvhK0rSnhSGSuaqMQj6K/ozbtk5jNPcIaukt711u0Y4vS0ZLs74J5uOv3ZB SZn/FHOlvRaO7aWK9YIgUu8RQyWlIVasuqD2w/44ndq31okol99c7k4MSFjZr4kN LiMoVtypv/rYJtd53EoojF9HybfdjyATDCUz4Rcety6msgwZD5sJshUdgT+VDPTU ygTGBTaI7H7/82AHCyzl3pACqwhXSDlgkJjpiXD30K35nm2GyjoZBAcVMW6Tsbax S0FHo9GfCI1h1HtzPUfYw== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvledrheeggdejhecutefuodetggdotefrodftvf curfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfghnecu uegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmdenuc fjughrpefhvfevufgjfhffkfgfgggtgfesthhqredttderjeenucfhrhhomhepvfhimhho thhhhicuufgrmhhplhgvuceoshgrmhhplhgvthesnhhghihrohdrtghomheqnecuggftrf grthhtvghrnhepkeefjeffueekveffueefvefhhefgtdetvdetkeevfefffffggfdvhfev gedtkeehnecuffhomhgrihhnpehgnhhurdhorhhgnecuvehluhhsthgvrhfuihiivgeptd enucfrrghrrghmpehmrghilhhfrhhomhepshgrmhhplhgvthesnhhghihrohdrtghomh X-ME-Proxy: Feedback-ID: i4721425c:Fastmail Received: by mail.messagingengine.com (Postfix) with ESMTPA; Sat, 2 Mar 2024 23:54:23 -0500 (EST) From: Timothy Sample To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#69328] [PATCH 00/12] Better source code recovery from SWH In-Reply-To: ("Ludovic =?utf-8?Q?Court?= =?utf-8?Q?=C3=A8s=22's?= message of "Fri, 23 Feb 2024 15:22:51 +0100") References: Date: Sat, 02 Mar 2024 22:54:22 -0600 Message-ID: <87il23kj9d.fsf@ngyro.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 69328 Cc: Josselin Poiret , Tobias Geerinckx-Rice , Simon Tournier , Mathieu Othacehe , 69328@debbugs.gnu.org, Ricardo Wurmus , Christopher Baines 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: -1.7 (-) Ludovic Court=C3=A8s writes: > Hello Guix! > > This patch series improves source code recovery from SWH, as a followup > to . > > It does several things: > > =E2=80=A2 =E2=80=98guix lint -c archival=E2=80=99 now emits save reques= ts for VCSes other > than Git. > > =E2=80=A2 Fix . > > =E2=80=A2 Allow content-addressed recovery of Mercurial and Subversion > checkouts. > > =E2=80=A2 Allow Bazaar recovery using =E2=80=98download-nar=E2=80=99 (I= didn=E2=80=99t bother with SWH). > > =E2=80=A2 Have all these things honor the =E2=80=98GUIX_DOWNLOAD_SEQUEN= CE=E2=80=99 environment > variable. Very nice! I like the design of =E2=80=98GUIX_DOWNLOAD_SEQUENCE=E2=80=99 c= ompared to =E2=80=98GUIX_DOWNLOAD_FALLBACK_TEST=E2=80=99, but I=E2=80=99m not sure abo= ut the name (sorry for bike shedding!). In particular, the =E2=80=9Csequences=E2=80=9D =E2=80= =98(nar swh)=E2=80=99 and =E2=80=98(swh nar)=E2=80=99 will both try =E2=80=98nar=E2=80=99 first and t= hen =E2=80=98swh=E2=80=99. What about =E2=80=9Cmethods=E2=80=9D or =E2=80=9Cstrategies=E2=80=9D or something? > You can try the various methods like this: > > GUIX_DOWNLOAD_SEQUENCE=3Dnar ./pre-inst-env guix build -S apl --check > GUIX_DOWNLOAD_SEQUENCE=3Dswh ./pre-inst-env guix build -S guile-wisp --= check > GUIX_DOWNLOAD_SEQUENCE=3Dswh ./pre-inst-env guix build -S guile-gcrypt = --check I tried GUIX_DOWNLOAD_SEQUENCE=3Ddisarchive ./pre-inst-env guix build -S mes --ch= eck and it worked like a charm. > Feedback welcome! Other than the name and the little separate comment on the last patch, this all LGTM. -- Tim From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 05:26:54 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 10:26:54 +0000 Received: from localhost ([127.0.0.1]:46276 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhS0c-0004Zg-AF for submit@debbugs.gnu.org; Tue, 05 Mar 2024 05:26:54 -0500 Received: from eggs.gnu.org ([209.51.188.92]:45062) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhS0Y-0004ZO-CV for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 05:26:53 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhRzw-0002UE-ST; Tue, 05 Mar 2024 05:26:12 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=MbRAMv6kAEGdUTbX0TdOdAM2idbs5unq8Ha5kja5UDo=; b=mrMdvJXZMOjBQzxlx1nh SSBjIJ/vzHmiXLEJsO8UAtL+qHm30JPJ2bJ7YtSyoV17rHgw0Db0EVSrwvejd7xEx9CNNz7vOR/1L gDQCzfnll5xwEWzSQsUy/Wd4DXEH/jGZzpwQmu4mEAbTJUEahfHVxXXV2QlSnF8fQ8N6In0K1u2vP noce5ht/0jyQvIifYq/1++irtSOYNNzgIde/hzXaYk0IKv5tAdPIFQX5KgZCsd5cWpNhvKtMveXDM NYU2GaOGOMr1OloFtIubkbzfSI3cTIwrEUK3W0NF0JNrZQm/7I9RMZeuDWUbRuFffpO9pCuMQlDaq epFSUURIESEYhA==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Timothy Sample Subject: Re: [bug#69328] [PATCH 12/12] download: Honor =?utf-8?Q?=E2=80=98GUIX=5FDOWNLOAD=5FSEQUENCE=E2=80=99?= environment variable. In-Reply-To: <87jzmjkjb2.fsf@ngyro.com> (Timothy Sample's message of "Sat, 02 Mar 2024 22:53:21 -0600") References: <0eafb9b6a14808552c10a4d9d44eef1ec69897f9.1708697539.git.ludo@gnu.org> <87jzmjkjb2.fsf@ngyro.com> Date: Tue, 05 Mar 2024 11:26:03 +0100 Message-ID: <87ttllc6v8.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Josselin Poiret , 69328@debbugs.gnu.org, Simon Tournier , Mathieu Othacehe , Tobias Geerinckx-Rice , Ricardo Wurmus , Christopher Baines 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: -3.3 (---) Timothy Sample skribis: > Ludovic Court=C3=A8s writes: > >> diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-do= wnload.scm >> index b96959a09e..250b1c2b48 100644 >> --- a/guix/scripts/perform-download.scm >> +++ b/guix/scripts/perform-download.scm >> @@ -114,14 +120,16 @@ (define* (perform-git-download drv output >> ;; on ambient authority, hence the PATH value below. >> (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") >>=20=20 >> - ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are >> - ;; different, hence the #:item argument below. >> - (git-fetch-with-fallback url commit output >> - #:hash hash >> - #:hash-algorithm algo >> - #:recursive? recursive? >> - #:item (derivation-output-path drv-outpu= t) >> - #:git-command %git)))) >> + (parameterize ((%download-sequence >> + (and download-sequence >> + (call-with-input-string download-sequence >> + read)))) >> + (git-fetch-with-fallback url commit output >> + #:hash hash >> + #:hash-algorithm algo >> + #:recursive? recursive? >> + #:item (derivation-output-path drv-out= put) >> + #:git-command %git))))) > > Did you mean to delete the comment here? Nope, good catch! From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 05:58:53 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 10:58:53 +0000 Received: from localhost ([127.0.0.1]:46323 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSVZ-0005U3-A9 for submit@debbugs.gnu.org; Tue, 05 Mar 2024 05:58:53 -0500 Received: from eggs.gnu.org ([209.51.188.92]:54446) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSVX-0005Tp-35 for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 05:58:52 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSUv-0000Yo-GX; Tue, 05 Mar 2024 05:58:13 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=MEb3WRsJM78e1by0EBu+Bnpr6k8CkHNfV0FkpQo9P6k=; b=T3jYh9wC+IPQgx5dZXCH +LCkuc7XCOQWb1cxUIpGkwRvVax1Bp+PW/UZpXeQHKSrl/niUeYj0FFAdtPqQ8Q0dbCn1xymB877Q UEVqasV7Mo3HW3e+xsGtuU4iNpZsZZN7P32ov+e3eu4YLarYdNvzoS59QK40777RAmbpcSJu2ld5M rHZjf32ua/zFFXdC03oDbCSwJqQhpSouZzD4AldR83vlAarVLuLjC/gpjDzwmD0q/wE4m7RGwpCXf I4kTW0fLq0n77SOyITWg+T7WYY+4NIn85XH06PuuZdukAzoEr5j3EqIOSHitniQckjmIuL+H9c38l 2HaYVYxqqrHq9w==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Timothy Sample Subject: Re: [bug#69328] [PATCH 00/12] Better source code recovery from SWH In-Reply-To: <87il23kj9d.fsf@ngyro.com> (Timothy Sample's message of "Sat, 02 Mar 2024 22:54:22 -0600") References: <87il23kj9d.fsf@ngyro.com> Date: Tue, 05 Mar 2024 11:58:05 +0100 Message-ID: <87o7btc5du.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Josselin Poiret , 69328@debbugs.gnu.org, Simon Tournier , Mathieu Othacehe , Tobias Geerinckx-Rice , Ricardo Wurmus , Christopher Baines 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: -3.3 (---) Hi, Timothy Sample skribis: > Ludovic Court=C3=A8s writes: [...] >> =E2=80=A2 Have all these things honor the =E2=80=98GUIX_DOWNLOAD_SEQUE= NCE=E2=80=99 environment >> variable. > > Very nice! I like the design of =E2=80=98GUIX_DOWNLOAD_SEQUENCE=E2=80=99= compared to > =E2=80=98GUIX_DOWNLOAD_FALLBACK_TEST=E2=80=99, but I=E2=80=99m not sure a= bout the name (sorry > for bike shedding!). In particular, the =E2=80=9Csequences=E2=80=9D =E2= =80=98(nar swh)=E2=80=99 and > =E2=80=98(swh nar)=E2=80=99 will both try =E2=80=98nar=E2=80=99 first and= then =E2=80=98swh=E2=80=99. What about > =E2=80=9Cmethods=E2=80=9D or =E2=80=9Cstrategies=E2=80=9D or something? Good point; I like =E2=80=9Cmethods=E2=80=9D. > Other than the name and the little separate comment on the last patch, > this all LGTM. Awesome; I=E2=80=99ll send an updated version and merge by the end of the w= eek if nobody objects. Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:51 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:51 +0000 Received: from localhost ([127.0.0.1]:46373 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeF-0008WK-7H for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:51 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40844) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeD-0008Vo-GN for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:50 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdd-0002tD-SQ; Tue, 05 Mar 2024 06:07:13 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=mweznaeSa8lo+k359M/SGVd1fQ3+v3DXBJsYRoVbaNg=; b=Cs++XkGXw1J4W7b3Ogz4 EuQ9s52dqmcm1jL+79PmSG4gq+2q48Qq58zdaBLWV/F95DcGG4gLrsDyvjKdRnSabsZ1BitBrcX5U k15E4es5mgLk8y87GhB7rwDxZIGiiG2yusX142IOxXNMlMDI+sdFDXaKZPIdAL1zvvzz0evvr8PZ/ aGyPqXnDJ+kz2MbE2Y9FaZRIQo4GQOWYabQqJ5QgbbidEeeR0ElLTWCW3wooCVddJGub64WpBaz/Y ezuQEsA/O9DGkFm481ifCeQ3KI8D2XsBV/SRRLkQURlJtbbu9c8UPIazO4AcIxYDbOaRb2rVAdruC GCRL37pPGSZwdQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 00/12] Better source code recovery from SWH Date: Tue, 5 Mar 2024 12:06:48 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Hello! Changes since v1: • Renamed ‘GUIX_DOWNLOAD_SEQUENCE’ to ‘GUIX_DOWNLOAD_METHODS’ as suggested by Timothy. • Reinstated comment that was inadvertently removed in last patch. • Added comment in ‘svn-multi-fetch’ fallback pointing to SWH issue being discussed. I plan to push by the end of the week if there are no objections. Ludo’. Ludovic Courtès (12): lint: Switch to SRFI-71. lint: archival: Fix crash in non-Git case. lint: archival: Trigger “Save Code Now” for VCSes other than Git. swh: Add ‘type’ field to . swh: ‘origin-visits’ takes an optional ‘max’ parameter. swh: ‘lookup-origin-revision’ handles branches pointing to directories. hg-download: Use ‘swh-download-directory-by-nar-hash’. svn-download: Use ‘swh-download-directory-by-nar-hash’. bzr-download: Implement nar fallback. download-nar: Distinguish ‘output’ and ‘item’ parameter. perform-download: Allow use of ‘download-nar’ for ‘--check’ builds. download: Honor ‘GUIX_DOWNLOAD_METHODS’ environment variable. guix/build/bzr.scm | 3 +- guix/build/download-nar.scm | 12 +-- guix/build/download.scm | 50 +++++++--- guix/build/git.scm | 27 ++++-- guix/bzr-download.scm | 57 ++++++++--- guix/cvs-download.scm | 24 +++-- guix/download.scm | 53 ++++------- guix/git-download.scm | 20 ++-- guix/hg-download.scm | 36 ++++--- guix/lint.scm | 151 +++++++++++++++++++----------- guix/scripts/perform-download.scm | 67 +++++++------ guix/svn-download.scm | 88 +++++++++++------ guix/swh.scm | 71 ++++++++------ tests/lint.scm | 20 ++++ tests/swh.scm | 74 +++++++++++++++ 15 files changed, 507 insertions(+), 246 deletions(-) base-commit: b7f0aad907d6c33c4ccb137190b7a6b710a7112b -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:52 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:52 +0000 Received: from localhost ([127.0.0.1]:46375 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeF-0008WM-HI for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:51 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40856) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeD-0008Vp-JN for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:50 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSde-0002ua-2v; Tue, 05 Mar 2024 06:07:14 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=ElMxgUvcBIC1vFL13ue8a05OA3nKi/YwTK46N47dER0=; b=BrFcVwkJrTJm0Vk5902t LDyeL+tEeyEjtl2rc45Ho6gMZlYaRTVjrnnRm+EikTYUJiMlF4BjL5Jle5VlMV2OV5LHNlo4kSFEa 8wbN3ZDD1fSCGsAwePPofS0QJ+RFEidi5tpugXYGqEgyhMrg0Q+d6Zgrd1ZXQtHpvBmJi1VUcffT4 FynaQi7/nmEQtlXrrlroK5JtoPHeRUZGF7yLK8SE9nZd45Zm2lon0BXsfPtV9/KhcWiyWwcehm8MS ooHgJKSggSL5M4lY5aVYvnQurh/vrnxFZEPhccxPbVMjdJz58LSZqJb8Zws6Jc6Bp1YI49HRpuqcD Pa3aRsF648aoCQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 02/12] lint: archival: Fix crash in non-Git case. Date: Tue, 5 Mar 2024 12:06:50 +0100 Message-ID: <395f0625fc5373cee2de0793a98ea57a4059cc7d.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes a bug introduced in 29f3089c841f00144f24f5c32296aebf22d752cc where ‘guix lint -c archival guile-wisp’ (for instance) would crash with a match error because ‘lookup-by-nar-hash’ returns a string. * guix/lint.scm (check-archival): Add SWHID case in the non-Git case. Change-Id: I66fb060172d372041df47d90a14df168b0fa762d --- guix/lint.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/lint.scm b/guix/lint.scm index 84df171045..ad84048660 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1736,6 +1736,8 @@ (define (check-archival package) (list id) #:field 'source))))))) ((? content?) + '()) + ((? string? swhid) '()))) '())) ((? local-file?) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:52 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:53 +0000 Received: from localhost ([127.0.0.1]:46379 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeG-00004t-1D for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:52 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40868) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeD-0008Vq-PY for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:50 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdd-0002uL-Tp; Tue, 05 Mar 2024 06:07:13 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=jE72jc8CNzz9m9Fcp3dz6S+FjFst2TTCXkUasSQYmuc=; b=qarYui+8mw2peqwH+yOa /552Xfdde6o71FXLrMXKre9N6k+FCXqQBPfgEiS2b3X7PP1nFFtdsqv22fp/whDHnOOk17vf/LooT JaPHQJiWrlzn9VQI2NluuxsMkzJRFESQenMj14zZmxyagXMV7nVAXVOCXuDRu2dGE5dIAzCDp48gG lEcomUA0yrDy1q0x0eTM3WrcAMpSDnRNmvI+4xgdjEejzazD4vOQg62wseFKC1vm4+jQsRoJQaNzI kgWvrx/qE2pkSbt0uaUlvk05f7vA18wrE5eI8G1S9h617RurZNSVMHu8uo2j2juvv6IYfKOLoHu5h 7r2fRTPt4hU68A==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 01/12] lint: Switch to SRFI-71. Date: Tue, 5 Mar 2024 12:06:49 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/lint.scm: Switch from SRFI-11 to SRFI-71. Change-Id: I62e6cd304ad73570bd12bd67f7051566205596bb --- guix/lint.scm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index c95de85e69..84df171045 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -84,10 +84,10 @@ (define-module (guix lint) #:use-module (srfi srfi-1) #:use-module (srfi srfi-6) ;Unicode string ports #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (ice-9 rdelim) #:export (check-description-style check-inputs-should-be-native @@ -823,8 +823,8 @@ (define* (probe-uri uri #:key timeout) ;; Return RESPONSE, unless the final response as we follow ;; redirects is not 200. (if location - (let-values (((status response2) - (loop location (cons location visited)))) + (let ((status response2 (loop location + (cons location visited)))) (case status ((http-response) (values 'http-response @@ -926,8 +926,7 @@ (define (tls-certificate-error-string args) (define (validate-uri uri package field) "Return #t if the given URI can be reached, otherwise return a warning for PACKAGE mentioning the FIELD." - (let-values (((status argument) - (probe-uri uri #:timeout 3))) ;wait at most 3 seconds + (let ((status argument (probe-uri uri #:timeout 3))) ;wait at most 3 seconds (case status ((http-response) (cond ((= 200 (response-code argument)) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:57 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:57 +0000 Received: from localhost ([127.0.0.1]:46389 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeK-00005f-R1 for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:57 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40880) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeF-0008Vu-JG for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:51 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdg-0002vf-3Z; Tue, 05 Mar 2024 06:07:16 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=DPOCVet0L6oI0b2IYdoDO4DlH2KPp7cO49mpfaGWTlA=; b=ioA0JwbsChXsq+5rZV3z gzjpRrMbjBuGzsw7Ggc1+VegP/izZ2V4Gj34sHpxQ4S9kA8MoKJNx1oNtYwz505QI5I8HurxEk93C PxTZiKalXQIL635eVkK66AEbzKqxjKObbskzGDqSmfIqCZ3+vvyvpDUm95be/rGNW5JAla3aeUmG0 MZTl87Q5vgWlsnSG4YoVwKKFHTigrijuNp+paEteG/DWEoogFd78CnqtjzvGgSoK/vttScGPdsjCP hgE/i7a7Up2SW3j1+nLkjMBY97NlLVTRib1/Om6eP4Nq5q6Loc0XJi36sKuQL3RlDj6JqKWF/K+Mv A1SVRdkTe9f89w==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 04/12] =?UTF-8?q?swh:=20Add=20=E2=80=98type=E2=80=99=20?= =?UTF-8?q?field=20to=20.?= Date: Tue, 5 Mar 2024 12:06:52 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/swh.scm ()[type]: New field. Change-Id: I7677984c7daef38d8f3c3bef19723fa0efb035ba --- guix/swh.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/swh.scm b/guix/swh.scm index 04cecd854c..83f67423c8 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -54,6 +54,7 @@ (define-module (guix swh) visit-snapshot-url visit-status visit-number + visit-type visit-snapshot snapshot? @@ -312,6 +313,7 @@ (define-json-mapping make-visit visit? (url visit-url "origin_visit_url") (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f (status visit-status "status" string->symbol) ;'full | 'partial | 'ongoing + (type visit-type "type" string->symbol) ;'git | 'git-checkout | ... (number visit-number "visit")) ;; -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:58 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:58 +0000 Received: from localhost ([127.0.0.1]:46395 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeL-00005k-8t for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:57 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40896) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeG-0008Vx-LV for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:53 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdh-0002vy-4o; Tue, 05 Mar 2024 06:07:17 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Hucc6WJuBhVi+/2k46omilZnN1Sg3HuEcy/BKiZe2OU=; b=YEWn1VA8fPRK3BpB/Z0l 1h5B6BXU1DlB9+/klr2J8zQTyLyTGrhNBUQN2rYctQ/vARxr7KzMazNbBZVbWBXyhkg4G479JUqAn riij859hyWFGBqotcABAEPg/0SdQFg4g66dZliqCK9hBRxu9aV8Qq5i8fgf34uE9qN890kozZYu4o hkYGIN3uKvLGMOuv5sSpTJp5HdeHY1/hdUaK/pSMXrcltjjlNzePpz9XVeuj1sFSc781Tfk6oXzSL /rWv5FQDjK7OqnK8yze6RinBH3il/9lMkZA67v5txILY7AG/07t4ax20dmoHuXAVs9EDKerQtMvkE fqva+rzCnov32Q==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 05/12] =?UTF-8?q?swh:=20=E2=80=98origin-visits=E2=80=99?= =?UTF-8?q?=20takes=20an=20optional=20=E2=80=98max=E2=80=99=20parameter.?= Date: Tue, 5 Mar 2024 12:06:53 +0100 Message-ID: <170679e479acdb28dbe721f77e4368098e7cd97e.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/swh.scm (origin-visits): Add optional ‘max’ parameter and honor it. Change-Id: I642d7d4b0672b68fb5c7ce2b49161307e13d3c95 --- guix/swh.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/guix/swh.scm b/guix/swh.scm index 83f67423c8..14c65f6806 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -474,10 +474,11 @@ (define* (lookup-directory-by-nar-hash hash #:optional (algorithm 'sha256)) hash) external-id-target)) -(define (origin-visits origin) - "Return the list of visits of ORIGIN, a record as returned by -'lookup-origin'." - (call (swh-url (origin-visits-url origin)) +(define* (origin-visits origin #:optional (max 10)) + "Return the list of the up to MAX latest visits of ORIGIN, a record as +returned by 'lookup-origin'." + (call (string-append (swh-url (origin-visits-url origin)) + "?per_page=" (number->string max)) (lambda (port) (map json->visit (vector->list (json->scm port)))))) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:58 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:59 +0000 Received: from localhost ([127.0.0.1]:46397 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeL-00005z-Vx for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:58 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40894) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeG-0008Vw-7B for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:53 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdf-0002vD-A9; Tue, 05 Mar 2024 06:07:15 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=J2NKJ/7s0Llg3irvfcBHgHZYrMwIa3sokuS2T42kAy8=; b=cD1S49PoeGCGZaHcdnOy ko9aXsl19wvZ909MncwgkizFh4mnXNkaYb6f+Eb3m7x6f+R8+dCHV/3g/s6DxtS+IGa8IAPHHLgsF D2APZLRdDVw0H/LcVPHjVPEKH68qrmKZa1V2czBbtGBzeD7YE5tiMKJm0ldwFBI8HYtLkbqaSMnGk o/O6RzpD7n1koY+gNxrDpylw2qxSDza3W5zgtly5dnstSFOIUTw+HAtse5cXiAcdHFThjhhYaVTfB jrG3H+CkVfZTsrf/8iA5VTu1ZmDSBzxNxGOHNpmlkd0zehjNiQ9wI6/Ye+D/fNDpLGCKPw4NzyULx Ju0Y8cO0X2y/RA==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 03/12] =?UTF-8?q?lint:=20archival:=20Trigger=20?= =?UTF-8?q?=E2=80=9CSave=20Code=20Now=E2=80=9D=20for=20VCSes=20other=20tha?= =?UTF-8?q?n=20Git.?= Date: Tue, 5 Mar 2024 12:06:51 +0100 Message-ID: <3ca956c57b34c820ee0e43a71334a512079c3732.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) From: Ludovic Courtès Until now, ‘save-origin’ would be called only when given a . With this change, ‘save-origin’ gets called for other version control systems as well. * guix/lint.scm (swh-response->warning): New procedure, formerly in ‘check-archival’. (vcs-origin, save-package-source): New procedures. (check-archival)[response->warning]: Remove. Call ‘save-package-source’ in both the Git and the non-Git cases. * tests/lint.scm ("archival: missing svn revision"): New test. Change-Id: I535e4ec89488faf83bfa544d5e4935fa73ef54fb --- guix/lint.scm | 140 +++++++++++++++++++++++++++++++------------------ tests/lint.scm | 20 +++++++ 2 files changed, 109 insertions(+), 51 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index ad84048660..68d532968d 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -67,6 +67,10 @@ (define-module (guix lint) svn-multi-reference-url svn-multi-reference-user-name svn-multi-reference-password) + #:autoload (guix hg-download) (hg-reference? + hg-reference-url) + #:autoload (guix bzr-download) (bzr-reference? + bzr-reference-url) #:use-module (guix import stackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -1632,6 +1636,69 @@ (define (lookup-disarchive-spec hash) (extract-swh-id spec))))) %disarchive-mirrors)) +(define (swh-response->warning package url method response) + "Given RESPONSE, the response of METHOD on URL, return a suitable warning +list for PACKAGE." + (if (request-rate-limit-reached? url method) + (list (make-warning package + (G_ "Software Heritage rate limit reached; \ +try again later") + #:field 'source)) + (list (make-warning package + (G_ "'~a' returned ~a") + (list url (response-code response)) + #:field 'source)))) + +(define (vcs-origin origin) + "Return two values: the URL and type (a string) of the version-control used +for ORIGIN. Return #f and #f if ORIGIN is not a version-control checkout." + (match (and=> origin origin-uri) + ((? git-reference? ref) + (values (git-reference-url ref) "git")) + ((? svn-reference? ref) + (values (svn-reference-url ref) "svn")) + ((? svn-multi-reference? ref) + (values (svn-multi-reference-url ref) "svn")) + ((? hg-reference? ref) + (values (hg-reference-url ref) "hg")) + ((? bzr-reference? ref) + (values (bzr-reference-url ref) "bzr")) + ;; XXX: Not sure what to do with the weird CVS URIs (:pserver: etc.). + (_ + (values #f #f)))) + +(define (save-package-source package) + "Attempt to save the source of PACKAGE on SWH. Return a list of warnings." + (let* ((origin (package-source package)) + (url type (if origin (vcs-origin origin) (values #f #f)))) + (cond ((and url type) + (catch 'swh-error + (lambda () + (save-origin url type) + (list (make-warning + package + ;; TRANSLATORS: "Software Heritage" is a proper noun that + ;; must remain untranslated. See + ;; . + (G_ "scheduled Software Heritage archival") + #:field 'source))) + (lambda (key url method response . _) + (cond ((= 429 (response-code response)) + (list (make-warning + package + (G_ "archival rate limit exceeded; \ +try again later") + #:field 'source))) + (else + (swh-response->warning package url method response)))))) + ((not origin) + '()) + (else + (list (make-warning + package + (G_ "source code cannot be archived") + #:field 'source)))))) + (define (check-archival package) "Check whether PACKAGE's source code is archived on Software Heritage. If it's not, and if its source code is a VCS snapshot, then send a \"save\" @@ -1640,17 +1707,6 @@ (define (check-archival package) Software Heritage imposes limits on the request rate per client IP address. This checker prints a notice and stops doing anything once that limit has been reached." - (define (response->warning url method response) - (if (request-rate-limit-reached? url method) - (list (make-warning package - (G_ "Software Heritage rate limit reached; \ -try again later") - #:field 'source)) - (list (make-warning package - (G_ "'~a' returned ~a") - (list url (response-code response)) - #:field 'source)))) - (define skip-key (gensym "skip-archival-check")) (define (skip-when-limit-reached url method) @@ -1685,28 +1741,8 @@ (define (check-archival package) '()) (#f ;; Revision is missing from the archive, attempt to save it. - (catch 'swh-error - (lambda () - (save-origin (git-reference-url reference) "git") - (list (make-warning - package - ;; TRANSLATORS: "Software Heritage" is a proper noun - ;; that must remain untranslated. See - ;; . - (G_ "scheduled Software Heritage archival") - #:field 'source))) - (lambda (key url method response . _) - (cond ((= 429 (response-code response)) - (list (make-warning - package - (G_ "archival rate limit exceeded; \ -try again later") - #:field 'source))) - (else - (response->warning url method response)))))))) + (save-package-source package)))) ((? origin? origin) - ;; Since "save" origins are not supported for non-VCS source, all - ;; we can do is tell whether a given tarball is available or not. (if (and=> (origin-hash origin) ;XXX: for ungoogled-chromium content-hash-value) ;& icecat (let ((hash (origin-hash origin))) @@ -1715,26 +1751,28 @@ (define (check-archival package) (symbol->string (content-hash-algorithm hash)))) (#f - ;; If SWH doesn't have HASH as is, it may be because it's - ;; a hand-crafted tarball. In that case, check whether - ;; the Disarchive database has an entry for that tarball. - (match (lookup-disarchive-spec hash) - (#f - (list (make-warning package - (G_ "source not archived on Software \ + ;; If ORIGIN is a version-control checkout, save it now. + ;; If not, check whether HASH is in the Disarchive + ;; database ("Save Code Now" does not accept tarballs). + (if (vcs-origin origin) + (save-package-source package) + (match (lookup-disarchive-spec hash) + (#f + (list (make-warning package + (G_ "source not archived on Software \ Heritage and missing from the Disarchive database") - #:field 'source))) - (directory-ids - (match (find (lambda (id) - (not (lookup-directory id))) - directory-ids) - (#f '()) - (id - (list (make-warning package - (G_ "\ + #:field 'source))) + (directory-ids + (match (find (lambda (id) + (not (lookup-directory id))) + directory-ids) + (#f '()) + (id + (list (make-warning package + (G_ "\ Disarchive entry refers to non-existent SWH directory '~a'") - (list id) - #:field 'source))))))) + (list id) + #:field 'source)))))))) ((? content?) '()) ((? string? swhid) @@ -1749,7 +1787,7 @@ (define (check-archival package) #:field 'source))))) (match-lambda* (('swh-error url method response) - (response->warning url method response)) + (swh-response->warning package url method response)) ((key . args) (if (eq? key skip-key) '() diff --git a/tests/lint.scm b/tests/lint.scm index 87213fcc78..95d82d7490 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1407,6 +1407,26 @@ (define (package-with-phase-changes changes) (check-archival (dummy-package "x" (source origin))))))) (warning-contains? "scheduled" warnings))) +(test-assert "archival: missing svn revision" + (let* ((origin (origin + (method svn-fetch) + (uri (svn-reference + (url "http://example.org/svn/foo") + (revision "1234"))) + (sha256 (make-bytevector 32)))) + ;; https://archive.softwareheritage.org/api/1/origin/save/ + (save "{ \"origin_url\": \"http://example.org/svn/foo\", + \"save_request_date\": \"2014-11-17T22:09:38+01:00\", + \"save_request_status\": \"accepted\", + \"save_task_status\": \"scheduled\" }") + (warnings (with-http-server `((404 "No extid.") ;lookup-directory-by-nar-hash + (404 "No revision.") ;lookup-revision + (404 "No origin.") ;lookup-origin + (200 ,save)) ;save-origin + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin))))))) + (warning-contains? "scheduled" warnings))) + (test-equal "archival: revision available" '() (let* ((origin (origin -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:07:59 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:07:59 +0000 Received: from localhost ([127.0.0.1]:46399 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeM-00006D-V1 for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:59 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40908) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeI-0008W0-6J for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:54 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdi-0002wG-4H; Tue, 05 Mar 2024 06:07:18 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=sPOsCgLubkee2GGfJt8QIFvys49VqYkuvP8nxBPM+r0=; b=XiiZgv8AJJQKnvfK3V6A ZiAcLFI8K3Su/V4CncyzgqMdJMJmXhZ4EY77K/SgLeAZdPlYme18ZjS3jKA5mQpg0D9GVer6bNxLQ 4KBS6SFpQjpZcHq6EOxoT1zb79OeLVa8vg18FhqWZp9EKEwFElU/C+GZBCDWsRdigaLjjLINxL2B1 ieSTvSx1e/jwXq/LC5bPzTcFL1OaLvXDVbmm5dpsOi4ZDFKln/qF0twGKNcU4OXm4pVv1UCFmTuVQ T3b1mgg8Z+aEXUDkQ7m8aVW1zreo0tfFm5p06W118j+FCesD3oQ8khxU5qkpT9tAUpvNlj3x39++d FPj56PJ0jeo6EA==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 06/12] =?UTF-8?q?swh:=20=E2=80=98lookup-origin-revision?= =?UTF-8?q?=E2=80=99=20handles=20branches=20pointing=20to=20directories.?= Date: Tue, 5 Mar 2024 12:06:54 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes . * guix/swh.scm (branch-target): Add clause for 'directory and 'alias. (lookup-origin-revision): Iterate over all the visits of ORIGIN instead of just the first one. Handle the case where ‘branch-target’ returns something other than a release or revision. * tests/swh.scm ("lookup-origin-revision"): New test. Change-Id: I7f636739a719908763bca1d3e7376341dd62e816 --- guix/swh.scm | 60 ++++++++++++++++++++++------------------- tests/swh.scm | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 27 deletions(-) diff --git a/guix/swh.scm b/guix/swh.scm index 14c65f6806..f602cd89d1 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -516,14 +516,20 @@ (define (lookup-snapshot-branch snapshot name) (_ #f))))) (define (branch-target branch) - "Return the target of BRANCH, either a or a ." + "Return the target of BRANCH: a , a , or the SWHID of a +directory." (match (branch-target-type branch) ('release (call (swh-url (branch-target-url branch)) json->release)) ('revision (call (swh-url (branch-target-url branch)) - json->revision)))) + json->revision)) + ((or 'directory 'alias) + (match (string-tokenize (branch-target-url branch) + (char-set-complement (char-set #\/))) + ((_ ... "directory" id) + (string-append "swh:1:dir:" id)))))) (define (lookup-origin-revision url tag) "Return a corresponding to the given TAG for the repository @@ -537,31 +543,31 @@ (define (lookup-origin-revision url tag) (match (lookup-origin url) (#f #f) (origin - (match (filter (lambda (visit) - ;; Return #f if (visit-snapshot VISIT) would return #f. - (and (visit-snapshot-url visit) - (eq? 'full (visit-status visit)))) - (origin-visits origin)) - ((visit . _) - (let ((snapshot (visit-snapshot visit))) - (match (and=> (find (lambda (branch) - (or - ;; Git specific. - (string=? (string-append "refs/tags/" tag) - (branch-name branch)) - ;; Hg specific. - (string=? tag - (branch-name branch)))) - (snapshot-branches snapshot)) - branch-target) - ((? release? release) - (release-target release)) - ((? revision? revision) - revision) - (#f ;tag not found - #f)))) - (() - #f))))) + (any (lambda (visit) + (and (visit-snapshot-url visit) + (eq? 'full (visit-status visit)) + (let ((snapshot (visit-snapshot visit))) + (match (and=> (find (lambda (branch) + (or + ;; Git specific. + (string=? (string-append "refs/tags/" tag) + (branch-name branch)) + ;; Hg specific. + (string=? tag + (branch-name branch)))) + (snapshot-branches snapshot)) + branch-target) + ((? release? release) + (release-target release)) + ((? revision? revision) + revision) + (_ + ;; Either the branch points to a directory rather than + ;; a revision (this is the case for visits of type + ;; 'git-checkout, 'hg-checkout, 'tarball-directory, + ;; etc.), or TAG was not found. + #f))))) + (origin-visits origin 30))))) (define (release-target release) "Return the revision that is the target of RELEASE." diff --git a/tests/swh.scm b/tests/swh.scm index e7ced6b50c..11dcbdddd8 100644 --- a/tests/swh.scm +++ b/tests/swh.scm @@ -109,6 +109,80 @@ (define-syntax-rule (with-json-result str exp ...) (directory-entry-length entry))) (lookup-directory "123")))) +(test-equal "lookup-origin-revision" + '("cd86c72084993d9ef26fc9e24b73cea612b8c97b" + "d173c707ee88e3c89401ad77fafa65fcd9e9f5be") + (let () + ;; Make sure that 'lookup-origin-revision' does the job, and in particular + ;; that it doesn't stop until it has found an actual revision: + ;; 'git-checkout visits point to directories instead of revisions. + ;; See . + (define visits + ;; Two visits of differing types: the first visit (type 'git-checkout') + ;; points to a directory, the second one (type 'git') points to a + ;; revision. + "[ { + \"origin\": \"https://example.org/repo.git\", + \"visit\": 1, + \"type\": \"git-checkout\", + \"date\": \"2020-05-17T21:43:45.422977+00:00\", + \"status\": \"full\", + \"metadata\": {}, + \"type\": \"git-checkout\", + \"origin_visit_url\": \"/visit/42\", + \"snapshot_url\": \"/snapshot/1\" + }, { + \"origin\": \"https://example.org/repo.git\", + \"visit\": 2, + \"type\": \"git\", + \"date\": \"2020-05-17T21:43:49.422977+00:00\", + \"status\": \"full\", + \"metadata\": {}, + \"type\": \"git\", + \"origin_visit_url\": \"/visit/41\", + \"snapshot_url\": \"/snapshot/2\" + } ]") + (define snapshot-for-git-checkout + "{ \"id\": 42, + \"branches\": { \"1.3.2\": { + \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\", + \"target_type\": \"directory\", + \"target_url\": \"/directory/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\" + }} + }") + (define snapshot-for-git + "{ \"id\": 42, + \"branches\": { \"1.3.2\": { + \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\", + \"target_type\": \"revision\", + \"target_url\": \"/revision/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\" + }} + }") + (define revision + "{ \"author\": {}, + \"committer\": {}, + \"committer_date\": \"2018-05-17T21:43:49.422977+00:00\", + \"date\": \"2018-05-17T21:43:49.422977+00:00\", + \"directory\": \"d173c707ee88e3c89401ad77fafa65fcd9e9f5be\", + \"directory_url\": \"/directory/d173c707ee88e3c89401ad77fafa65fcd9e9f5be\", + \"id\": \"cd86c72084993d9ef26fc9e24b73cea612b8c97b\", + \"merge\": false, + \"message\": \"Fix.\", + \"parents\": [], + \"type\": \"what type?\" + }") + + (with-http-server `((200 ,%origin) + (200 ,visits) + (200 ,snapshot-for-git-checkout) + (200 ,snapshot-for-git) + (200 ,revision)) + (parameterize ((%swh-base-url (%local-url))) + (let ((revision (lookup-origin-revision "https://example.org/repo.git" + "1.3.2"))) + (list (revision-id revision) + (revision-directory revision))))))) + (test-equal "lookup-directory-by-nar-hash" "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153" (with-json-result %external-id -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:00 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:00 +0000 Received: from localhost ([127.0.0.1]:46403 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeN-00006P-Ro for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40910) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeI-0008W1-KZ for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:55 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdj-0002wb-5n; Tue, 05 Mar 2024 06:07:19 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=tn7XnRlT0ne20UQYW6HkO1+8mS23Op5Nm/U0W5j/K4I=; b=LooflkKDANyZLx8+LwR5 me6UhVmMZUz+eY8epF822aJYFreGapg/9Alc6xhrW9m9N68gig5Ure14QFwAz0djbP8IkfPRMfzo+ 4xPX8D0SMjFkTgYpcqM7uKMSEna7xZKSpb6Fovl6UZNmsjpFJIhQRtO78N17We2cs2rlEjdLRFJmh 52WgNN4OrE8DSOdZSNOFHE+GamiSz4Dg2nMmFjKUmSfmynHkjfUoDpEykvEx6VCO+8ftk8QuUYwkp muIVAU9VGFdwhRfHUfdP9t2Qg2qhSApt0qjVtrG0JwBeOGpOy90Eef5vsngZ6iZwtGiXZV5fV7U4k ml/ERpnt/M1fpQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 07/12] =?UTF-8?q?hg-download:=20Use=20=E2=80=98swh-down?= =?UTF-8?q?load-directory-by-nar-hash=E2=80=99.?= Date: Tue, 5 Mar 2024 12:06:55 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This allows content-addressed access to the checkout, which is preferable. * guix/hg-download.scm (hg-fetch): Add call to ‘swh-download-directory-by-nar-hash’ before ‘swh-download’ call. Change-Id: I2afc8badc1f8bb2c8bdd3a47abbb72d455d93e64 --- guix/hg-download.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 6d02de47e4..dd28d9c244 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès ;;; Copyright © 2016 Ricardo Wurmus ;;; Copyright © 2021 Xinglu Chen ;;; @@ -117,9 +117,11 @@ (define* (hg-fetch ref hash-algo hash (parameterize ((%verify-swh-certificate? #f)) (format (current-error-port) "Trying to download from Software Heritage...~%") - (swh-download #$(hg-reference-url ref) - #$(hg-reference-changeset ref) - #$output))))))) + (or (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output) + (swh-download #$(hg-reference-url ref) + #$(hg-reference-changeset ref) + #$output)))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:00 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:00 +0000 Received: from localhost ([127.0.0.1]:46405 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeO-00006b-9V for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:49810) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeL-00004v-2G for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:57 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdl-0002x1-7b; Tue, 05 Mar 2024 06:07:21 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=G6BugkD26wUOoZWh1+LBXLc9ti+OqXPrxU6iVh4uZ90=; b=cKBldQrQbI3tjad25y4V mfeKs9DGVP5RVwbv4aLIdyRbhEfvVamdllpNglxnclhz+k5vml6S75YtQEYMzQu2BKQsJzwv3O9LU G7rAmXVl7Qmy6r3nx6+dKkwCElZZ9paFUep4szxltEp6NMPMQti0cpce798xWhX75Y+QgLbtSrpe9 our+/4kz2TrT5UY8PmYBnsr26KcWF1+pN7Azow2NmK/vxM+9x9Bge2rLGk3RE7TLvhCUozTDi6Q8j Q+mhiUPbXoAtq8us86M2+u6b684rlCCZTBPP9ddKBz2Bty7xQcTr0l3xLDBSiqgyaVnuifmQQGsP+ kyB6P26dFVTNEQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 09/12] bzr-download: Implement nar fallback. Date: Tue, 5 Mar 2024 12:06:57 +0100 Message-ID: <09b424cf6c561426047790d7bca50055b5caad21.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) * guix/bzr-download.scm (bzr-fetch)[guile-json, guile-lzlib, guile-gnutls]: New variables. [build]: Add ‘with-extensions’ and import more modules. Invoke ‘download-nar’ when ‘bzr-fetch’ returns #f. * guix/build/bzr.scm (bzr-fetch): Actually return #t on success. Change-Id: Id5d4ebd0f9ddc3c44b6456d3b46c0000cc7b9997 --- guix/build/bzr.scm | 3 ++- guix/bzr-download.scm | 43 ++++++++++++++++++++++++++++++++----------- 2 files changed, 34 insertions(+), 12 deletions(-) diff --git a/guix/build/bzr.scm b/guix/build/bzr.scm index a0f5e15880..dede5e031a 100644 --- a/guix/build/bzr.scm +++ b/guix/build/bzr.scm @@ -37,6 +37,7 @@ (define* (bzr-fetch url revision directory (invoke bzr-command "-Ossl.cert_reqs=none" "checkout" "--lightweight" "-r" revision url directory) (with-directory-excursion directory - (delete-file-recursively ".bzr"))) + (delete-file-recursively ".bzr")) + #t) ;;; bzr.scm ends here diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm index d97f84838e..01c12fd54d 100644 --- a/guix/bzr-download.scm +++ b/guix/bzr-download.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2022 Maxim Cournoyer +;;; Copyright © 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,20 +52,40 @@ (define (bzr-package) (module-ref distro 'breezy))) (define* (bzr-fetch ref hash-algo hash - #:optional name - #:key (system (%current-system)) (guile (default-guile)) - (bzr (bzr-package))) + #:optional name + #:key (system (%current-system)) (guile (default-guile)) + (bzr (bzr-package))) "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." + (define guile-json + (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4)) + + (define guile-lzlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib)) + + (define guile-gnutls + (module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls)) + (define build - (with-imported-modules (source-module-closure - '((guix build bzr))) - #~(begin - (use-modules (guix build bzr)) - (bzr-fetch - (getenv "bzr url") (getenv "bzr reference") #$output - #:bzr-command (string-append #+bzr "/bin/brz"))))) + (with-extensions (list guile-gnutls guile-lzlib guile-json) + (with-imported-modules (source-module-closure + '((guix build bzr) + (guix build utils) + (guix build download-nar))) + #~(begin + (use-modules (guix build bzr) + (guix build download-nar) + (guix build utils) + (srfi srfi-34)) + + (or (guard (c ((invoke-error? c) + (report-invoke-error c) + #f)) + (bzr-fetch (getenv "bzr url") (getenv "bzr reference") + #$output + #:bzr-command (string-append #+bzr "/bin/brz"))) + (download-nar #$output)))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "bzr-branch") build @@ -79,7 +100,7 @@ (define* (bzr-fetch ref hash-algo hash "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") #:system system - #:local-build? #t ;don't offload repo branching + #:local-build? #t ;don't offload repo branching #:hash-algo hash-algo #:hash hash #:recursive? #t -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:15 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:15 +0000 Received: from localhost ([127.0.0.1]:46465 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeW-00009D-OZ for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:15 -0500 Received: from eggs.gnu.org ([209.51.188.92]:49800) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeL-00004u-2m for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:58 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdk-0002wu-6m; Tue, 05 Mar 2024 06:07:21 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=kn6fmIGpiP7s+2FT3HULwuTCk/sW1ObA6ST/vQdp6kI=; b=TMMOcWmt8tHItyhjXPMG ZyvE/vD49VCzqIvrzmuTzCXYv9Sezq8SdTpRtdl1V7pWBPKUfL8rDZNTXqXZHpKdvcFunDWVzCA4m pJpqJaWpFMWr2AYHMy83ZkzVQzPw7Jk17yx448DcTSaU9n50CbEW0mSfrTsxjB2HdUpwCZwFhL9sO XV7+ogQHF/oQ5XO1mjKWc3hGmAin0FxaSxjbV6j3HSTz6FQfnx2DqxuTpbe2QLpkr8YmCLXGC0Dew DJKdr4TKxjM6Zh4V7iO1lc6QAX6VR57A3AfaiSVHzCCjH56tW1wkP5VqfYdIvrfcYS26oJHh40gFf dfwVanRU66BgRw==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 08/12] =?UTF-8?q?svn-download:=20Use=20=E2=80=98swh-dow?= =?UTF-8?q?nload-directory-by-nar-hash=E2=80=99.?= Date: Tue, 5 Mar 2024 12:06:56 +0100 Message-ID: <81113a322b0f885ed0e09867b00a1ca46c6c7bbd.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Fixes . * guix/svn-download.scm (svn-fetch)[build]: Add ‘swh-download-directory-by-nar-hash’ call as a last resort. Import (guix swh). * guix/svn-download.scm (svn-multi-fetch)[build]: Likewise. Change-Id: Ifcb9be1e9c2b05ce172c44e45dcf3a3ea6df8e76 --- guix/svn-download.scm | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index c6688908de..64af996a06 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2016, 2019, 2021-2023 Ludovic Courtès +;;; Copyright © 2014-2016, 2019, 2021-2024 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus ;;; @@ -94,12 +94,14 @@ (define* (svn-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build svn) (guix build download-nar) - (guix build utils))) + (guix build utils) + (guix swh))) (with-extensions (list guile-json guile-gnutls ;for (guix swh) guile-lzlib) #~(begin (use-modules (guix build svn) (guix build download-nar) + (guix swh) (ice-9 match)) (or (svn-fetch (getenv "svn url") @@ -111,7 +113,10 @@ (define* (svn-fetch ref hash-algo hash (_ #f)) #:user-name (getenv "svn user name") #:password (getenv "svn password")) - (download-nar #$output)))))) + (download-nar #$output) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -174,13 +179,15 @@ (define* (svn-multi-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build svn) (guix build download-nar) - (guix build utils))) + (guix build utils) + (guix swh))) (with-extensions (list guile-json guile-gnutls ;for (guix swh) guile-lzlib) #~(begin (use-modules (guix build svn) (guix build utils) (guix build download-nar) + (guix swh) (srfi srfi-1) (ice-9 match)) @@ -206,7 +213,14 @@ (define* (svn-multi-fetch ref hash-algo hash (begin (when (file-exists? #$output) (delete-file-recursively #$output)) - (download-nar #$output))))))) + (or (download-nar #$output) + (parameterize ((%verify-swh-certificate? #f)) + ;; SWH keeps HASH as an ExtID for the combination of + ;; files/directories, which allows us to retrieve the + ;; entire combination at once: + ;; . + (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:15 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:15 +0000 Received: from localhost ([127.0.0.1]:46471 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSed-00009X-5B for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:15 -0500 Received: from eggs.gnu.org ([209.51.188.92]:49816) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeN-00005N-3b for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:07:59 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdn-0002xt-Gw; Tue, 05 Mar 2024 06:07:23 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=r1S7QRxOSIfz/tH9fyNFWCjkYdbX+9xm2B1kmVqebQ0=; b=Ic2LOc+fLaKQFgyBrX9b s4nGiQ3D5sU7eLMm9LNL5Jdth2o0Vzr3AxmnTiGEmrSNvQVlpL1z1itSpeUN0Pd8wEwDNEtOYlYAt k6a7ZQU4JJmsYiMAdmASfuQNbr9ZT5CMaeJO6+ChPbw5FR2or9iKG2/IO7AXS/tlycFPUzvxX93E8 x6fABvQYew6Jig2GlHSrTQ2XxWvbr5Byjz0OY2Aeb9oUX6vKOJNgF27HdSQxmHlbzLJYA1xqAXXvH Sg/Z9rfRGcoMWGSatYLdmVHLqpCfXQbjTCcrdzbzGK+bMfBdg5pvkz2tZGfa8pmz8AD76a+GGLNw2 4mBIBWoE3+l1LQ==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 10/12] =?UTF-8?q?download-nar:=20Distinguish=20?= =?UTF-8?q?=E2=80=98output=E2=80=99=20and=20=E2=80=98item=E2=80=99=20param?= =?UTF-8?q?eter.?= Date: Tue, 5 Mar 2024 12:06:58 +0100 Message-ID: <559b047af3adb608ef8245faadb0c7089dd2de1a.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This is useful when running a ‘--check’ build, where the output file name differs from the store file name we are trying to restore. * guix/build/download-nar.scm (download-nar): Add ‘output’ parameter and distinguish it from ‘item’. Change-Id: I42219b6d4c8fd1ed506720301384efc1aa351561 --- guix/build/download-nar.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 3ba121b7fb..f26ad28cd0 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2019, 2020 Ludovic Courtès +;;; Copyright © 2017, 2019, 2020, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,9 +57,9 @@ (define (restore-lzipped-nar port item size) (restore-file decompressed-port item)))) -(define (download-nar item) - "Download and extract the normalized archive for ITEM. Return #t on -success, #f otherwise." +(define* (download-nar item #:optional (output item)) + "Download and extract to OUTPUT the normalized archive for ITEM, a store +item. Return #t on success, #f otherwise." ;; Let progress reports go through. (setvbuf (current-error-port) 'none) (setvbuf (current-output-port) 'none) @@ -96,10 +96,10 @@ (define (download-nar item) #:download-size size))) (if (string-contains url "/lzip") (restore-lzipped-nar port-with-progress - item + output size) (restore-file port-with-progress - item))) + output))) (newline) #t)))) (() -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:16 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:16 +0000 Received: from localhost ([127.0.0.1]:46473 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSed-00009j-Sj for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:16 -0500 Received: from eggs.gnu.org ([209.51.188.92]:49830) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeO-00005c-Ua for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:01 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSdp-0002yW-CM; Tue, 05 Mar 2024 06:07:25 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=Xd3ynKgR2neJ0oh4LY9MYvQqEdzV/095+EAdboz2Jv8=; b=rwJcDGGRcbei3rWwwF8z KEojtIiCcNt7JP285iQUMBzz5CesdBewRbCJaLzlM4piMCHQtiGC4QGLOe+AcXOiuqMz6MsFgmy0c ePRlLNBYz2UsIe1ZgFot2NO20a06XB0OKzO9Yyk487uaqppvLGslOCqdo6oUkvKFG2HD0NJSfDP2b UN4LnZK7XGjtNjZh4uy5vIUDBJ785ShkngP6E1ZJ6qmBodufo7e8kFMUw/d3USOWVBNm2USUbwWAz 7Wwd+ztE5djz5UMOnfLxME5Icuq5cabtHmgcZzGsACO+HjxCi4Qf2J8w+PWZIjVkzTAMZVs5ACN9Z vFVSWOvmgd5zEg==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 11/12] =?UTF-8?q?perform-download:=20Allow=20use=20of?= =?UTF-8?q?=20=E2=80=98download-nar=E2=80=99=20for=20=E2=80=98--check?= =?UTF-8?q?=E2=80=99=20builds.?= Date: Tue, 5 Mar 2024 12:06:59 +0100 Message-ID: <06837fef6279131031f9fe5a176624167c3d46b0.1709636144.git.ludo@gnu.org> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) Previously, the nar fallback would always fail on ‘--check’ build because the output directory in that case is different from the store file name. This change fixes that. * guix/build/git.scm (git-fetch-with-fallback): Add #:item parameter and pass it to ‘download-nar’. * guix/scripts/perform-download.scm (perform-git-download): Pass #:item to ‘git-fetch-with-fallback’. Change-Id: I30fc948718e99574005150bba5215a51ef153c49 --- guix/build/git.scm | 14 ++++++++------ guix/scripts/perform-download.scm | 3 +++ 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/guix/build/git.scm b/guix/build/git.scm index 4c69365a7b..a135026fae 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -92,19 +92,21 @@ (define* (git-fetch url commit directory (define* (git-fetch-with-fallback url commit directory - #:key (git-command "git") + #:key (item directory) + (git-command "git") hash hash-algorithm lfs? recursive?) "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to -alternative methods when fetching from URL fails: attempt to download a nar, -and if that also fails, download from the Software Heritage archive. When -HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of -the directory of interested and are used as its content address at SWH." +alternative methods when fetching from URL fails: attempt to download a nar +for ITEM, and if that also fails, download from the Software Heritage archive. +When HASH and HASH-ALGORITHM are provided, they are interpreted as the nar +hash of the directory of interested and are used as its content address at +SWH." (or (git-fetch url commit directory #:lfs? lfs? #:recursive? recursive? #:git-command git-command) - (download-nar directory) + (download-nar item directory) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index e7eb3b2a1f..b96959a09e 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -114,10 +114,13 @@ (define* (perform-git-download drv output ;; on ambient authority, hence the PATH value below. (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") + ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are + ;; different, hence the #:item argument below. (git-fetch-with-fallback url commit output #:hash hash #:hash-algorithm algo #:recursive? recursive? + #:item (derivation-output-path drv-output) #:git-command %git)))) (define (assert-low-privileges) -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 05 06:08:23 2024 Received: (at 69328) by debbugs.gnu.org; 5 Mar 2024 11:08:23 +0000 Received: from localhost ([127.0.0.1]:46477 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSef-00009n-Al for submit@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:49844) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rhSeR-00006C-Ux for 69328@debbugs.gnu.org; Tue, 05 Mar 2024 06:08:09 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rhSds-0002z9-2U; Tue, 05 Mar 2024 06:07:28 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=RulKgo5fhOTEpugzu+DQthBxENMwJ3+0jp4P/SjKYqA=; b=b+ktkCtSnCnzTJc1nFkP s/qauiXQnG3ucncFqE78iXaVvzzDTCeKO/KmoOtXTJaJJNChhsGfHMz2tG7MW2peuaDj85w5uZeKj KyAWyqT3GD4S0WS5ZMFY8uuaVfbk5by4HJjkfV5W5cc0Ux/LTze69RwW7L/pObhIv7B1kdnvAdoJG zoLza8ab/BSTwrFZ6gCKonGIhxhJe+7rSUD3rhc38HF/T9pNnOkqvTv7sicWK/r04PnYWY3A173VZ P/3HcNXquOuVS3svaSz1M0el/52rBpKiLQM5DsAon0oPgRfaNDF4jcSjE1ZsRvw9RQKb8u6z1IFYs 5U1Iq5BzrsiB2g==; From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: 69328@debbugs.gnu.org Subject: [PATCH v2 12/12] =?UTF-8?q?download:=20Honor=20=E2=80=98GUIX=5FDO?= =?UTF-8?q?WNLOAD=5FMETHODS=E2=80=99=20environment=20variable.?= Date: Tue, 5 Mar 2024 12:07:00 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87o7btc5du.fsf@gnu.org> References: <87o7btc5du.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Debbugs-Cc: Christopher Baines , Josselin Poiret , Ludovic Courtès , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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: -3.3 (---) This replaces ‘GUIX_DOWNLOAD_FALLBACK_TEST’ and allows you to test various download methods, like so: GUIX_DOWNLOAD_METHODS=nar guix build guile-gcrypt -S --check GUIX_DOWNLOAD_METHODS=disarchive guix build hello -S --check * guix/build/download.scm (%download-methods): New variable. (download-method-enabled?): New procedure. (url-fetch): Define ‘initial-uris’; honor ‘download-method-enabled?’. Call ‘disarchive-fetch/any’ only when the 'disarchive method is enabled. * guix/build/git.scm (git-fetch-with-fallback): Honor ‘download-method-enabled?’. * guix/download.scm (%download-methods): New variable. (%download-fallback-test): Remove. (built-in-download): Add #:download-methods parameter and honor it. (url-fetch*): Pass #:content-addressed-mirrors and #:disarchive-mirrors unconditionally. * guix/git-download.scm (git-fetch/in-band*): Pass “git url” unconditionally. (git-fetch/built-in): Likewise. Pass “download-methods”. * guix/bzr-download.scm (bzr-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. * guix/cvs-download.scm (cvs-fetch)[build]: Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. * guix/hg-download.scm (hg-fetch): Honor ‘download-method-enabled?’. Pass #:env-vars to ‘gexp->derivation’. * guix/scripts/perform-download.scm (perform-download): Honor “download-methods” from DRV. Parameterize ‘%download-methods’ before calling ‘url-fetch’. (perform-git-download): Likewise. * guix/svn-download.scm (svn-fetch): Honor ‘download-method-enabled?’. Pass ‘GUIX_DOWNLOAD_METHODS’ to #:env-vars. (svn-multi-fetch): Likewise. Change-Id: Ia3402e17f0303dfa964bdc761265efe8a1dd69ab --- guix/build/download.scm | 50 ++++++++++++++---- guix/build/git.scm | 15 ++++-- guix/bzr-download.scm | 28 ++++++---- guix/cvs-download.scm | 24 ++++++--- guix/download.scm | 53 +++++++------------ guix/git-download.scm | 20 +++---- guix/hg-download.scm | 36 ++++++++----- guix/scripts/perform-download.scm | 70 +++++++++++++----------- guix/svn-download.scm | 88 +++++++++++++++++++------------ 9 files changed, 230 insertions(+), 154 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index db0a39084b..74b7486b7b 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès +;;; Copyright © 2012-2022, 2024 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; Copyright © 2021 Timothy Sample @@ -40,7 +40,10 @@ (define-module (guix build download) #:autoload (guix swh) (swh-download-directory %verify-swh-certificate?) #:use-module (ice-9 match) #:use-module (ice-9 format) - #:export (open-socket-for-uri + #:export (%download-methods + download-method-enabled? + + open-socket-for-uri open-connection-for-uri http-fetch %x509-certificate-directory @@ -622,6 +625,20 @@ (define-syntax-rule (false-if-exception* body ...) (lambda (key . args) (print-exception (current-error-port) #f key args)))) +(define %download-methods + ;; Either #f (the default) or a list of symbols denoting the sequence of + ;; download methods to be used--e.g., '(swh nar upstream). + (make-parameter + (and=> (getenv "GUIX_DOWNLOAD_METHODS") + (lambda (str) + (map string->symbol (string-tokenize str)))))) + +(define (download-method-enabled? method) + "Return true if METHOD (a symbol such as 'swh) is enabled as part of the +download fallback sequence." + (or (not (%download-methods)) + (memq method (%download-methods)))) + (define (uri-vicinity dir file) "Concatenate DIR, slash, and FILE, keeping only one slash in between. This is required by some HTTP servers." @@ -788,18 +805,28 @@ (define* (url-fetch url file hashes))) disarchive-mirrors)) + (define initial-uris + (append (if (download-method-enabled? 'upstream) + uri + '()) + (if (download-method-enabled? 'content-addressed-mirrors) + content-addressed-uris + '()) + (if (download-method-enabled? 'internet-archive) + (match uri + ((first . _) + (or (and=> (internet-archive-uri first) list) + '())) + (() '())) + '()))) + ;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; means '\n', not '\r', so it's not appropriate here. (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'line) - (let try ((uri (append uri content-addressed-uris - (match uri - ((first . _) - (or (and=> (internet-archive-uri first) list) - '())) - (() '()))))) + (let try ((uri initial-uris)) (match uri ((uri tail ...) (or (fetch uri file) @@ -807,9 +834,10 @@ (define* (url-fetch url file (() ;; If we are looking for a software archive, one last thing we ;; can try is to use Disarchive to assemble it. - (or (disarchive-fetch/any disarchive-uris file - #:verify-certificate? verify-certificate? - #:timeout timeout) + (or (and (download-method-enabled? 'disarchive) + (disarchive-fetch/any disarchive-uris file + #:verify-certificate? verify-certificate? + #:timeout timeout)) (begin (format (current-error-port) "failed to download ~s from ~s~%" file url) diff --git a/guix/build/git.scm b/guix/build/git.scm index a135026fae..62877394bb 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -19,6 +19,8 @@ (define-module (guix build git) #:use-module (guix build utils) + #:use-module ((guix build download) + #:select (download-method-enabled?)) #:autoload (guix build download-nar) (download-nar) #:autoload (guix swh) (%verify-swh-certificate? swh-download @@ -102,17 +104,20 @@ (define* (git-fetch-with-fallback url commit directory When HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of the directory of interested and are used as its content address at SWH." - (or (git-fetch url commit directory - #:lfs? lfs? - #:recursive? recursive? - #:git-command git-command) - (download-nar item directory) + (or (and (download-method-enabled? 'upstream) + (git-fetch url commit directory + #:lfs? lfs? + #:recursive? recursive? + #:git-command git-command)) + (and (download-method-enabled? 'nar) + (download-nar item directory)) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending ;; on nss-certs--we're authenticating the checkout anyway. ;; XXX: Currently recursive checkouts are not supported. (and (not recursive?) + (download-method-enabled? 'swh) (parameterize ((%verify-swh-certificate? #f)) (format (current-error-port) "Trying to download from Software Heritage...~%") diff --git a/guix/bzr-download.scm b/guix/bzr-download.scm index 01c12fd54d..a22c9bee99 100644 --- a/guix/bzr-download.scm +++ b/guix/bzr-download.scm @@ -24,7 +24,7 @@ (define-module (guix bzr-download) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) - + #:use-module (ice-9 match) #:export (bzr-reference bzr-reference? bzr-reference-url @@ -72,20 +72,26 @@ (define* (bzr-fetch ref hash-algo hash (with-imported-modules (source-module-closure '((guix build bzr) (guix build utils) + (guix build download) (guix build download-nar))) #~(begin (use-modules (guix build bzr) (guix build download-nar) + ((guix build download) + #:select (download-method-enabled?)) (guix build utils) (srfi srfi-34)) - (or (guard (c ((invoke-error? c) - (report-invoke-error c) - #f)) - (bzr-fetch (getenv "bzr url") (getenv "bzr reference") - #$output - #:bzr-command (string-append #+bzr "/bin/brz"))) - (download-nar #$output)))))) + (or (and (download-method-enabled? 'upstream) + (guard (c ((invoke-error? c) + (report-invoke-error c) + #f)) + (bzr-fetch (getenv "bzr url") (getenv "bzr reference") + #$output + #:bzr-command + (string-append #+bzr "/bin/brz")))) + (and (download-method-enabled? 'nar) + (download-nar #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "bzr-branch") build @@ -95,7 +101,11 @@ (define* (bzr-fetch ref hash-algo hash #:script-name "bzr-download" #:env-vars `(("bzr url" . ,(bzr-reference-url ref)) - ("bzr reference" . ,(bzr-reference-revision ref))) + ("bzr reference" . ,(bzr-reference-revision ref)) + ,@(match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value))))) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index c0c526b9db..023054941b 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2014-2017, 2019, 2024 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2015 Mark H Weaver ;;; @@ -73,6 +73,7 @@ (define* (cvs-fetch ref hash-algo hash (define modules (delete '(guix config) (source-module-closure '((guix build cvs) + (guix build download) (guix build download-nar))))) (define build (with-imported-modules modules @@ -80,20 +81,29 @@ (define* (cvs-fetch ref hash-algo hash guile-lzlib) #~(begin (use-modules (guix build cvs) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar)) - (or (cvs-fetch '#$(cvs-reference-root-directory ref) - '#$(cvs-reference-module ref) - '#$(cvs-reference-revision ref) - #$output - #:cvs-command (string-append #+cvs "/bin/cvs")) - (download-nar #$output)))))) + (or (and (download-method-enabled? 'upstream) + (cvs-fetch '#$(cvs-reference-root-directory ref) + '#$(cvs-reference-module ref) + '#$(cvs-reference-revision ref) + #$output + #:cvs-command + #+(file-append cvs "/bin/cvs"))) + (and (download-method-enabled? 'nar) + (download-nar #$output))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") + #:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value)))) #:system system #:hash-algo hash-algo #:hash hash diff --git a/guix/download.scm b/guix/download.scm index 21d02ab203..3dfe143e9f 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2021, 2024 Ludovic Courtès ;;; Copyright © 2013, 2014, 2015 Andreas Enge ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2016 Alex Griffin @@ -35,9 +35,9 @@ (define-module (guix download) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (%mirrors + #:export (%download-methods + %mirrors %disarchive-mirrors - %download-fallback-test (url-fetch* . url-fetch) url-fetch/executable url-fetch/tarbomb @@ -434,10 +434,19 @@ (define %no-disarchive-mirrors-file (define built-in-builders* (store-lift built-in-builders)) +(define %download-methods + ;; Either #f (the default) or a list of symbols denoting the sequence of + ;; download methods to be used--e.g., '(swh nar upstream). + (make-parameter + (and=> (getenv "GUIX_DOWNLOAD_METHODS") + (lambda (str) + (map string->symbol (string-tokenize str)))))) + (define* (built-in-download file-name url #:key system hash-algo hash mirrors content-addressed-mirrors disarchive-mirrors + (download-methods (%download-methods)) executable? (guile 'unused)) "Download FILE-NAME from URL using the built-in 'download' builder. When @@ -471,6 +480,11 @@ (define* (built-in-download file-name url ("disarchive-mirrors" . ,disarchive-mirrors) ,@(if executable? '(("executable" . "1")) + '()) + ,@(if download-methods + `(("download-methods" + . ,(object->string + download-methods))) '())) ;; Do not offload this derivation because we cannot be @@ -479,24 +493,6 @@ (define* (built-in-download file-name url ;; for that built-in is widespread. #:local-build? #t))) -(define %download-fallback-test - ;; Define whether to test one of the download fallback mechanism. Possible - ;; values are: - ;; - ;; - #f, to use the normal download methods, not trying to exercise the - ;; fallback mechanism; - ;; - ;; - 'none, to disable all the fallback mechanisms; - ;; - ;; - 'content-addressed-mirrors, to purposefully attempt to download from - ;; a content-addressed mirror; - ;; - ;; - 'disarchive-mirrors, to download from Disarchive + Software Heritage. - ;; - ;; This is meant to be used for testing purposes. - (make-parameter (and=> (getenv "GUIX_DOWNLOAD_FALLBACK_TEST") - string->symbol))) - (define* (url-fetch* url hash-algo hash #:optional name #:key (system (%current-system)) @@ -532,10 +528,7 @@ (define* (url-fetch* url hash-algo hash (unless (member "download" builtins) (error "'guix-daemon' is too old, please upgrade" builtins)) - (built-in-download (or name file-name) - (match (%download-fallback-test) - ((or #f 'none) url) - (_ "https://example.org/does-not-exist")) + (built-in-download (or name file-name) url #:guile guile #:system system #:hash-algo hash-algo @@ -543,15 +536,9 @@ (define* (url-fetch* url hash-algo hash #:executable? executable? #:mirrors %mirror-file #:content-addressed-mirrors - (match (%download-fallback-test) - ((or #f 'content-addressed-mirrors) - %content-addressed-mirror-file) - (_ %no-mirrors-file)) + %content-addressed-mirror-file #:disarchive-mirrors - (match (%download-fallback-test) - ((or #f 'disarchive-mirrors) - %disarchive-mirror-file) - (_ %no-disarchive-mirrors-file))))))) + %disarchive-mirror-file))))) (define* (url-fetch/executable url hash-algo hash #:optional name diff --git a/guix/git-download.scm b/guix/git-download.scm index aadcbd234c..d26a814e07 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -29,8 +29,8 @@ (define-module (guix git-download) #:use-module (guix packages) #:use-module (guix modules) #:use-module ((guix derivations) #:select (raw-derivation)) + #:autoload (guix download) (%download-methods) #:autoload (guix build-system gnu) (standard-packages) - #:autoload (guix download) (%download-fallback-test) #:autoload (git bindings) (libgit2-init!) #:autoload (git repository) (repository-open repository-close! @@ -180,11 +180,7 @@ (define* (git-fetch/in-band* ref hash-algo hash ;; downloads. #:script-name "git-download" #:env-vars - `(("git url" . ,(match (%download-fallback-test) - ('content-addressed-mirrors - "https://example.org/does-not-exist") - (_ - (git-reference-url ref)))) + `(("git url" . ,(git-reference-url ref)) ("git commit" . ,(git-reference-commit ref)) ("git recursive?" . ,(object->string (git-reference-recursive? ref))) @@ -246,14 +242,14 @@ (define* (git-fetch/built-in ref hash-algo hash #:recursive? #t #:env-vars `(("url" . ,(object->string - (match (%download-fallback-test) - ('content-addressed-mirrors - "https://example.org/does-not-exist") - (_ - (git-reference-url ref))))) + (git-reference-url ref))) ("commit" . ,(git-reference-commit ref)) ("recursive?" . ,(object->string - (git-reference-recursive? ref)))) + (git-reference-recursive? ref))) + ,@(if (%download-methods) + `(("download-methods" + . ,(object->string (%download-methods)))) + '())) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") diff --git a/guix/hg-download.scm b/guix/hg-download.scm index dd28d9c244..55d908817f 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -84,6 +84,7 @@ (define* (hg-fetch ref hash-algo hash (define modules (delete '(guix config) (source-module-closure '((guix build hg) + (guix build download) (guix build download-nar) (guix swh))))) @@ -94,6 +95,8 @@ (define* (hg-fetch ref hash-algo hash #~(begin (use-modules (guix build hg) (guix build utils) ;for `set-path-environment-variable' + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (ice-9 match)) @@ -106,28 +109,35 @@ (define* (hg-fetch ref hash-algo hash (setvbuf (current-output-port) 'line) (setvbuf (current-error-port) 'line) - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output) + (or (and (download-method-enabled? 'upstream) + (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg"))) + (and (download-method-enabled? 'nar) + (download-nar #$output)) ;; As a last resort, attempt to download from Software Heritage. ;; Disable X.509 certificate verification to avoid depending ;; on nss-certs--we're authenticating the checkout anyway. - (parameterize ((%verify-swh-certificate? #f)) - (format (current-error-port) - "Trying to download from Software Heritage...~%") - (or (swh-download-directory-by-nar-hash #$hash '#$hash-algo - #$output) - (swh-download #$(hg-reference-url ref) - #$(hg-reference-changeset ref) - #$output)))))))) + (and (download-method-enabled? 'swh) + (parameterize ((%verify-swh-certificate? #f)) + (format (current-error-port) + "Trying to download from Software Heritage...~%") + (or (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output) + (swh-download #$(hg-reference-url ref) + #$(hg-reference-changeset ref) + #$output))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS") + #:env-vars (match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value)))) #:system system #:local-build? #t ;don't offload repo cloning #:hash-algo hash-algo diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index b96959a09e..5079d0ea71 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -21,7 +21,7 @@ (define-module (guix scripts perform-download) #:use-module (guix scripts) #:use-module (guix derivations) #:use-module ((guix store) #:select (derivation-path? store-path?)) - #:autoload (guix build download) (url-fetch) + #:autoload (guix build download) (%download-methods url-fetch) #:autoload (guix build git) (git-fetch-with-fallback) #:autoload (guix config) (%git) #:use-module (ice-9 match) @@ -55,7 +55,8 @@ (define* (perform-download drv output (executable "executable") (mirrors "mirrors") (content-addressed-mirrors "content-addressed-mirrors") - (disarchive-mirrors "disarchive-mirrors")) + (disarchive-mirrors "disarchive-mirrors") + (download-methods "download-methods")) (unless url (leave (G_ "~a: missing URL~%") (derivation-file-name drv))) @@ -64,26 +65,30 @@ (define* (perform-download drv output (algo (derivation-output-hash-algo drv-output)) (hash (derivation-output-hash drv-output))) ;; We're invoked by the daemon, which gives us write access to OUTPUT. - (when (url-fetch url output - #:print-build-trace? print-build-trace? - #:mirrors (if mirrors - (call-with-input-file mirrors read) - '()) - #:content-addressed-mirrors - (if content-addressed-mirrors - (call-with-input-file content-addressed-mirrors - (lambda (port) - (eval (read port) %user-module))) - '()) - #:disarchive-mirrors - (if disarchive-mirrors - (call-with-input-file disarchive-mirrors read) - '()) - #:hashes `((,algo . ,hash)) + (when (parameterize ((%download-methods + (and download-methods + (call-with-input-string download-methods + read)))) + (url-fetch url output + #:print-build-trace? print-build-trace? + #:mirrors (if mirrors + (call-with-input-file mirrors read) + '()) + #:content-addressed-mirrors + (if content-addressed-mirrors + (call-with-input-file content-addressed-mirrors + (lambda (port) + (eval (read port) %user-module))) + '()) + #:disarchive-mirrors + (if disarchive-mirrors + (call-with-input-file disarchive-mirrors read) + '()) + #:hashes `((,algo . ,hash)) - ;; Since DRV's output hash is known, X.509 certificate - ;; validation is pointless. - #:verify-certificate? #f) + ;; Since DRV's output hash is known, X.509 certificate + ;; validation is pointless. + #:verify-certificate? #f)) (when (and executable (string=? executable "1")) (chmod output #o755)))))) @@ -96,7 +101,8 @@ (define* (perform-git-download drv output 'bmRepair' builds." (derivation-let drv ((url "url") (commit "commit") - (recursive? "recursive?")) + (recursive? "recursive?") + (download-methods "download-methods")) (unless url (leave (G_ "~a: missing Git URL~%") (derivation-file-name drv))) (unless commit @@ -114,14 +120,18 @@ (define* (perform-git-download drv output ;; on ambient authority, hence the PATH value below. (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin") - ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are - ;; different, hence the #:item argument below. - (git-fetch-with-fallback url commit output - #:hash hash - #:hash-algorithm algo - #:recursive? recursive? - #:item (derivation-output-path drv-output) - #:git-command %git)))) + (parameterize ((%download-methods + (and download-methods + (call-with-input-string download-methods + read)))) + ;; Note: When doing a '--check' build, DRV-OUTPUT and OUTPUT are + ;; different, hence the #:item argument below. + (git-fetch-with-fallback url commit output + #:hash hash + #:hash-algorithm algo + #:recursive? recursive? + #:item (derivation-output-path drv-output) + #:git-command %git))))) (define (assert-low-privileges) (when (zero? (getuid)) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index 64af996a06..17a7f4f957 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -93,6 +93,7 @@ (define* (svn-fetch ref hash-algo hash (define build (with-imported-modules (source-module-closure '((guix build svn) + (guix build download) (guix build download-nar) (guix build utils) (guix swh))) @@ -100,23 +101,28 @@ (define* (svn-fetch ref hash-algo hash guile-lzlib) #~(begin (use-modules (guix build svn) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (ice-9 match)) - (or (svn-fetch (getenv "svn url") - (string->number (getenv "svn revision")) - #$output - #:svn-command #+(file-append svn "/bin/svn") - #:recursive? (match (getenv "svn recursive?") - ("yes" #t) - (_ #f)) - #:user-name (getenv "svn user name") - #:password (getenv "svn password")) - (download-nar #$output) - (parameterize ((%verify-swh-certificate? #f)) - (swh-download-directory-by-nar-hash #$hash '#$hash-algo - #$output))))))) + (or (and (download-method-enabled? 'upstream) + (svn-fetch (getenv "svn url") + (string->number (getenv "svn revision")) + #$output + #:svn-command #+(file-append svn "/bin/svn") + #:recursive? (match (getenv "svn recursive?") + ("yes" #t) + (_ #f)) + #:user-name (getenv "svn user name") + #:password (getenv "svn password"))) + (and (download-method-enabled? 'nar) + (download-nar #$output)) + (and (download-method-enabled? 'swh) + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash #$hash '#$hash-algo + #$output)))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -139,7 +145,11 @@ (define* (svn-fetch ref hash-algo hash ,@(if (svn-reference-password ref) `(("svn password" . ,(svn-reference-password ref))) - '())) + '()) + ,@(match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value))))) #:system system #:hash-algo hash-algo @@ -178,6 +188,7 @@ (define* (svn-multi-fetch ref hash-algo hash (define build (with-imported-modules (source-module-closure '((guix build svn) + (guix build download) (guix build download-nar) (guix build utils) (guix swh))) @@ -186,6 +197,8 @@ (define* (svn-multi-fetch ref hash-algo hash #~(begin (use-modules (guix build svn) (guix build utils) + ((guix build download) + #:select (download-method-enabled?)) (guix build download-nar) (guix swh) (srfi srfi-1) @@ -197,30 +210,33 @@ (define* (svn-multi-fetch ref hash-algo hash ;; single file. (unless (string-suffix? "/" location) (mkdir-p (string-append #$output "/" (dirname location)))) - (svn-fetch (string-append (getenv "svn url") "/" location) - (string->number (getenv "svn revision")) - (if (string-suffix? "/" location) - (string-append #$output "/" location) - (string-append #$output "/" (dirname location))) - #:svn-command #+(file-append svn "/bin/svn") - #:recursive? (match (getenv "svn recursive?") - ("yes" #t) - (_ #f)) - #:user-name (getenv "svn user name") - #:password (getenv "svn password"))) + (and (download-method-enabled? 'upstream) + (svn-fetch (string-append (getenv "svn url") "/" location) + (string->number (getenv "svn revision")) + (if (string-suffix? "/" location) + (string-append #$output "/" location) + (string-append #$output "/" (dirname location))) + #:svn-command #+(file-append svn "/bin/svn") + #:recursive? (match (getenv "svn recursive?") + ("yes" #t) + (_ #f)) + #:user-name (getenv "svn user name") + #:password (getenv "svn password")))) (call-with-input-string (getenv "svn locations") read)) (begin (when (file-exists? #$output) (delete-file-recursively #$output)) - (or (download-nar #$output) - (parameterize ((%verify-swh-certificate? #f)) - ;; SWH keeps HASH as an ExtID for the combination of - ;; files/directories, which allows us to retrieve the - ;; entire combination at once: - ;; . - (swh-download-directory-by-nar-hash - #$hash '#$hash-algo #$output))))))))) + (or (and (download-method-enabled? 'nar) + (download-nar #$output)) + (and (download-method-enabled? 'swh) + ;; SWH keeps HASH as an ExtID for the combination + ;; of files/directories, which allows us to + ;; retrieve the entire combination at once: + ;; . + (parameterize ((%verify-swh-certificate? #f)) + (swh-download-directory-by-nar-hash + #$hash '#$hash-algo #$output)))))))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "svn-checkout") build @@ -245,7 +261,11 @@ (define* (svn-multi-fetch ref hash-algo hash ,@(if (svn-multi-reference-password ref) `(("svn password" . ,(svn-multi-reference-password ref))) - '())) + '()) + ,@(match (getenv "GUIX_DOWNLOAD_METHODS") + (#f '()) + (value + `(("GUIX_DOWNLOAD_METHODS" . ,value))))) #:leaked-env-vars '("http_proxy" "https_proxy" "LC_ALL" "LC_MESSAGES" "LANG" -- 2.41.0 From debbugs-submit-bounces@debbugs.gnu.org Thu Mar 07 13:40:22 2024 Received: (at 69328) by debbugs.gnu.org; 7 Mar 2024 18:40:22 +0000 Received: from localhost ([127.0.0.1]:54898 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1riIfG-0007V9-16 for submit@debbugs.gnu.org; Thu, 07 Mar 2024 13:40:22 -0500 Received: from mail-wr1-f44.google.com ([209.85.221.44]:41040) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1riIfE-0007Ut-Ki for 69328@debbugs.gnu.org; Thu, 07 Mar 2024 13:40:21 -0500 Received: by mail-wr1-f44.google.com with SMTP id ffacd0b85a97d-33e73f04309so73360f8f.0 for <69328@debbugs.gnu.org>; Thu, 07 Mar 2024 10:39:48 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1709836723; x=1710441523; darn=debbugs.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:references :in-reply-to:subject:cc:to:from:from:to:cc:subject:date:message-id :reply-to; bh=QCemS8QbAJH5jstny4ycnD9gdiVwurb7msvt7F18ln0=; b=VbSlylt0p7JzSz2FZpxrB6pyImYOE/2DKTowpWzKA3DkPu1T0jqGDfoetewGE5P66k TXI+iNgh/igpNNYI+1kBe0bv3S6KC0mgHKHui34ZJ3ZCr15vjteuWn3YxJO6QqtS8kFg GIoBpnPlkBpqthLQhkOSiSp6SfVutvrunp2cCeHm831iuEiNkcUfJazgyWahireHT5PK zRxMNpnTwZJ71oEg0iSk97buVPMPVf2OcfBs2XRN8Vj5ypdGKWfiZAUJPnamQ6Yn7DPl y57JzQOfqU2MgZRRBFEIE9bLP6aU0+TeBVhLS38ZqZIoIf/W+icOIElCsTOfQjuigk1V aA4g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1709836723; x=1710441523; h=content-transfer-encoding:mime-version:message-id:date:references :in-reply-to:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=QCemS8QbAJH5jstny4ycnD9gdiVwurb7msvt7F18ln0=; b=KKdWQzVIeW+0C12k44mar2FtGdfRDMk/W2zEFNHGjoMLXbucZHzwOLq9fkvtSaGWMH RM1dub4MfcG1fyYx9XL+0rjp4eO2EpaY/H1UrbPZAhqaaJ9v1PyYRxlTKNgmq4Fiiwp6 NsnsA+g/VZmAxCU+XZY/PhvWpYu254idnFOq4lwgLTm7TK0k1vSW/gQLsC2Fq2o7gDNk 3iCIaPr1cbQP5rduROhUl8Fw/UNjB7Bef0VyYyUI0dYVEEz1MVCkTnOa4T+OqgS00FuO lTflzU7uRaq/yDNoPz03fYLVWAoO7wJkRseWU+1I3O4KKB8cYCM3blMeUQJ3AiVv0+LU brPw== X-Forwarded-Encrypted: i=1; AJvYcCVZYvPRYdyV4oWDVratCL9V/VasWDA0p9hate0kkzmwvp78JoGCVHkDZtchwsTx8Wps3AjX9QvQfVxFSSpLbcMLJyeOzPk= X-Gm-Message-State: AOJu0Yz7XKJkHD+KKH/Jrsh7a6ZvZOmjQ1dN5swx1fWoJJ+mHB0afEQ4 oayr7D4bHGwU4/3jaBeKxNqbSYQ1tsKS18j8t5FO9ASOkLo0Fr4h X-Google-Smtp-Source: AGHT+IE4s+Q1SS3PpuOaXAqSfyvAehkV17hDreuVjkVxKAACe0j39xV72qMk/G1L5/t9t8Dg0k28+w== X-Received: by 2002:a05:600c:354d:b0:412:c327:4064 with SMTP id i13-20020a05600c354d00b00412c3274064mr2036621wmq.3.1709836722978; Thu, 07 Mar 2024 10:38:42 -0800 (PST) Received: from lili (roam-nat-fw-prg-194-254-61-41.net.univ-paris-diderot.fr. [194.254.61.41]) by smtp.gmail.com with ESMTPSA id i20-20020a05600c355400b00413079f9065sm3501141wmq.8.2024.03.07.10.38.41 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 07 Mar 2024 10:38:42 -0800 (PST) From: Simon Tournier To: Ludovic =?utf-8?Q?Court=C3=A8s?= , 69328@debbugs.gnu.org Subject: Re: [bug#69328] [PATCH v2 00/12] Better source code recovery from SWH In-Reply-To: References: <87o7btc5du.fsf@gnu.org> Date: Thu, 07 Mar 2024 19:38:34 +0100 Message-ID: <877cidriol.fsf@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 69328 Cc: Timothy Sample , Josselin Poiret , Mathieu Othacehe , Ludovic =?utf-8?Q?Court=C3=A8s?= , Tobias Geerinckx-Rice , Ricardo Wurmus , Christopher Baines 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: -1.0 (-) Hi, On mar., 05 mars 2024 at 12:06, Ludovic Court=C3=A8s wrote: > Ludovic Court=C3=A8s (12): > lint: Switch to SRFI-71. > lint: archival: Fix crash in non-Git case. > lint: archival: Trigger =E2=80=9CSave Code Now=E2=80=9D for VCSes other= than Git. > swh: Add =E2=80=98type=E2=80=99 field to . > swh: =E2=80=98origin-visits=E2=80=99 takes an optional =E2=80=98max=E2= =80=99 parameter. > swh: =E2=80=98lookup-origin-revision=E2=80=99 handles branches pointing= to > directories. > hg-download: Use =E2=80=98swh-download-directory-by-nar-hash=E2=80=99. > svn-download: Use =E2=80=98swh-download-directory-by-nar-hash=E2=80=99. > bzr-download: Implement nar fallback. > download-nar: Distinguish =E2=80=98output=E2=80=99 and =E2=80=98item=E2= =80=99 parameter. > perform-download: Allow use of =E2=80=98download-nar=E2=80=99 for =E2= =80=98--check=E2=80=99 builds. > download: Honor =E2=80=98GUIX_DOWNLOAD_METHODS=E2=80=99 environment var= iable. LGTM. Unrelated things for later. :-)=20 1. About CVS, IIRC, there is only one package: gnu-standards. And it changes barely. Why not fetch from FTP or else instead of CVS? 2. About the lookup, currently it is done item per item when it could be done several at once =E2=80=93 Timothy does that with PoG. This helps for = the rate limit. For instance if one uses =E2=80=9Cguix lint -c archival -m manifest.scm=E2=80=9D. 3. The option =E2=80=99-m=E2=80=99 for =E2=80=9Cguix lint=E2=80=9D seems mi= ssing. These #2 and #3 would help third-party channels, IMHO. Although, I am slowly working on some =E2=80=9Cguix swh=E2=80=9D extension= =E2=80=A6 but I have been distraction by another extension =E2=80=9Cguix try-out=E2=80=9D, then = distracted by another one =E2=80=9Cguix cite=E2=80=9D. Well, I need to finish all my hom= eworks. ;-) Anyway, really nice new features! Cheers, simon From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 09 13:52:02 2024 Received: (at 69328-done) by debbugs.gnu.org; 9 Mar 2024 18:52:02 +0000 Received: from localhost ([127.0.0.1]:34860 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rj1ne-0006jK-DR for submit@debbugs.gnu.org; Sat, 09 Mar 2024 13:52:02 -0500 Received: from eggs.gnu.org ([209.51.188.92]:48012) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rj1nc-0006j2-E8 for 69328-done@debbugs.gnu.org; Sat, 09 Mar 2024 13:52:01 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rj1mz-0006UQ-S5; Sat, 09 Mar 2024 13:51:21 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=8Ux0g9u2iB+z7s6ywZpJw1kOOpfRWpW4RVghVY3tHUQ=; b=MYUrqFcdG3+LeFpQ/mDi uc8IBvZX8iONh8wkVk5NYXZFu5n6chMhxmD8afQlKkvZFtIiHkYZyXLZ+4xdhTCj9OGJ5PdMJVNjt MO3ghmE5yO6B1VZL1zJhFsHoR3o0QGgW6az7kIhgcpmAOdFFFzT9kCnOUkOX7wqLC1iYjkRG5lApF mt/TPCrkC6dNxUbMstBOAwNB9D2IT4viu/c+DRK5mHyNQtYDVHgFo9Q4Hy+liGo0WzKE0PL/ThEIj LzUntXQmZKJRpG3XujYHbYDSzNMBmxf55RrnrH0y/zOsp47MjqqHcZnSd0ADcqhWwvluNwRgslzde 7mdSnY9eUpWWjQ==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Simon Tournier Subject: Re: [bug#69328] [PATCH v2 00/12] Better source code recovery from SWH In-Reply-To: <877cidriol.fsf@gmail.com> (Simon Tournier's message of "Thu, 07 Mar 2024 19:38:34 +0100") References: <87o7btc5du.fsf@gnu.org> <877cidriol.fsf@gmail.com> Date: Sat, 09 Mar 2024 19:51:19 +0100 Message-ID: <87y1arz1aw.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 69328-done Cc: Timothy Sample , Josselin Poiret , Mathieu Othacehe , Tobias Geerinckx-Rice , 69328-done@debbugs.gnu.org, Ricardo Wurmus , Christopher Baines 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: -3.3 (---) Hello, Simon Tournier skribis: > On mar., 05 mars 2024 at 12:06, Ludovic Court=C3=A8s wrote: > >> Ludovic Court=C3=A8s (12): >> lint: Switch to SRFI-71. >> lint: archival: Fix crash in non-Git case. >> lint: archival: Trigger =E2=80=9CSave Code Now=E2=80=9D for VCSes othe= r than Git. >> swh: Add =E2=80=98type=E2=80=99 field to . >> swh: =E2=80=98origin-visits=E2=80=99 takes an optional =E2=80=98max=E2= =80=99 parameter. >> swh: =E2=80=98lookup-origin-revision=E2=80=99 handles branches pointin= g to >> directories. >> hg-download: Use =E2=80=98swh-download-directory-by-nar-hash=E2=80=99. >> svn-download: Use =E2=80=98swh-download-directory-by-nar-hash=E2=80=99. >> bzr-download: Implement nar fallback. >> download-nar: Distinguish =E2=80=98output=E2=80=99 and =E2=80=98item= =E2=80=99 parameter. >> perform-download: Allow use of =E2=80=98download-nar=E2=80=99 for =E2= =80=98--check=E2=80=99 builds. >> download: Honor =E2=80=98GUIX_DOWNLOAD_METHODS=E2=80=99 environment va= riable. > > LGTM. Pushed as 2f441fc738976175d438f7942211b1894e2eb416, thank you & Timothy for taking a look! I=E2=80=99ll update the =E2=80=98guix=E2=80=99 package in the coming days s= o we can benefit from all of this. > Unrelated things for later. :-)=20 > > 1. About CVS, IIRC, there is only one package: gnu-standards. And it > changes barely. Why not fetch from FTP or else instead of CVS? Good idea (or maybe someday someone will finally migrate it to some other VCS?). > 2. About the lookup, currently it is done item per item when it could be > done several at once =E2=80=93 Timothy does that with PoG. This helps fo= r the > rate limit. For instance if one uses =E2=80=9Cguix lint -c archival -m > manifest.scm=E2=80=9D. > > 3. The option =E2=80=99-m=E2=80=99 for =E2=80=9Cguix lint=E2=80=9D seems = missing. > > These #2 and #3 would help third-party channels, IMHO. All good ideas. > Although, I am slowly working on some =E2=80=9Cguix swh=E2=80=9D extensio= n=E2=80=A6 but I have > been distraction by another extension =E2=80=9Cguix try-out=E2=80=9D, the= n distracted by > another one =E2=80=9Cguix cite=E2=80=9D. Well, I need to finish all my h= omeworks. ;-) Heh, sounds exciting! Ludo=E2=80=99. From unknown Fri Jul 18 15:28:04 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Sun, 07 Apr 2024 11:24:23 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator