futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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>
This commit is contained in:
Maxim Cournoyer 2023-09-11 15:46:47 -04:00
parent 5ff9afb5fd
commit a5b5df7f7f
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
guix/gnu-maintenance.scm
View File

@ -975,17 +975,24 @@ updater."
((url-predicate http-url?) package))) ((url-predicate http-url?) package)))
(define* (import-html-updatable-release package #:key (version #f)) (define* (import-html-updatable-release package #:key (version #f))
"Return the latest release of PACKAGE. Do that by crawling the HTML page of "Return the latest release of PACKAGE else #f. Do that by crawling the HTML
the directory containing its source tarball. Optionally include a VERSION page of the directory containing its source tarball. Optionally include a
string to fetch a specific version." VERSION string to fetch a specific version."
(let* ((uri (string->uri
(match (origin-uri (package-source package)) (define (expand-uri uri)
((and (? string?) (string->uri
(? (cut string-prefix? "mirror://" <>) url)) (match uri
((and (? string?) (? (cut string-prefix? "mirror://" <>) url))
;; Retrieve the authoritative HTTP URL from a mirror. ;; Retrieve the authoritative HTTP URL from a mirror.
(http-url? url)) (http-url? url))
((? string? url) url) ((? string? url)
((url _ ...) 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) (custom (assoc-ref (package-properties package)
'release-monitoring-url)) 'release-monitoring-url))
(base (or custom (base (or custom