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.
This commit is contained in:
parent
630602831d
commit
977eb5d023
@ -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>."
|
||||
|
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user