ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-13 06:36:37 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: openntpd: Fix the config generation code.

Browse source 
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:
Maxim Cournoyer 2019-09-07 12:37:37 +09:00
parent 2625abc6aa
commit ccdfae388d
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 23 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gnu/services/networking.scm
View file

@ -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-append
(string-join (string-join
(filter-map (concatenate
(lambda (field value) (filter-map (lambda (field values)
(string-join (match values
(map (cut string-append field <> "\n") (() #f) ;discard entry with filter-map
value))) ((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" '("listen on" "query from" "sensor" "server" "servers"
"constraint from ") "constraint from" "constraints from")
(list listen-on query-from sensor server servers constraint-from)) ;; The corresponding entry values.
;; The 'constraints from' field needs to be enclosed in double quotes. (list listen-on query-from sensor server servers
(string-join constraint-from constraints-from)))
(map (cut string-append "constraints from \"" <> "\"\n") "\n")
constraints-from))))) "\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))