summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-09-11 15:46:47 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-09-11 22:53:38 -0400
commita5b5df7f7fbbb98487b2e7a59941efee6492bc7f (patch)
tree6fe71db06bc9cac0456c59da14c05aecc7f40bae /guix
parent5ff9afb5fdc6e34936683524907343859976a805 (diff)
gnu-maintenance: Support URI list of mixed mirrors, HTTP URLs.
Fixes <https://issues.guix.gnu.org/58697>. * guix/gnu-maintenance.scm (import-html-updatable-release): Update doc. <expand-uri>: New nested procedure. Apply it to the origin URI. Reported-by: kiasoc5 <kiasoc5@disroot.org>
Diffstat (limited to 'guix')
-rw-r--r--guix/gnu-maintenance.scm29
1 files changed, 18 insertions, 11 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 5a84fcb117..302243559d 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -975,17 +975,24 @@ updater."
((url-predicate http-url?) package)))
(define* (import-html-updatable-release package #:key (version #f))
- "Return the latest release of PACKAGE. Do that by crawling the HTML page of
-the directory containing its source tarball. Optionally include a VERSION
-string to fetch a specific version."
- (let* ((uri (string->uri
- (match (origin-uri (package-source package))
- ((and (? string?)
- (? (cut string-prefix? "mirror://" <>) url))
- ;; Retrieve the authoritative HTTP URL from a mirror.
- (http-url? url))
- ((? string? url) url)
- ((url _ ...) url))))
+ "Return the latest release of PACKAGE else #f. Do that by crawling the HTML
+page of the directory containing its source tarball. Optionally include a
+VERSION string to fetch a specific version."
+
+ (define (expand-uri uri)
+ (string->uri
+ (match uri
+ ((and (? string?) (? (cut string-prefix? "mirror://" <>) url))
+ ;; Retrieve the authoritative HTTP URL from a mirror.
+ (http-url? url))
+ ((? string? url)
+ url)
+ ((url _ ...)
+ ;; This case is for when the URI is a list of possibly mirror URLs as
+ ;; well as HTTP URLs.
+ (expand-uri url)))))
+
+ (let* ((uri (expand-uri (origin-uri (package-source package))))
(custom (assoc-ref (package-properties package)
'release-monitoring-url))
(base (or custom