From patchwork Mon Aug 21 18:06:12 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 53077 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 6BCC727BBEA; Mon, 21 Aug 2023 19:11:04 +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_ADSP_CUSTOM_MED, 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 9EF8A27BBE2 for ; Mon, 21 Aug 2023 19:11:02 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qY9Mb-0005em-Hf; Mon, 21 Aug 2023 14:10:53 -0400 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 1qY9Ln-0005Mq-U1 for guix-patches@gnu.org; Mon, 21 Aug 2023 14:10:08 -0400 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 1qY9Lm-0004ui-Tr; Mon, 21 Aug 2023 14:10:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qY9Lo-0007WP-HF; Mon, 21 Aug 2023 14:10:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#65230] [PATCH v3 08/10] gnu-maintenance: Add support to rewrite version in URL path. Resent-From: Maxim Cournoyer 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: Mon, 21 Aug 2023 18:10:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 65230 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 65230@debbugs.gnu.org Cc: Maxim Cournoyer , 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 65230-submit@debbugs.gnu.org id=B65230.169264136028747 (code B ref 65230); Mon, 21 Aug 2023 18:10:04 +0000 Received: (at 65230) by debbugs.gnu.org; 21 Aug 2023 18:09:20 +0000 Received: from localhost ([127.0.0.1]:57692 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qY9L5-0007TT-8l for submit@debbugs.gnu.org; Mon, 21 Aug 2023 14:09:20 -0400 Received: from mail-qk1-x72c.google.com ([2607:f8b0:4864:20::72c]:42019) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qY9Ky-0007SD-PF for 65230@debbugs.gnu.org; Mon, 21 Aug 2023 14:09:14 -0400 Received: by mail-qk1-x72c.google.com with SMTP id af79cd13be357-76da88804c1so51464285a.0 for <65230@debbugs.gnu.org>; Mon, 21 Aug 2023 11:09:10 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20221208; t=1692641345; x=1693246145; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=pSgDAuzYQ4pY5Tno0h9v46bbcunDuIvk9rvy84FGWMI=; b=mM5uY9tP6Z9JSTGkDU2wjC1XNWgBtlUpvv4qOJem5gI/Me5Yz73eyRLS7T7lUDDt8J VZudBIV7lIX2QY6U9vLnhMbWUhIQ07XHcPkRf8pL5118p8MFOsj3Y4gxnR22cUEzE9w7 W9IHQsW19FeHRBb9npg+CU0uRDolhXBkJbXjO0zWxRCkXh4QS4VdXm5o4j0o792ug57l MD1oevoNkXUCBqjQtUyglAxFh0bVE1r/ZaZdTn5DnhAEUIahtf8FwNIV6ZpdR4+FGmz+ /G6rGvnfKBW4x84UfimWg0XptT+jfRFPZ1l6seeiv66M2qd+l//VkWXg6YN/FySvukmY EVTA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1692641345; x=1693246145; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=pSgDAuzYQ4pY5Tno0h9v46bbcunDuIvk9rvy84FGWMI=; b=IOw4frF6WpyDK1HD15NHBXWVw4euEYE0/6RUjX4wreNgne2+2j5WUmtLqlH2n1Dt0t 84+Hi1SrqL5jO2gMF7bMV8GeEMtUVw8dD6xkMys3RCcEqc5z1G9XaJwFMNiCopssFUn1 AZnD33jRE1Cy2UXpYu6PRBR2w2cD20aQYcnaXp1oUT6aXW5tDWmtPUCqRMsIYPf8Tm2L PBLES1C7d8+nYYZ3uYcGGmBwjX/8d4DTVj1vxMMtVUj6pb1vUXB3UmMA12A4pYpjshuf A/37XhW9q/8Qpqa/jUWnSZOVI9LZga74T8U/VDiTKNqwNPJhSdJcl80GVWD8rFSXahSF m9cw== X-Gm-Message-State: AOJu0YwOONxhKTz5sNNlZPvWWAwu/bhgkWxBbX3BFyX1RbowJJO8SL5j 5Vp4UPNq0lnubEMz6VdFSiUDADGTRWw= X-Google-Smtp-Source: AGHT+IHyo7xtbxJ2byIfrK9etrKrkBy8eRCDsZEWvAQdDtvM63dsv6s7tQJOIbO31fMI7xShpfhaIA== X-Received: by 2002:a05:620a:3915:b0:76c:a911:f74f with SMTP id qr21-20020a05620a391500b0076ca911f74fmr10318512qkn.27.1692641344581; Mon, 21 Aug 2023 11:09:04 -0700 (PDT) Received: from localhost.localdomain (dsl-10-148-105.b2b2c.ca. [72.10.148.105]) by smtp.gmail.com with ESMTPSA id t16-20020a05620a035000b00767303dc070sm2635523qkm.8.2023.08.21.11.09.03 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 21 Aug 2023 11:09:03 -0700 (PDT) From: Maxim Cournoyer Date: Mon, 21 Aug 2023 14:06:12 -0400 Message-ID: <7566bf9f3d57c65f4a7d2a09924aaf7252016f09.1692641173.git.maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: <5465490ad96f27fecbb69f9bd6f1607d29af6c23.1692641173.git.maxim.cournoyer@gmail.com> References: <5465490ad96f27fecbb69f9bd6f1607d29af6c23.1692641173.git.maxim.cournoyer@gmail.com> 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 . Previously, the generic HTML updater would only look for the list of files found at the parent of its current source URL, ignoring that the URL may embed the version elsewhere in its path. This could cause 'guix refresh' to report no updates available, while in fact there were, such as for 'libuv'. * guix/gnu-maintenance.scm (strip-trailing-slash): New procedure. (%version-rx): New variable. (rewrite-url): New procedure. (import-html-release): New rewrite-url? argument. When true, use the above procedure. (import-html-updatable-release): Call import-html-release with #:rewrite-url set to #t. * tests/gnu-maintenance.scm ("rewrite-url, to-version specified") ("rewrite-url, without to-version"): New tests. --- (no changes since v1) guix/gnu-maintenance.scm | 102 ++++++++++++++++++++++++++++++++++++-- tests/gnu-maintenance.scm | 43 ++++++++++++++++ 2 files changed, 142 insertions(+), 3 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index abba891d4b..3cd84ee3d7 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2022 Maxime Devos +;;; Copyright © 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +27,7 @@ (define-module (guix gnu-maintenance) #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (rnrs io ports) @@ -61,6 +63,7 @@ (define-module (guix gnu-maintenance) gnu-package? uri-mirror-rewrite + rewrite-url release-file? releases @@ -518,9 +521,93 @@ (define (canonicalize-url url base-url) ;; within a directory. (string-append (dirname base-url) "/" url)))) +(define (strip-trailing-slash s) + "Strip any trailing slash from S, a string." + (if (string-suffix? "/" s) + (string-drop-right s 1) + s)) + +;;; TODO: Extend to support the RPM and GNOME version schemes? +(define %version-rx "[0-9.]+") + +(define* (rewrite-url url version #:key to-version) + "Rewrite URL so that the URL path components matching the current VERSION or +VERSION-MAJOR.VERSION-MINOR are updated with that of the latest version found +by crawling the corresponding URL directories. Alternatively, when TO-VERSION +is specified, rewrite version matches directly to it without crawling URL. + +For example, the URL +\"https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz\" could be +rewritten to something like +\"https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz\"." + ;; XXX: major-minor may be #f if version is not a triplet but a single + ;; number such as "2". + (let* ((major-minor (false-if-exception (version-major+minor version))) + (to-major-minor (false-if-exception + (and=> to-version version-major+minor))) + (uri (string->uri url)) + (url-prefix (string-drop-right url (string-length (uri-path uri)))) + (url-prefix-components (string-split url-prefix #\/)) + (path (uri-path uri)) + ;; Strip a forward slash on the path to avoid a double slash when + ;; string-joining later. + (path (if (string-prefix? "/" path) + (string-drop path 1) + path)) + (path-components (string-split path #\/))) + (string-join + (reverse + (fold + (lambda (s parents) + (if to-version + ;; Direct rewrite case; the archive is assumed to exist. + (let ((u (string-replace-substring s version to-version))) + (cons (if (and major-minor to-major-minor) + (string-replace-substring u major-minor to-major-minor) + u) + parents)) + ;; More involved HTML crawl case. + (let* ((pattern (if major-minor + (format #f "(~a|~a)" version major-minor) + (format #f "(~a)" version))) + (m (string-match pattern s))) + (if m + ;; Crawl parent and rewrite current component. + (let* ((parent-url (string-join (reverse parents) "/")) + (links (url->links parent-url)) + ;; The pattern matching the version. + (pattern (string-append "^" (match:prefix m) + "(" %version-rx ")" + (match:suffix m) "$")) + (candidates (filter-map + (lambda (l) + ;; Links may be followed by a + ;; trailing '/' in the case of + ;; directories. + (and-let* + ((l (strip-trailing-slash l)) + (m (string-match pattern l)) + (v (match:substring m 1))) + (cons v l))) + links))) + ;; Retrieve the item having the largest version. + (if (null? candidates) + (error "no candidates found in rewrite-url") + (cons (cdr (first (sort candidates + (lambda (x y) + (version>? (car x) + (car y)))))) + parents))) + ;; No version found in path component; continue. + (cons s parents))))) + (reverse url-prefix-components) + path-components)) + "/"))) + (define* (import-html-release base-url package #:key - (version #f) + rewrite-url? + version (directory (string-append "/" (package-upstream-name package))) file->signature) @@ -534,11 +621,19 @@ (define* (import-html-release base-url package When FILE->SIGNATURE is omitted or #f, guess the detached signature file name, if any. Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source file URL and must return the corresponding signature URL, or #f it signatures -are unavailable." - (let* ((name (package-upstream-name package)) +are unavailable. + +When REWRITE-URL? is #t, versioned components in BASE-URL and/or DIRECTORY are +also updated to the latest version, as explained in the doc of the +\"rewrite-url\" procedure used." + (let* ((current-version (package-version package)) + (name (package-upstream-name package)) (url (if (string-null? directory) base-url (string-append base-url directory "/"))) + (url (if rewrite-url? + (rewrite-url url current-version #:to-version version) + url)) (links (map (cut canonicalize-url <> url) (url->links url)))) (define (file->signature/guess url) @@ -873,6 +968,7 @@ (define* (import-html-updatable-release package #:key (version #f)) (dirname (uri-path uri))))) (false-if-networking-error (import-html-release base package + #:rewrite-url? #t #:version version #:directory directory)))) diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm index 516e02ec6a..196a6f9092 100644 --- a/tests/gnu-maintenance.scm +++ b/tests/gnu-maintenance.scm @@ -147,4 +147,47 @@ (define-module (test-gnu-maintenance) (equal? (list expected-signature-url) (upstream-source-signature-urls update)))))) +(test-equal "rewrite-url, to-version specified" + "https://download.qt.io/official_releases/qt/6.5/6.5.2/\ +submodules/qtbase-everywhere-src-6.5.2.tar.xz" + (rewrite-url "https://download.qt.io/official_releases/qt/6.3/6.3.2/\ +submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2")) + +(test-equal "rewrite-url, without to-version" + "https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz" + (with-http-server + ;; First reply, crawling https://dist.libuv.org/dist/. + `((200 "\ + + +Index of dist + +../ +v1.44.0/ +v1.44.1/ +v1.44.2/ +v1.45.0/ +v1.46.0/ + +") + ;; Second reply, crawling https://dist.libuv.org/dist/v1.46.0/. + (200 "\ + + +Index of dist/v1.46.0 + +../ + + libuv-v1.46.0-dist.tar.gz +libuv-v1.46.0-dist.tar.gz.sign + + libuv-v1.46.0.tar.gz + + libuv-v1.46.0.tar.gz.sign + +")) + (rewrite-url "https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz" + "1.45.0"))) + (test-end)