futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Properly deal with build directories containing '~'.

Browse Source 
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:
Ludovic Courtès 2020-11-16 11:03:19 +01:00
parent 630602831d
commit 977eb5d023
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gnu/services/base.scm
View File

@ -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) (define (file-system->shepherd-service-name file-system)
"Return the symbol that denotes the service mounting and unmounting "Return the symbol that denotes the service mounting and unmounting
FILE-SYSTEM." FILE-SYSTEM."
(symbol-append 'file-system- (define valid-characters
(string->symbol (file-system-mount-point file-system)))) ;; 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) (define (mapped-device->shepherd-service-name md)
"Return the symbol that denotes the shepherd service of MD, a <mapped-device>." "Return the symbol that denotes the shepherd service of MD, a <mapped-device>."

4
tests/build-utils.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -174,7 +174,7 @@ echo hello world"))
(let ((script-file-name (string-append directory "/foo"))) (let ((script-file-name (string-append directory "/foo")))
(call-with-output-file script-file-name (call-with-output-file script-file-name
(lambda (port) (lambda (port)
(format port script-contents))) (display script-contents port)))
(chmod script-file-name #o777) (chmod script-file-name #o777)
(wrap-script script-file-name (wrap-script script-file-name
`("GUIX_FOO" prefix ("/some/path" `("GUIX_FOO" prefix ("/some/path"