From 720cb10c15a4606fe0dc3511db4fef325f3d9dc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= Date: Tue, 28 Feb 2017 01:44:03 +0100 Subject: [PATCH] services: Move configuration functions that shouldn't be factorized. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- gnu/services/configuration.scm | 40 ---------------------------------- gnu/services/cups.scm | 32 +++++++++++++++++++++++++++ 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))))