diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-11-18 10:58:58 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-11-18 11:13:49 +0100 |
| commit | 37b98e8cca3244067071bc6e382b06861457a459 (patch) | |
| tree | c85c955f098254a2770372f0471b4f2a1c88f3cf | |
| parent | 5bc19300ee82093f9e20760dc5e305e12df12dd0 (diff) | |
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 #\-.
| -rw-r--r-- | gnu/services/base.scm | 15 | ||||
| -rw-r--r-- | 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 55d8c91cb5a..e1892f3e487 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 | |||
| 291 | (define (file-system->shepherd-service-name file-system) | 291 | (define (file-system->shepherd-service-name file-system) |
| 292 | "Return the symbol that denotes the service mounting and unmounting | 292 | "Return the symbol that denotes the service mounting and unmounting |
| 293 | FILE-SYSTEM." | 293 | FILE-SYSTEM." |
| 294 | (define valid-characters | 294 | (symbol-append 'file-system- |
| 295 | ;; Valid store characters; see 'checkStoreName' in the daemon. | 295 | (string->symbol (file-system-mount-point file-system)))) |
| 296 | (string->char-set | ||
| 297 | "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?=")) | ||
| 298 | |||
| 299 | (define mount-point | ||
| 300 | (string-map (lambda (chr) | ||
| 301 | (if (char-set-contains? valid-characters chr) | ||
| 302 | chr | ||
| 303 | #\-)) | ||
| 304 | (file-system-mount-point file-system))) | ||
| 305 | |||
| 306 | (symbol-append 'file-system- (string->symbol mount-point))) | ||
| 307 | 296 | ||
| 308 | (define (mapped-device->shepherd-service-name md) | 297 | (define (mapped-device->shepherd-service-name md) |
| 309 | "Return the symbol that denotes the shepherd service of MD, a <mapped-device>." | 298 | "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 e14ceca231c..1faeb350dfb 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm | |||
| @@ -224,16 +224,21 @@ which is not provided by any service") | |||
| 224 | 224 | ||
| 225 | (for-each assert-satisfied-requirements services)) | 225 | (for-each assert-satisfied-requirements services)) |
| 226 | 226 | ||
| 227 | (define %store-characters | ||
| 228 | ;; Valid store characters; see 'checkStoreName' in the daemon. | ||
| 229 | (string->char-set | ||
| 230 | "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?=")) | ||
| 231 | |||
| 227 | (define (shepherd-service-file-name service) | 232 | (define (shepherd-service-file-name service) |
| 228 | "Return the file name where the initialization code for SERVICE is to be | 233 | "Return the file name where the initialization code for SERVICE is to be |
| 229 | stored." | 234 | stored." |
| 230 | (let ((provisions (string-join (map symbol->string | 235 | (let ((provisions (string-join (map symbol->string |
| 231 | (shepherd-service-provision service))))) | 236 | (shepherd-service-provision service))))) |
| 232 | (string-append "shepherd-" | 237 | (string-append "shepherd-" |
| 233 | (string-map (match-lambda | 238 | (string-map (lambda (chr) |
| 234 | (#\/ #\-) | 239 | (if (char-set-contains? %store-characters chr) |
| 235 | (#\ #\-) | 240 | chr |
| 236 | (chr chr)) | 241 | #\-)) |
| 237 | provisions) | 242 | provisions) |
| 238 | ".scm"))) | 243 | ".scm"))) |
| 239 | 244 | ||
