summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-27 21:33:54 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-27 21:33:54 +0100
commit480943dd461690358f25ad579c2d0a30351669aa (patch)
tree46fde215b375566170b9f38794ddb47b304aef4b
parent5321f74f234742ad9e039de33e60288a9a830949 (diff)
downloadguix-480943dd461690358f25ad579c2d0a30351669aa.tar.gz
download: Keep only one slash when concatenating URIs.
* guix/build/download.scm (url-fetch)[uri-vicinity]: New procedure.
  [maybe-expand-mirrors]: Use it.
-rw-r--r--guix/build/download.scm8
1 files changed, 7 insertions, 1 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 7af16da65f..9d90971f28 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -135,6 +135,12 @@ which is not available during bootstrap."
   "Fetch FILE from URL; URL may be either a single string, or a list of
 string denoting alternate URLs for FILE.  Return #f on failure, and FILE
 on success."
+  (define (uri-vicinity dir file)
+    ;; Concatenate DIR, slash, and FILE, keeping only one slash in between.
+    ;; This is required by some HTTP servers.
+    (string-append (string-trim-right dir #\/) "/"
+                   (string-trim file #\/)))
+
   (define (maybe-expand-mirrors uri)
     (case (uri-scheme uri)
       ((mirror)
@@ -142,7 +148,7 @@ on success."
              (path (uri-path uri)))
          (match (assoc-ref mirrors kind)
            ((mirrors ..1)
-            (map (compose string->uri (cut string-append <> path))
+            (map (compose string->uri (cut uri-vicinity <> path))
                  mirrors))
            (_
             (error "unsupported URL mirror kind" kind uri)))))