From ccdfae388d61f2263a085a4ddac8cb2919d01531 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Sat, 7 Sep 2019 12:37:37 +0900
Subject: 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.
---
 gnu/services/networking.scm | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

(limited to 'gnu/services')

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 432f3a80ee..c775242f99 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -505,22 +505,33 @@ (define-record-type* <openntpd-configuration>
                            (default #f))) ; upstream default
 
 (define (openntpd-configuration->string config)
+
+  (define (quote-field? name)
+    (member name '("constraints from")))
+
   (match-record config <openntpd-configuration>
     (listen-on query-from sensor server servers constraint-from
                constraints-from)
-    (string-join
-     (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-append
      (string-join
-      (map (cut string-append "constraints from \"" <> "\"\n")
-           constraints-from)))))
+      (concatenate
+       (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)
   (let ((openntpd (openntpd-configuration-openntpd config))
-- 
cgit v1.2.3