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.
This commit is contained in:
parent
6eb1d20b68
commit
dec845606d
|
@ -33,6 +33,7 @@
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-14)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
|
@ -54,9 +55,23 @@
|
||||||
(url-fetch url file #:mirrors %mirrors)))
|
(url-fetch url file #:mirrors %mirrors)))
|
||||||
file))
|
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))
|
(define* (download-to-store* url #:key (verify-certificate? #t))
|
||||||
(with-store store
|
(with-store store
|
||||||
(download-to-store store url
|
(download-to-store store url
|
||||||
|
(ensure-valid-store-file-name (basename url))
|
||||||
#:verify-certificate? verify-certificate?)))
|
#:verify-certificate? verify-certificate?)))
|
||||||
|
|
||||||
(define %default-options
|
(define %default-options
|
||||||
|
|
Loading…
Reference in New Issue