mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
services: openntpd: Fix the config generation code.
This fixes issue #37318 (see: http://bugs.gnu.org/37318). * gnu/services/networking.scm (openntpd-configuration->string): Rewrite in order to make the "openntpd configuration generation sanity check" test pass.
This commit is contained in:
parent
2625abc6aa
commit
ccdfae388d
1 changed files with 23 additions and 12 deletions
|
@ -505,22 +505,33 @@ (define-record-type* <openntpd-configuration>
|
||||||
(default #f))) ; upstream default
|
(default #f))) ; upstream default
|
||||||
|
|
||||||
(define (openntpd-configuration->string config)
|
(define (openntpd-configuration->string config)
|
||||||
|
|
||||||
|
(define (quote-field? name)
|
||||||
|
(member name '("constraints from")))
|
||||||
|
|
||||||
(match-record config <openntpd-configuration>
|
(match-record config <openntpd-configuration>
|
||||||
(listen-on query-from sensor server servers constraint-from
|
(listen-on query-from sensor server servers constraint-from
|
||||||
constraints-from)
|
constraints-from)
|
||||||
(string-join
|
(string-append
|
||||||
(filter-map
|
|
||||||
(lambda (field value)
|
|
||||||
(string-join
|
|
||||||
(map (cut string-append field <> "\n")
|
|
||||||
value)))
|
|
||||||
'("listen on " "query from " "sensor " "server " "servers "
|
|
||||||
"constraint from ")
|
|
||||||
(list listen-on query-from sensor server servers constraint-from))
|
|
||||||
;; The 'constraints from' field needs to be enclosed in double quotes.
|
|
||||||
(string-join
|
(string-join
|
||||||
(map (cut string-append "constraints from \"" <> "\"\n")
|
(concatenate
|
||||||
constraints-from)))))
|
(filter-map (lambda (field values)
|
||||||
|
(match values
|
||||||
|
(() #f) ;discard entry with filter-map
|
||||||
|
((val ...) ;validate value type
|
||||||
|
(map (lambda (value)
|
||||||
|
(if (quote-field? field)
|
||||||
|
(format #f "~a \"~a\"" field value)
|
||||||
|
(format #f "~a ~a" field value)))
|
||||||
|
values))))
|
||||||
|
;; The entry names.
|
||||||
|
'("listen on" "query from" "sensor" "server" "servers"
|
||||||
|
"constraint from" "constraints from")
|
||||||
|
;; The corresponding entry values.
|
||||||
|
(list listen-on query-from sensor server servers
|
||||||
|
constraint-from constraints-from)))
|
||||||
|
"\n")
|
||||||
|
"\n"))) ;add a trailing newline
|
||||||
|
|
||||||
(define (openntpd-shepherd-service config)
|
(define (openntpd-shepherd-service config)
|
||||||
(let ((openntpd (openntpd-configuration-openntpd config))
|
(let ((openntpd (openntpd-configuration-openntpd config))
|
||||||
|
|
Loading…
Reference in a new issue