aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2022-09-11 16:23:37 +0200
committerChristopher Baines <mail@cbaines.net>2022-09-17 19:09:45 +0200
commitc967d1153cae419e4acbe0dbed8f558d95ced0e3 (patch)
tree6fcb5746d4352226e0695aa8718c141a433341c8
parentc00e1c87f219ab9947204af53afff6ccf812fa91 (diff)
downloadguix-c967d1153cae419e4acbe0dbed8f558d95ced0e3.tar
guix-c967d1153cae419e4acbe0dbed8f558d95ced0e3.tar.gz
gnu-maintenance: Support // URLs in latest-html-release.
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. Signed-off-by: Christopher Baines <mail@cbaines.net>
-rw-r--r--guix/gnu-maintenance.scm7
-rw-r--r--tests/gnu-maintenance.scm29
2 files changed, 36 insertions, 0 deletions
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 <ludo@gnu.org>
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -499,6 +500,12 @@ are unavailable."
(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 <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; 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 @@
("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 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
+<head>
+<title>Releases (on another domain)!</title>
+</head>
+<body
+<a href=\"//another-site/foo-2.tar.gz\">version 1</a>
+</body>
+</html>"))
+ (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)