01/01: guix download: Ensure destination file-name is valid in the store.

[guix-commits]

htgoebel pushed a commit to branch master
in repository guix.

commit dec845606d2d184da31065fa26cd951b84b3ce2d
Author: Hartmut Goebel <address@hidden>
Date:   Thu Aug 8 16:43:15 2019 +0200

    guix download: Ensure destination file-name is valid in the store.
    
    Avoid invalid store-file-name by explicitly passing the destination
    name, replacing any character not allowed in the store-file-name by an
    underscore.
    
    Fixes <http://issues.guix.gnu.org/issue/26175>
    
    * guix/scripts/download.scm (safe-naensure-valid-store-file-nameme):
      New function. (download-to-store*): Use it to generate a "safe"
      basename of URL.
---
 guix/scripts/download.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index d8fe71c..22cd75e 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -33,6 +33,7 @@
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-14)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs bytevectors)
@@ -54,9 +55,23 @@
        (url-fetch url file #:mirrors %mirrors)))
     file))
 
+(define (ensure-valid-store-file-name name)
+  "Replace any character not allowed in a stror name by an underscore."
+
+  (define valid
+    ;; according to nix/libstore/store-api.cc
+    (string->char-set (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                     "abcdefghijklmnopqrstuvwxyz"
+                                     "0123456789" "+-._?=")))
+  (string-map (lambda (c)
+                (if (char-set-contains? valid c) c #\_))
+              name))
+
+
 (define* (download-to-store* url #:key (verify-certificate? #t))
   (with-store store
     (download-to-store store url
+                       (ensure-valid-store-file-name (basename url))
                        #:verify-certificate? verify-certificate?)))
 
 (define %default-options