02/03: substitutes: Properly construct URLs.

[guix-commits]

htgoebel pushed a commit to branch master
in repository guix.

commit ccdf7b8006bd5173cd8ff7d2fe732fc171d38f5d
Author: Hartmut Goebel <h.goebel@crazy-compilers.com>
AuthorDate: Thu Jul 8 00:45:41 2021 +0200

    substitutes: Properly construct URLs.
    
    Use relative URIs and "resolve-uri-reference" (which implements the 
algorithm
    specified in RFC 3986 section 5.2.2) for building the URL, instead of just
    appending strings. This avoids issued if the cache-url ends with a slash.
    
    * guix/substitutes.scm (narinfo-request): Use resolve-uri-reference for
      constructing the url.
---
 guix/substitutes.scm | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/guix/substitutes.scm b/guix/substitutes.scm
index 4987cda..a5c554a 100644
--- a/guix/substitutes.scm
+++ b/guix/substitutes.scm
@@ -37,7 +37,8 @@
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
                 #:select ((open-connection-for-uri
-                           . guix:open-connection-for-uri)))
+                           . guix:open-connection-for-uri)
+                          resolve-uri-reference))
   #:use-module (guix progress)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
@@ -155,10 +156,12 @@ indicates that PATH is unavailable at CACHE-URL."
 
 (define (narinfo-request cache-url path)
   "Return an HTTP request for the narinfo of PATH at CACHE-URL."
-  (let ((url (string-append cache-url "/" (store-path-hash-part path)
-                            ".narinfo"))
-        (headers '((User-Agent . "GNU Guile"))))
-    (build-request (string->uri url) #:method 'GET #:headers headers)))
+  (let* ((base (string->uri cache-url))
+         (ref (build-relative-ref
+               #:path (string-append (store-path-hash-part path) ".narinfo")))
+         (url (resolve-uri-reference ref base))
+         (headers '((User-Agent . "GNU Guile"))))
+    (build-request url #:method 'GET #:headers headers)))
 
 (define (narinfo-from-file file url)
   "Attempt to read a narinfo from FILE, using URL as the cache URL.  Return #f