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:
Clément Lassieur 2017-02-28 01:44:03 +01:00
parent 56aef188a2
commit 720cb10c15
No known key found for this signature in database
GPG Key ID: 89F96D4808F359C7
3 changed files with 47 additions and 40 deletions

View File

@ -39,14 +39,6 @@
define-configuration define-configuration
validate-configuration validate-configuration
generate-documentation 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)) serialize-package))
;;; Commentary: ;;; Commentary:
@ -140,41 +132,9 @@
#,(id #'stem #'stem #'-fields)) #,(id #'stem #'stem #'-fields))
conf)))))))) 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) (define (serialize-package field-name val)
#f) #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. ;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name) (define (generate-documentation documentation documentation-name)
(define (str x) (object->string x)) (define (str x) (object->string x))

View File

@ -57,6 +57,21 @@
(home-directory "/var/empty") (home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin"))))) (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) (define (multiline-string-list? val)
(and (list? val) (and (list? val)
(and-map (lambda (x) (and-map (lambda (x)
@ -65,11 +80,28 @@
(define (serialize-multiline-string-list field-name val) (define (serialize-multiline-string-list field-name val)
(for-each (lambda (str) (serialize-field field-name str)) 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) (define (space-separated-symbol-list? val)
(and (list? val) (and-map symbol? val))) (and (list? val) (and-map symbol? val)))
(define (serialize-space-separated-symbol-list field-name val) (define (serialize-space-separated-symbol-list field-name val)
(serialize-field field-name (string-join (map symbol->string 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) (define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val)))) (and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val) (define (serialize-non-negative-integer field-name val)

View File

@ -96,6 +96,12 @@ trailing '?' removed."
(unless (eq? val unset-field) (unless (eq? val unset-field)
(serialize-field* field-name (string-join val " ")))) (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? (define space-separated-string-list/unset?
(predicate/unset space-separated-string-list?)) (predicate/unset space-separated-string-list?))
@ -118,10 +124,19 @@ trailing '?' removed."
(lambda (val) (lambda (val)
(string-prefix? "/" 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) (define (serialize-file-name field-name val)
(unless (eq? val unset-field) (unless (eq? val unset-field)
(serialize-string field-name val))) (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) (define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val)))) (and (exact-integer? val) (not (negative? val))))