[bug#51441] [PATCH] substitutes: keep base's uri-path for Properly construct URL.

[Z572 via Guix-patches via <guix-patches@gnu.org>]

it just fix fetch narinfos url, substitute still don't download, later i
will try fix it.

Z572 via Guix-patches via <guix-patches@gnu.org> writes:

> Hello,
>
> Sorry for my english, and i'm not sure ChangeLog is right.
>
> https://mirror.sjtu.edu.cn/guix use customize script to mirror official
> substitutes server, at /guix not in /  . narinfo-request will forget add /guix to url, so i
> can't use substitutes from them, this patch fix it.
>
> From 7fe17965d5336d55ec8b1b7471cbbb34b12e9a0b Mon Sep 17 00:00:00 2001
> From: Z572 <873216071@qq.com>
> Date: Wed, 27 Oct 2021 21:28:24 +0800
> Subject: [PATCH] substitutes: keep base's uri-path for Properly construct URL.
>
> substitutes (narinfo-request): keep BASE's uri-path for properly construct url.
>
> some substitutes server don't use guix publish, them use customize scripts to
> mirror official server, if them look likes https://example.com/guix ,
> narinfo-request will lost /guix .
> ---
>  guix/substitutes.scm | 4 +++-
>  1 file changed, 3 insertions(+), 1 deletion(-)
>
> diff --git a/guix/substitutes.scm b/guix/substitutes.scm
> index a5c554acff..bfbd29623e 100644
> --- a/guix/substitutes.scm
> +++ b/guix/substitutes.scm
> @@ -3,6 +3,7 @@
>  ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
>  ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
>  ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
> +;;; Copyright © 2021 Zheng Junjie <873216071@qq.com>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -158,7 +159,8 @@ (define (narinfo-request cache-url path)
>    "Return an HTTP request for the narinfo of PATH at CACHE-URL."
>    (let* ((base (string->uri cache-url))
>           (ref (build-relative-ref
> -               #:path (string-append (store-path-hash-part path) ".narinfo")))
> +               #:path (string-append (uri-path base) "/"
> +                                     (store-path-hash-part path) ".narinfo")))
>           (url (resolve-uri-reference ref base))
>           (headers '((User-Agent . "GNU Guile"))))
>      (build-request url #:method 'GET #:headers headers)))
> -- 
> 2.33.1


-- 
over