aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-11-16 11:03:19 +0100
committerLudovic Courtès <ludo@gnu.org>2020-11-16 11:21:42 +0100
commit977eb5d023cfdf8e336f1896480eea9cef5c04e9 (patch)
treeef52e8a6dd446e79c964afb83befc46daedd4335
parent630602831dd93e7bc9a8e64fba958300e8cb0474 (diff)
downloadguix-977eb5d023cfdf8e336f1896480eea9cef5c04e9.tar
guix-977eb5d023cfdf8e336f1896480eea9cef5c04e9.tar.gz
Properly deal with build directories containing '~'.
Fixes <https://bugs.gnu.org/44626>. Reported by Vagrant Cascadian <vagrant@debian.org>. * tests/build-utils.scm ("wrap-script, simple case"): Pass SCRIPT-CONTENTS to 'display' rather than 'format'. * gnu/services/base.scm (file-system->shepherd-service-name) [valid-characters, mount-point]: New variables. Filter out invalid store file name characters from the mount point of FILE-SYSTEM.
-rw-r--r--gnu/services/base.scm15
-rw-r--r--tests/build-utils.scm4
2 files changed, 15 insertions, 4 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 499e50bfd7..712b3a018f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -285,8 +285,19 @@ This service must be the root of the service dependency graph so that its
(define (file-system->shepherd-service-name file-system)
"Return the symbol that denotes the service mounting and unmounting
FILE-SYSTEM."
- (symbol-append 'file-system-
- (string->symbol (file-system-mount-point file-system))))
+ (define valid-characters
+ ;; Valid store characters; see 'checkStoreName' in the daemon.
+ (string->char-set
+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
+
+ (define mount-point
+ (string-map (lambda (chr)
+ (if (char-set-contains? valid-characters chr)
+ chr
+ #\-))
+ (file-system-mount-point file-system)))
+
+ (symbol-append 'file-system- (string->symbol mount-point)))
(define (mapped-device->shepherd-service-name md)
"Return the symbol that denotes the shepherd service of MD, a <mapped-device>."
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 47a57a984b..654b480ed9 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@@ -174,7 +174,7 @@ echo hello world"))
(let ((script-file-name (string-append directory "/foo")))
(call-with-output-file script-file-name
(lambda (port)
- (format port script-contents)))
+ (display script-contents port)))
(chmod script-file-name #o777)
(wrap-script script-file-name
`("GUIX_FOO" prefix ("/some/path"