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

gnu-maintenance: Accept package object in 'import-html-release' procedure.

Browse source 
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.
This commit is contained in:
Maxim Cournoyer 2023-08-09 22:53:03 -04:00
parent a5e67dec2a
commit c6b5eeac92
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 8 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/gnu-maintenance.scm
View file

@ -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 (file->signature file)
(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
@ -873,8 +873,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