diff options
| author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-09-11 15:46:47 -0400 |
|---|---|---|
| committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-09-11 22:53:38 -0400 |
| commit | a5b5df7f7fbbb98487b2e7a59941efee6492bc7f (patch) | |
| tree | 6fe71db06bc9cac0456c59da14c05aecc7f40bae | |
| parent | 5ff9afb5fdc6e34936683524907343859976a805 (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>
| -rw-r--r-- | guix/gnu-maintenance.scm | 29 |
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 |