From 2a7f031ca9d6d16fe0264023d8beca02b3ac0050 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Mon, 11 Sep 2023 23:37:34 -0400 Subject: [PATCH] gnu-maintenance: Support URI list of mixed mirrors, HTTP URLs. This reinstate commit a5b5df7f7fbbb98487b2e7a59941efee6492bc7f with a fix to the inner expand-uri procedure. --- guix/gnu-maintenance.scm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 5a84fcb117..881e941fbf 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) + (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 (string->uri + (expand-uri (origin-uri (package-source package))))) (custom (assoc-ref (package-properties package) 'release-monitoring-url)) (base (or custom