TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
1 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
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?) (match uri
(? (cut string-prefix? "mirror://" <>) url)) ((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 (string->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