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

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new a5b5df7f7f gnu-maintenance: Support URI list of mixed mirrors, HTTP 
URLs.
a5b5df7f7f is described below

commit a5b5df7f7fbbb98487b2e7a59941efee6492bc7f
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Mon Sep 11 15:46:47 2023 -0400

    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>
---
 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..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