From 977eb5d023cfdf8e336f1896480eea9cef5c04e9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Nov 2020 11:03:19 +0100 Subject: Properly deal with build directories containing '~'. Fixes . Reported by Vagrant Cascadian . * 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. --- gnu/services/base.scm | 15 +++++++++++++-- tests/build-utils.scm | 4 ++-- 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 @@ (define (root-file-system-service) (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 ." 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 +;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -174,7 +174,7 @@ (define-module (test-build-utils) (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" -- cgit v1.2.3