This makes "./pre-inst-env guix refresh -u" download the release tarball from the right place -- previously, it downloaded from https://www.libreoffice.org//download.documentfoundation.org/libreoffice/src/7.4.0/libreoffice-7.4.0.3.tar.xz?idx=1 whereas it should download from https://download.documentfoundation.org/libreoffice/src/7.4.0/libreoffice-7.4.0.3.tar.xz?idx=1 instead. * guix/gnu-maintenance.scm (latest-html-release)[url-release]: Adjust computation in the case of an absolute URI-reference without a scheme. * tests/gnu-maintenance.scm ("latest-html-release, scheme-less URIs"): Test it. --- guix/gnu-maintenance.scm | 7 +++++++ tests/gnu-maintenance.scm | 29 +++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index e7edbf6656..1ffa408666 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. ;;; @@ -499,6 +500,12 @@ (define (url->release url) (base-url (string-append base-url directory)) (url (cond ((and=> (string->uri url) uri-scheme) ;full URL? url) + ;; full URL, except for URI scheme. Reuse the URI + ;; scheme of the document that contains the link. + ((string-prefix? "//" url) + (string-append + (symbol->string (uri-scheme (string->uri base-url))) + ":" url)) ((string-prefix? "/" url) ;absolute path? (let ((uri (string->uri base-url))) (uri->string diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm index c04d8ba733..89b0684c25 100644 --- a/tests/gnu-maintenance.scm +++ b/tests/gnu-maintenance.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2021 Ludovic Courtès +;;; Copyright © 2022 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +19,10 @@ (define-module (test-gnu-maintenance) #:use-module (guix gnu-maintenance) + #:use-module (guix tests) + #:use-module (guix tests http) + #:use-module (guix upstream) + #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) @@ -55,4 +60,28 @@ (define-module (test-gnu-maintenance) ("mpg321_0.3.2.orig.tar.gz" "0.3.2") ("bvi-1.4.1.src.tar.gz" "1.4.1"))))) +(test-assert "latest-html-release, scheme-less URIs" + (with-http-server + `((200 " + +Releases (on another domain)! + +version 1 + +")) + (let () + (define package + (dummy-package "foo" + (source + (dummy-origin + (uri (string-append (%local-url) "/foo-1.tar.gz")))) + (properties + `((release-monitoring-url . ,(%local-url)))))) + (define update ((upstream-updater-latest %generic-html-updater) package)) + (define expected-new-url "http://another-site/foo-2.tar.gz") + (and (pk 'u update) + (equal? (upstream-source-version update) "2") + (equal? (list expected-new-url) (upstream-source-urls update)))))) + (test-end) base-commit: a44e08337d15b3f254a35d0311663c2bbd501852 prerequisite-patch-id: 0caac311875ee39cb48573657ebb960e90da6dfb prerequisite-patch-id: 418285493d89ebf102175902d9b09a0174e88190 prerequisite-patch-id: 3c39eb839d9d3ff3fca6cd98621a5d5c411b7af4 prerequisite-patch-id: 8d5662e874c469f5ee496ef5181cf2d0a30ad1d8 prerequisite-patch-id: 26513c3b3b86963df718ee41d14a25d1cc6a8f3f prerequisite-patch-id: 2b2497e2edec0afc48ebadd6f09f0c661c466127 prerequisite-patch-id: 2712efb97bf33985fd0658e4dd8e936dc08be5fe prerequisite-patch-id: 9d2409b480a8bff0fef029b4b095922d4957e06f prerequisite-patch-id: 51a32abca3efec1ba67ead59b8694c5ea3129ad3 -- 2.37.2