gnu-maintenance: Support URI list of mixed mirrors, HTTP URLs.

This reinstate commit a5b5df7f7f with a fix to
the inner expand-uri procedure.
This commit is contained in:
Maxim Cournoyer 2023-09-11 23:37:34 -04:00
parent a9d5d1d9dd
commit 2a7f031ca9
No known key found for this signature in database
GPG key ID: 1260E46482E63562

View file

@ -975,17 +975,24 @@ (define (html-updatable-package? package)
((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