mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
gnu-maintenance: 'generic-html' correctly handles relative release URLs.
* guix/gnu-maintenance.scm (latest-html-release)[url->release]: Fix source URL construction in cases where URL is a possibly relative path.
This commit is contained in:
parent
d7c356edb9
commit
84f8bae0f8
1 changed files with 17 additions and 3 deletions
|
@ -496,9 +496,23 @@ (define (file->signature/guess url)
|
|||
|
||||
(define (url->release url)
|
||||
(let* ((base (basename url))
|
||||
(url (if (string=? base url)
|
||||
(string-append base-url directory "/" url)
|
||||
url)))
|
||||
(base-url (string-append base-url directory))
|
||||
(url (cond ((and=> (string->uri url) uri-scheme) ;full URL?
|
||||
url)
|
||||
((string-prefix? "/" url) ;absolute path?
|
||||
(let ((uri (string->uri base-url)))
|
||||
(uri->string
|
||||
(build-uri (uri-scheme uri)
|
||||
#:host (uri-host uri)
|
||||
#:port (uri-port uri)
|
||||
#:path url))))
|
||||
|
||||
;; URL is relative path and BASE-URL may or may not
|
||||
;; end in slash.
|
||||
((string-suffix? "/" base-url)
|
||||
(string-append base-url url))
|
||||
(else
|
||||
(string-append (dirname base-url) "/" url)))))
|
||||
(and (release-file? package base)
|
||||
(let ((version (tarball->version base)))
|
||||
(upstream-source
|
||||
|
|
Loading…
Reference in a new issue