From patchwork Thu Sep 1 09:01:48 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 42108 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 329FD27BBEA; Thu, 1 Sep 2022 10:44:45 +0100 (BST) 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,FREEMAIL_FROM,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 8BAFE27BBE9 for ; Thu, 1 Sep 2022 10:44:44 +0100 (BST) Received: from localhost ([::1]:39420 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oTgkb-0005dK-SA for patchwork@mira.cbaines.net; Thu, 01 Sep 2022 05:44:43 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56762) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oTg6K-0004Bj-D4 for guix-patches@gnu.org; Thu, 01 Sep 2022 05:03:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:51460) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oTg6K-0005ea-2z for guix-patches@gnu.org; Thu, 01 Sep 2022 05:03:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oTg6J-0008QY-Ts for guix-patches@gnu.org; Thu, 01 Sep 2022 05:03:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#57515] [PATCH 1/8] guix: Extract logic of the check-mirror-url. Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 01 Sep 2022 09:03:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 57515 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 57515@debbugs.gnu.org Received: via spool by 57515-submit@debbugs.gnu.org id=B57515.166202292532262 (code B ref 57515); Thu, 01 Sep 2022 09:03:03 +0000 Received: (at 57515) by debbugs.gnu.org; 1 Sep 2022 09:02:05 +0000 Received: from localhost ([127.0.0.1]:41198 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oTg5M-0008OF-Sc for submit@debbugs.gnu.org; Thu, 01 Sep 2022 05:02:05 -0400 Received: from michel.telenet-ops.be ([195.130.137.88]:48460) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oTg5G-0008MC-0V for 57515@debbugs.gnu.org; Thu, 01 Sep 2022 05:02:02 -0400 Received: from localhost.localdomain ([IPv6:2a02:1811:8c09:9d00:5dba:d409:33f7:a16]) by michel.telenet-ops.be with bizsmtp id EZ1v2800K20ykKC06Z1wpG; Thu, 01 Sep 2022 11:01:56 +0200 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:48 +0200 Message-Id: X-Mailer: git-send-email 2.37.2 In-Reply-To: References: MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r22; t=1662022916; bh=YnhOqcNcQ/RQIUdmgdFcuyUwVGldGNWnk3IXi0SMSqM=; h=From:To:Subject:Date:In-Reply-To:References:Reply-To; b=UtXQcQLKAXuA2YLuU+c2dFbG3dA8q3tKG3Z0TQAtHJUvXwzHd3pCf5txerp1kUbKr tzI8n0XOcTBvOhB3bZrSEyRpGhPy+N9MGpcRwlKgP09wtZ+jdgr69ngcnU9lq01Me+ j6PpZxwnwd67Uu2TEbfXv31xgqHCk6S71n4+uGuy2PqIHNTAQagXtsk0dCXD6MBJal EGnSgO/V/38SlGXIoGnWDE/6U0NMihNvFNpTftG1d8kL5jwHvzAjjCUHmV/hEkkiXf CiiHHjJutthmLPXvUJvD9B8hNv4s7C8GXka0WKSbAo7J0PVeuiaNBjT8vTnimYWifC 2GxjcJEXtHutQ== 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: , Reply-To: 57515@debbugs.gnu.org Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches It will be useful for fixing #57477 ‘"guix refresh -u" sometimes 'unmirrors' source URLs’. * guix/lint.scm (check-mirror-url): Extract mirror://-constructing code to ... * guix/gnu-maintenance.scm (uri-mirror-rewrite): ... here, tweaking the API and implementation in anticipation of future users. --- guix/gnu-maintenance.scm | 23 +++++++++++++++++++++++ guix/lint.scm | 23 +++++++---------------- 2 files changed, 30 insertions(+), 16 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index e7edbf6656..51e8fcd815 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2022 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,8 @@ (define-module (guix gnu-maintenance) #:use-module (rnrs io ports) #:use-module (system foreign) #:use-module ((guix http-client) #:hide (open-socket-for-uri)) + ;; not required in many cases, so autoloaded to reduce start-up costs. + #:autoload (guix download) (%mirrors) #:use-module (guix ftp-client) #:use-module (guix utils) #:use-module (guix memoization) @@ -57,6 +60,8 @@ (define-module (guix gnu-maintenance) find-package gnu-package? + uri-mirror-rewrite + release-file? releases latest-release @@ -651,6 +656,24 @@ (define (url-prefix-rewrite old new) (string-append new (string-drop url (string-length old))) url))) +(define (uri-mirror-rewrite uri) + "Rewrite URI to a mirror:// URI if possible. When not, return URI unmodified." + (if (string-prefix? "mirror://" uri) + ;; Nothing to do, it's already a mirror URI! + uri + (let loop ((mirrors %mirrors)) + (match mirrors + (() + uri) + (((mirror-id mirror-urls ...) rest ...) + (match (find (cut string-prefix? <> uri) mirror-urls) + (#f + (loop rest)) + (prefix + (format #f "mirror://~a/~a" + mirror-id + (string-drop uri (string-length prefix)))))))))) + (define (adjusted-upstream-source source rewrite-url) "Rewrite URLs in SOURCE by apply REWRITE-URL to each of them." (upstream-source diff --git a/guix/lint.scm b/guix/lint.scm index edba1c2663..ff7863ab86 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -12,7 +12,7 @@ ;;; Copyright © 2020 Chris Marusich ;;; Copyright © 2020 Timothy Sample ;;; Copyright © 2021 Xinglu Chen -;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2021 Brice Waegeneire ;;; ;;; This file is part of GNU Guix. @@ -1223,21 +1223,12 @@ (define (check-source-uri uri) (define (check-mirror-url package) "Check whether PACKAGE uses source URLs that should be 'mirror://'." (define (check-mirror-uri uri) ;XXX: could be optimized - (let loop ((mirrors %mirrors)) - (match mirrors - (() - #f) - (((mirror-id mirror-urls ...) rest ...) - (match (find (cut string-prefix? <> uri) mirror-urls) - (#f - (loop rest)) - (prefix - (make-warning package - (G_ "URL should be \ -'mirror://~a/~a'") - (list mirror-id - (string-drop uri (string-length prefix))) - #:field 'source))))))) + (define maybe-rewritten-uri (uri-mirror-rewrite uri)) + (and (not (eq? uri maybe-rewritten-uri)) + (make-warning package + (G_ "URL should be '~a'") + (list maybe-rewritten-uri) + #:field 'source))) (let ((origin (package-source package))) (if (and (origin? origin)