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

[guix-commits]

civodul pushed a commit to branch version-1.2.0
in repository guix.

commit 37b98e8cca3244067071bc6e382b06861457a459
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Nov 18 10:58:58 2020 +0100

    services: shepherd: Map all the invalid store characters to dash.
    
    Fixes a regression introduced in
    977eb5d023cfdf8e336f1896480eea9cef5c04e9 whereby file system services
    would now have a different name.
    
    * gnu/services/base.scm (file-system->shepherd-service-name): Revert
    changes introduced in 977eb5d023cfdf8e336f1896480eea9cef5c04e9.
    * gnu/services/shepherd.scm (%store-characters): New variable
    (shepherd-service-file-name): Map all the characters outside
    %STORE-CHARACTERS to #\-.
---
 gnu/services/base.scm     | 15 ++-------------
 gnu/services/shepherd.scm | 13 +++++++++----
 2 files changed, 11 insertions(+), 17 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 55d8c91..e1892f3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -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>."
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index e14ceca..1faeb35 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -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")))