From patchwork Fri Feb 23 15:48:05 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60927 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 004FC27BBEA; Fri, 23 Feb 2024 16:12:43 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 76ED227BBE2 for ; Fri, 23 Feb 2024 16:12:43 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY9m-0004ff-Id; Fri, 23 Feb 2024 11:12:14 -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 1rdXtn-0002s6-1r for guix-patches@gnu.org; Fri, 23 Feb 2024 10:55:44 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXtl-0008Uf-Q9; Fri, 23 Feb 2024 10:55:41 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXu6-0002UE-Bm; Fri, 23 Feb 2024 10:56:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 01/12] lint: Switch to SRFI-71. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:56:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087037319440 (code B ref 69328); Fri, 23 Feb 2024 15:56:02 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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)) From patchwork Fri Feb 23 15:48:06 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60928 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EF99C27BBE9; Fri, 23 Feb 2024 16:14:59 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5E0FE27BBE2 for ; Fri, 23 Feb 2024 16:14:59 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdYC1-0005iY-Sh; Fri, 23 Feb 2024 11:14:33 -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 1rdXtn-0002sD-Hh for guix-patches@gnu.org; Fri, 23 Feb 2024 10:55:44 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXtl-0008Ub-K3; Fri, 23 Feb 2024 10:55:41 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXu6-0002UM-Q9; Fri, 23 Feb 2024 10:56:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 02/12] lint: archival: Fix crash in non-Git case. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:56:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087037329455 (code B ref 69328); Fri, 23 Feb 2024 15:56:02 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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?) From patchwork Fri Feb 23 15:48:07 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60929 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7234727BBE9; Fri, 23 Feb 2024 16:15:47 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 010A227BBE2 for ; Fri, 23 Feb 2024 16:15:46 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdYCO-0006BK-85; Fri, 23 Feb 2024 11:14:56 -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 1rdXo2-00048F-DJ for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:46 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo2-0007Fi-3v; Fri, 23 Feb 2024 10:49:46 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoP-0002Bn-30; Fri, 23 Feb 2024 10:50:09 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 03/12] lint: archival: Trigger =?utf-8?b?4oCc?= =?utf-8?b?U2F2ZQ==?= Code =?utf-8?b?Tm934oCd?= for VCSes other than Git. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:09 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033998294 (code B ref 69328); Fri, 23 Feb 2024 15:50:09 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 From patchwork Fri Feb 23 15:48:08 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60925 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EFFED27BBEA; Fri, 23 Feb 2024 16:06:21 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5D1A427BBE9 for ; Fri, 23 Feb 2024 16:06:21 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2R-0001ew-E2; Fri, 23 Feb 2024 11:04:39 -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 1rdXtn-0002sC-G6 for guix-patches@gnu.org; Fri, 23 Feb 2024 10:55:44 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXtm-0008Un-HQ; Fri, 23 Feb 2024 10:55:42 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXu7-0002UZ-DZ; Fri, 23 Feb 2024 10:56:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 04/12] swh: Add =?utf-8?b?4oCYdHlwZeKAmQ==?= field to . Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:56:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087037349466 (code B ref 69328); Fri, 23 Feb 2024 15:56:03 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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")) ;; From patchwork Fri Feb 23 15:48:09 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60921 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 47A4027BBEA; Fri, 23 Feb 2024 16:05:52 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 6615427BBE2 for ; Fri, 23 Feb 2024 16:05:47 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2J-0000oG-16; Fri, 23 Feb 2024 11:04:31 -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 1rdXo3-00048Z-Aw for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:48 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo3-0007GE-1h; Fri, 23 Feb 2024 10:49:47 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoJ-0002AP-Ae; Fri, 23 Feb 2024 10:50:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 05/12] swh: =?utf-8?b?4oCYb3JpZ2luLXZpc2l0cw==?= =?utf-8?b?4oCZ?= takes an optional =?utf-8?b?4oCYbWF44oCZ?= parameter. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033628036 (code B ref 69328); Fri, 23 Feb 2024 15:50:03 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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)))))) From patchwork Fri Feb 23 15:48:10 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60923 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EA5DE27BBEA; Fri, 23 Feb 2024 16:06:18 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id D7ABD27BBE2 for ; Fri, 23 Feb 2024 16:06:17 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2P-0001Pr-GC; Fri, 23 Feb 2024 11:04:37 -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 1rdXtn-0002s7-50 for guix-patches@gnu.org; Fri, 23 Feb 2024 10:55:44 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXtl-0008Ug-R1; Fri, 23 Feb 2024 10:55:41 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXu8-0002Uo-Gx; Fri, 23 Feb 2024 10:56:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 06/12] swh: =?utf-8?q?=E2=80=98lookup-origin-rev?= =?utf-8?q?ision=E2=80=99?= handles branches pointing to directories. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:56:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087037369476 (code B ref 69328); Fri, 23 Feb 2024 15:56:04 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 From patchwork Fri Feb 23 15:48:11 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60931 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 56AC827BBEA; Fri, 23 Feb 2024 16:16:21 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id E6F1C27BBE2 for ; Fri, 23 Feb 2024 16:16:20 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdYCP-0006EB-3D; Fri, 23 Feb 2024 11:14:57 -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 1rdXo2-00048P-Si for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:46 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo2-0007Fq-Ii; Fri, 23 Feb 2024 10:49:46 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoO-0002BY-Gw; Fri, 23 Feb 2024 10:50:08 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 07/12] hg-download: Use =?utf-8?q?=E2=80=98swh-d?= =?utf-8?q?ownload-directory-by-nar-hash=E2=80=99=2E?= Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:08 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033958271 (code B ref 69328); Fri, 23 Feb 2024 15:50:08 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 From patchwork Fri Feb 23 15:48:12 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60920 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B1DAC27BBEA; Fri, 23 Feb 2024 16:05:31 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B1EE327BBE2 for ; Fri, 23 Feb 2024 16:05:26 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2J-0000pK-5Z; Fri, 23 Feb 2024 11:04:31 -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 1rdXo2-00048Q-Vg for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:46 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo2-0007Ft-MO; Fri, 23 Feb 2024 10:49:46 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoN-0002BE-Ej; Fri, 23 Feb 2024 10:50:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 08/12] svn-download: Use =?utf-8?q?=E2=80=98swh-?= =?utf-8?q?download-directory-by-nar-hash=E2=80=99=2E?= Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033938254 (code B ref 69328); Fri, 23 Feb 2024 15:50:07 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 From patchwork Fri Feb 23 15:48:13 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60922 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 33B5427BBE9; Fri, 23 Feb 2024 16:05:59 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id CDD8D27BBE2 for ; Fri, 23 Feb 2024 16:05:57 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2G-0000hp-Qp; Fri, 23 Feb 2024 11:04:30 -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 1rdXnz-00047k-Ag for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:43 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXnz-0007F7-22; Fri, 23 Feb 2024 10:49:43 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoI-0002AF-EL; Fri, 23 Feb 2024 10:50:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 09/12] bzr-download: Implement nar fallback. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033608017 (code B ref 69328); Fri, 23 Feb 2024 15:50:02 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 From patchwork Fri Feb 23 15:48:14 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60930 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id C492527BBEA; Fri, 23 Feb 2024 16:16:17 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 4BFB927BBE2 for ; Fri, 23 Feb 2024 16:16:17 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdYCN-00067Z-Qs; Fri, 23 Feb 2024 11:14:55 -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 1rdXnx-00047b-W5 for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:42 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXnx-0007Ea-NH for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:41 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoL-0002Af-5T for guix-patches@gnu.org; Fri, 23 Feb 2024 10:50:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 10/12] download-nar: Distinguish =?utf-8?b?4oCY?= =?utf-8?b?b3V0cHV04oCZ?= and =?utf-8?b?4oCYaXRlbeKAmQ==?= parameter. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033668079 (code B ref 69328); Fri, 23 Feb 2024 15:50:05 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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)))) (() From patchwork Fri Feb 23 15:48:15 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60924 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1F41C27BBEA; Fri, 23 Feb 2024 16:06:20 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 101C427BBE2 for ; Fri, 23 Feb 2024 16:06:19 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2G-0000gy-Jq; Fri, 23 Feb 2024 11:04:28 -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 1rdXo1-00047w-0M for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:45 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo0-0007FU-G6; Fri, 23 Feb 2024 10:49:44 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoK-0002AW-9p; Fri, 23 Feb 2024 10:50:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 11/12] perform-download: Allow use of =?utf-8?b?4oCYZG93bmxvYWQtbmFy4oCZ?= for =?utf-8?b?4oCYLS1jaGVja+KAmQ==?= builds. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033668067 (code B ref 69328); Fri, 23 Feb 2024 15:50:04 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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) From patchwork Fri Feb 23 15:48:16 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 60926 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1B6FF27BBEA; Fri, 23 Feb 2024 16:06:42 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1792927BBE2 for ; Fri, 23 Feb 2024 16:06:39 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rdY2K-00010T-Ov; Fri, 23 Feb 2024 11:04:33 -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 1rdXo3-00048Y-9t for guix-patches@gnu.org; Fri, 23 Feb 2024 10:49:48 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rdXo3-0007GD-0M; Fri, 23 Feb 2024 10:49:47 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rdXoM-0002Au-4X; Fri, 23 Feb 2024 10:50:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69328] [PATCH 12/12] download: Honor =?utf-8?b?4oCYR1VJWF9E?= =?utf-8?b?T1dOTE9BRF9TRVFVRU5DReKAmQ==?= environment variable. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Fri, 23 Feb 2024 15:50:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69328 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69328@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69328-submit@debbugs.gnu.org id=B69328.17087033698097 (code B ref 69328); Fri, 23 Feb 2024 15:50:06 +0000 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: Ludovic =?utf-8?q?Court=C3=A8s?= 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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"