From 84f8bae0f85de081bbc55aa54ad6a50981a06a43 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 May 2021 22:56:38 +0200 Subject: 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. --- guix/gnu-maintenance.scm | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) (limited to 'guix/gnu-maintenance.scm') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 4e3a54dcab..19cf1062bd 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -496,9 +496,23 @@ are unavailable." (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 -- cgit v1.2.3