services: shepherd: Map all the invalid store characters to dash.

Fixes a regression introduced in
977eb5d023 whereby file system services
would now have a different name.

* gnu/services/base.scm (file-system->shepherd-service-name): Revert
changes introduced in 977eb5d023.
* gnu/services/shepherd.scm (%store-characters): New variable
(shepherd-service-file-name): Map all the characters outside
%STORE-CHARACTERS to #\-.
This commit is contained in:
Ludovic Courtès 2020-11-18 10:58:58 +01:00
parent 5bc19300ee
commit 37b98e8cca
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 11 additions and 17 deletions

View File

@ -291,19 +291,8 @@ 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."
(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)))
(symbol-append 'file-system-
(string->symbol (file-system-mount-point file-system))))
(define (mapped-device->shepherd-service-name md)
"Return the symbol that denotes the shepherd service of MD, a <mapped-device>."

View File

@ -224,16 +224,21 @@ which is not provided by any service")
(for-each assert-satisfied-requirements services))
(define %store-characters
;; Valid store characters; see 'checkStoreName' in the daemon.
(string->char-set
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
(define (shepherd-service-file-name service)
"Return the file name where the initialization code for SERVICE is to be
stored."
(let ((provisions (string-join (map symbol->string
(shepherd-service-provision service)))))
(string-append "shepherd-"
(string-map (match-lambda
(#\/ #\-)
(#\ #\-)
(chr chr))
(string-map (lambda (chr)
(if (char-set-contains? %store-characters chr)
chr
#\-))
provisions)
".scm")))