diff options
| -rw-r--r-- | gnu/services/networking.scm | 40 | ||||
| -rw-r--r-- | tests/networking.scm | 67 |
2 files changed, 86 insertions, 21 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index dd2f9e29e2..432f3a80ee 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -504,28 +504,30 @@ make an initial adjustment of more than 1,000 seconds." (allow-large-adjustment? openntpd-allow-large-adjustment? (default #f))) ; upstream default -(define (openntpd-shepherd-service config) +(define (openntpd-configuration->string config) (match-record config <openntpd-configuration> - (openntpd listen-on query-from sensor server servers constraint-from - constraints-from allow-large-adjustment?) - - (define config - (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-join - (map (cut string-append "constraints from \"" <> "\"\n") - constraints-from)))) + (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-join + (map (cut string-append "constraints from \"" <> "\"\n") + constraints-from))))) + +(define (openntpd-shepherd-service config) + (let ((openntpd (openntpd-configuration-openntpd config)) + (allow-large-adjustment? (openntpd-allow-large-adjustment? config))) (define ntpd.conf - (plain-file "ntpd.conf" config)) + (plain-file "ntpd.conf" (openntpd-configuration->string config))) (list (shepherd-service (provision '(ntpd)) diff --git a/tests/networking.scm b/tests/networking.scm index 001d7df74d..439cca5ffc 100644 --- a/tests/networking.scm +++ b/tests/networking.scm @@ -17,11 +17,19 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (tests networking) + #:use-module (ice-9 regex) #:use-module (gnu services networking) #:use-module (srfi srfi-64)) ;;; Tests for the (gnu services networking) module. +(test-begin "networking") + + +;;; +;;; NTP. +;;; + (define ntp-server->string (@@ (gnu services networking) ntp-server->string)) (define %ntp-server-sample @@ -30,8 +38,6 @@ (address "some.ntp.server.org") (options `(iburst (version 3) (maxpoll 16) prefer)))) -(test-begin "networking") - (test-equal "ntp-server->string" (ntp-server->string %ntp-server-sample) "server some.ntp.server.org iburst version 3 maxpoll 16 prefer") @@ -47,4 +53,61 @@ (ntp-configuration (servers (list "example.pool.ntp.org"))))) + +;;; +;;; OpenNTPD +;;; + +(define openntpd-configuration->string (@@ (gnu services networking) + openntpd-configuration->string)) + +(define %openntpd-conf-sample + (openntpd-configuration + (server '("0.guix.pool.ntp.org" "1.guix.pool.ntp.org")) + (listen-on '("127.0.0.1" "::1")) + (sensor '("udcf0 correction 70000")) + (constraint-from '("www.gnu.org")) + (constraints-from '("https://www.google.com/")) + (allow-large-adjustment? #t))) + +(test-assert "openntpd configuration generation sanity check" + + (begin + (define (string-match/newline pattern text) + (regexp-exec (make-regexp pattern regexp/newline) text)) + + (define (match-count pattern text) + (fold-matches (make-regexp pattern regexp/newline) text 0 + (lambda (match count) + (1+ count)))) + + (let ((config (openntpd-configuration->string %openntpd-conf-sample))) + (if (not + (and (string-match/newline "^listen on 127.0.0.1$" config) + (string-match/newline "^listen on ::1$" config) + (string-match/newline "^sensor udcf0 correction 70000$" config) + (string-match/newline "^constraint from www.gnu.org$" config) + (string-match/newline "^server 0.guix.pool.ntp.org$" config) + (string-match/newline + "^constraints from \"https://www.google.com/\"$" + config) + + ;; Check for issue #3731 (see: + ;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=37318). + (= (match-count "^listen on " config) 2) + (= (match-count "^sensor " config) 1) + (= (match-count "^constraint from " config) 1) + (= (match-count "^server " config) 2) + (= (match-count "^constraints from " config) 1))) + (begin + (format #t "The configuration below failed \ +the sanity check:\n~a~%" config) + #f) + #t)))) + +(test-equal "openntpd generated config string ends with a newline" + (let ((config (openntpd-configuration->string %openntpd-conf-sample))) + (string-take-right config 1)) + "\n") + (test-end "networking") |