diff options
author | Clément Lassieur <clement@lassieur.org> | 2017-02-28 01:44:03 +0100 |
---|---|---|
committer | Clément Lassieur <clement@lassieur.org> | 2017-03-12 19:09:32 +0100 |
commit | 720cb10c15a4606fe0dc3511db4fef325f3d9dc6 (patch) | |
tree | b11a2ea3bba52b3e8a79810b22e12e3dfc15b732 /gnu/services | |
parent | 56aef188a2a014e254d3c93c8a79cd1fb5a1ece6 (diff) | |
download | patches-720cb10c15a4606fe0dc3511db4fef325f3d9dc6.tar patches-720cb10c15a4606fe0dc3511db4fef325f3d9dc6.tar.gz |
services: Move configuration functions that shouldn't be factorized.
* gnu/services/configuration.scm (serialize-field, serialize-string)
(serialize-space-separated-string-list, space-separated-string-list?)
(serialize-file-name, file-name?, serialize-boolean): Move these functions...
* gnu/services/cups.scm: ...to this file.
* gnu/services/kerberos.scm: ...to this file.
Configuration syntaxes are very specific to services. Some services may have
the same configuration syntax, but none of them is common enough to be
abstracted in configuration.scm.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
Diffstat (limited to 'gnu/services')
-rw-r--r-- | gnu/services/configuration.scm | 40 | ||||
-rw-r--r-- | gnu/services/cups.scm | 32 | ||||
-rw-r--r-- | gnu/services/kerberos.scm | 15 |
3 files changed, 47 insertions, 40 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index a98db64fa5..2ad3a637a4 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -39,14 +39,6 @@ define-configuration validate-configuration generate-documentation - serialize-field - serialize-string - serialize-name - serialize-space-separated-string-list - space-separated-string-list? - serialize-file-name - file-name? - serialize-boolean serialize-package)) ;;; Commentary: @@ -140,41 +132,9 @@ #,(id #'stem #'stem #'-fields)) conf)))))))) -(define (uglify-field-name field-name) - (let ((str (symbol->string field-name))) - (string-concatenate - (map string-titlecase - (string-split (if (string-suffix? "?" str) - (substring str 0 (1- (string-length str))) - str) - #\-))))) - -(define (serialize-field field-name val) - (format #t "~a ~a\n" (uglify-field-name field-name) val)) - (define (serialize-package field-name val) #f) -(define (serialize-string field-name val) - (serialize-field field-name val)) - -(define (space-separated-string-list? val) - (and (list? val) - (and-map (lambda (x) - (and (string? x) (not (string-index x #\space)))) - val))) -(define (serialize-space-separated-string-list field-name val) - (serialize-field field-name (string-join val " "))) - -(define (file-name? val) - (and (string? val) - (string-prefix? "/" val))) -(define (serialize-file-name field-name val) - (serialize-string field-name val)) - -(define (serialize-boolean field-name val) - (serialize-string field-name (if val "yes" "no"))) - ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) (define (str x) (object->string x)) diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm index 70b858479a..70a71eff0a 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -57,6 +57,21 @@ (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-concatenate + (map string-titlecase + (string-split (if (string-suffix? "?" str) + (substring str 0 (1- (string-length str))) + str) + #\-))))) + +(define (serialize-field field-name val) + (format #t "~a ~a\n" (uglify-field-name field-name) val)) + +(define (serialize-string field-name val) + (serialize-field field-name val)) + (define (multiline-string-list? val) (and (list? val) (and-map (lambda (x) @@ -65,11 +80,28 @@ (define (serialize-multiline-string-list field-name val) (for-each (lambda (str) (serialize-field field-name str)) val)) +(define (space-separated-string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) (not (string-index x #\space)))) + val))) +(define (serialize-space-separated-string-list field-name val) + (serialize-field field-name (string-join val " "))) + (define (space-separated-symbol-list? val) (and (list? val) (and-map symbol? val))) (define (serialize-space-separated-symbol-list field-name val) (serialize-field field-name (string-join (map symbol->string val) " "))) +(define (file-name? val) + (and (string? val) + (string-prefix? "/" val))) +(define (serialize-file-name field-name val) + (serialize-string field-name val)) + +(define (serialize-boolean field-name val) + (serialize-string field-name (if val "yes" "no"))) + (define (non-negative-integer? val) (and (exact-integer? val) (not (negative? val)))) (define (serialize-non-negative-integer field-name val) diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm index cb33a7c53d..f09f47893c 100644 --- a/gnu/services/kerberos.scm +++ b/gnu/services/kerberos.scm @@ -96,6 +96,12 @@ trailing '?' removed." (unless (eq? val unset-field) (serialize-field* field-name (string-join val " ")))) +(define (space-separated-string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) (not (string-index x #\space)))) + val))) + (define space-separated-string-list/unset? (predicate/unset space-separated-string-list?)) @@ -118,10 +124,19 @@ trailing '?' removed." (lambda (val) (string-prefix? "/" val)))) +(define (serialize-field field-name val) + (format #t "~a ~a\n" (uglify-field-name field-name) val)) + +(define (serialize-string field-name val) + (serialize-field field-name val)) + (define (serialize-file-name field-name val) (unless (eq? val unset-field) (serialize-string field-name val))) +(define (serialize-space-separated-string-list field-name val) + (serialize-field field-name (string-join val " "))) + (define (non-negative-integer? val) (and (exact-integer? val) (not (negative? val)))) |