summary refs log tree commit diff
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-09-11 23:37:34 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-09-11 23:39:13 -0400
commit2a7f031ca9d6d16fe0264023d8beca02b3ac0050 (patch)
tree99c86f8df8e7e04e88e506fd8b6ed9cdaedbb06e
parenta9d5d1d9dd186ab21ee44ccf9b5c777e79f83c5b (diff)
downloadguix-2a7f031ca9d6d16fe0264023d8beca02b3ac0050.tar.gz
gnu-maintenance: Support URI list of mixed mirrors, HTTP URLs.
This reinstate commit a5b5df7f7fbbb98487b2e7a59941efee6492bc7f with a fix to
the inner expand-uri procedure.
-rw-r--r--guix/gnu-maintenance.scm29
1 files changed, 18 insertions, 11 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 5a84fcb117..881e941fbf 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)
+    (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