diff mbox series

[bug#65230,08/13] gnu-maintenance: Accept package object in 'import-html-release' procedure.

Message ID b43be37af943011dd56be329f3d88d530f830090.1691779500.git.maxim.cournoyer@gmail.com
State New
Headers show
Series Fix 'guix refresh' for Qt and other packages | expand

Commit Message

Maxim Cournoyer Aug. 11, 2023, 6:44 p.m. UTC 
This is in preparation for a new URL rewriting feature, which will need to
have the current version information available.

* guix/gnu-maintenance.scm (import-html-release): Update doc.  Adjust default
value of the DIRECTORY argument.  Bind PACKAGE in lexical scope so that its
value there is unchanged.
(import-savannah-release, import-kernel.org-release)
(import-html-updatable-release): Adjust accordingly.
---

 guix/gnu-maintenance.scm | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)
diff mbox series

Patch

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 67abbc1c5a..13d6c1c7f2 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -494,11 +494,12 @@  (define (url->links url)
 (define* (import-html-release base-url package
                               #:key
                               (version #f)
-                              (directory (string-append "/" package))
+                              (directory (string-append
+                                          "/" (package-upstream-name package)))
                               file->signature)
-  "Return an <upstream-source> for the latest release of PACKAGE (a string)
-under DIRECTORY at BASE-URL, or #f.  Optionally include a VERSION string to
-fetch a specific version.
+  "Return an <upstream-source> for the latest release of PACKAGE under
+DIRECTORY at BASE-URL, or #f.  Optionally include a VERSION string to fetch a
+specific version.
 
 BASE-URL should be the URL of an HTML page, typically a directory listing as
 found on 'https://kernel.org/pub'.
@@ -507,7 +508,8 @@  (define* (import-html-release base-url package
 if any.  Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
 file URL and must return the corresponding signature URL, or #f it signatures
 are unavailable."
-  (let* ((url (if (string-null? directory)
+  (let* ((package (package-upstream-name package))
+         (url (if (string-null? directory)
                   base-url
                   (string-append base-url directory "/")))
          (links (url->links url)))
@@ -730,7 +732,6 @@  (define* (import-savannah-release package #:key (version #f))
                      (match (origin-uri (package-source package))
                        ((? string? uri) uri)
                        ((uri mirrors ...) uri))))
-         (package   (package-upstream-name package))
          (directory (dirname (uri-path uri))))
     ;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
     ;; or whichever detached signature naming scheme PACKAGE uses.
@@ -825,7 +826,6 @@  (define* (import-kernel.org-release package #:key (version #f))
                      (match (origin-uri (package-source package))
                        ((? string? uri) uri)
                        ((uri mirrors ...) uri))))
-         (package   (package-upstream-name package))
          (directory (dirname (uri-path uri))))
     (import-html-release %kernel.org-base package
                          #:version version
@@ -869,8 +869,7 @@  (define* (import-html-updatable-release package #:key (version #f))
                                        "://" (uri-host uri))))
          (directory (if custom
                         ""
-                        (dirname (uri-path uri))))
-         (package   (package-upstream-name package)))
+                        (dirname (uri-path uri)))))
     (false-if-networking-error
      (import-html-release base package
                           #:version version