mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-27 21:49:34 -05:00
gnu-maintenance: Accept package object in 'import-html-release' procedure.
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:
parent
a5e67dec2a
commit
c6b5eeac92
1 changed files with 8 additions and 9 deletions
|
@ -494,11 +494,12 @@ (define (url->links url)
|
||||||
(define* (import-html-release base-url package
|
(define* (import-html-release base-url package
|
||||||
#:key
|
#:key
|
||||||
(version #f)
|
(version #f)
|
||||||
(directory (string-append "/" package))
|
(directory (string-append
|
||||||
|
"/" (package-upstream-name package)))
|
||||||
file->signature)
|
file->signature)
|
||||||
"Return an <upstream-source> for the latest release of PACKAGE (a string)
|
"Return an <upstream-source> for the latest release of PACKAGE under
|
||||||
under DIRECTORY at BASE-URL, or #f. Optionally include a VERSION string to
|
DIRECTORY at BASE-URL, or #f. Optionally include a VERSION string to fetch a
|
||||||
fetch a specific version.
|
specific version.
|
||||||
|
|
||||||
BASE-URL should be the URL of an HTML page, typically a directory listing as
|
BASE-URL should be the URL of an HTML page, typically a directory listing as
|
||||||
found on 'https://kernel.org/pub'.
|
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
|
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
|
file URL and must return the corresponding signature URL, or #f it signatures
|
||||||
are unavailable."
|
are unavailable."
|
||||||
(let* ((url (if (string-null? directory)
|
(let* ((package (package-upstream-name package))
|
||||||
|
(url (if (string-null? directory)
|
||||||
base-url
|
base-url
|
||||||
(string-append base-url directory "/")))
|
(string-append base-url directory "/")))
|
||||||
(links (url->links url)))
|
(links (url->links url)))
|
||||||
|
@ -730,7 +732,6 @@ (define* (import-savannah-release package #:key (version #f))
|
||||||
(match (origin-uri (package-source package))
|
(match (origin-uri (package-source package))
|
||||||
((? string? uri) uri)
|
((? string? uri) uri)
|
||||||
((uri mirrors ...) uri))))
|
((uri mirrors ...) uri))))
|
||||||
(package (package-upstream-name package))
|
|
||||||
(directory (dirname (uri-path uri))))
|
(directory (dirname (uri-path uri))))
|
||||||
;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
|
;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
|
||||||
;; or whichever detached signature naming scheme PACKAGE uses.
|
;; or whichever detached signature naming scheme PACKAGE uses.
|
||||||
|
@ -825,7 +826,6 @@ (define (file->signature file)
|
||||||
(match (origin-uri (package-source package))
|
(match (origin-uri (package-source package))
|
||||||
((? string? uri) uri)
|
((? string? uri) uri)
|
||||||
((uri mirrors ...) uri))))
|
((uri mirrors ...) uri))))
|
||||||
(package (package-upstream-name package))
|
|
||||||
(directory (dirname (uri-path uri))))
|
(directory (dirname (uri-path uri))))
|
||||||
(import-html-release %kernel.org-base package
|
(import-html-release %kernel.org-base package
|
||||||
#:version version
|
#:version version
|
||||||
|
@ -873,8 +873,7 @@ (define* (import-html-updatable-release package #:key (version #f))
|
||||||
"://" (uri-host uri))))
|
"://" (uri-host uri))))
|
||||||
(directory (if custom
|
(directory (if custom
|
||||||
""
|
""
|
||||||
(dirname (uri-path uri))))
|
(dirname (uri-path uri)))))
|
||||||
(package (package-upstream-name package)))
|
|
||||||
(false-if-networking-error
|
(false-if-networking-error
|
||||||
(import-html-release base package
|
(import-html-release base package
|
||||||
#:version version
|
#:version version
|
||||||
|
|
Loading…
Reference in a new issue