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>
This commit is contained in:
parent
56aef188a2
commit
720cb10c15
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue