From 1d03a9198db6f3656a34d62eb89e5f7d5a99e76a Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sat, 7 Sep 2019 22:23:32 +0200 Subject: tests: opam: Fix input type in import test. * tests/opam.scm: Expect propagated-inputs instead of inputs. --- tests/opam.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/opam.scm b/tests/opam.scm index e8c0d15198..d3626fd010 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -99,7 +99,7 @@ url { ('base32 (? string? hash))))) ('build-system 'ocaml-build-system) - ('inputs + ('propagated-inputs ('quasiquote (("ocaml-zarith" ('unquote 'ocaml-zarith))))) ('native-inputs -- cgit 1.4.1 From 5658ae8a0ad5d988765944b7e783b2bdc23a7f48 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 3 Sep 2019 10:14:59 +0900 Subject: services: ntp: Support different NTP server types and options. * gnu/services/networking.scm (ntp-server-types): New enum. (): New record type. (ntp-server->string): New procedure. (%ntp-servers): Define in terms of records. Use the first entrypoint server as a pool instead of a list of static servers. This is more resilient since a new server of the pool can be interrogated on every request. Add the 'iburst' options. (ntp-configuration-servers): Define a custom accessor that warns but honors the now deprecated server format. (): Use it. (%openntpd-servers): New variable, (): Use it, as a pool ('servers' field) instead of a regular server. * tests/networking.scm: New file. * Makefile.am (SCM_TESTS): Register it. * doc/guix.texi: Update documentation. --- Makefile.am | 1 + doc/guix.texi | 42 +++++++++++++++-- gnu/services/networking.scm | 108 ++++++++++++++++++++++++++++++++++++-------- tests/networking.scm | 50 ++++++++++++++++++++ 4 files changed, 178 insertions(+), 23 deletions(-) create mode 100644 tests/networking.scm (limited to 'tests') diff --git a/Makefile.am b/Makefile.am index 796e96f099..683b2242f0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -402,6 +402,7 @@ SCM_TESTS = \ tests/modules.scm \ tests/monads.scm \ tests/nar.scm \ + tests/networking.scm \ tests/opam.scm \ tests/packages.scm \ tests/pack.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 84f2c1558a..9101aafda1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -48,7 +48,7 @@ Copyright @copyright{} 2017 humanitiesNerd@* Copyright @copyright{} 2017 Christopher Allan Webber@* Copyright @copyright{} 2017, 2018 Marius Bakke@* Copyright @copyright{} 2017 Hartmut Goebel@* -Copyright @copyright{} 2017 Maxim Cournoyer@* +Copyright @copyright{} 2017, 2019 Maxim Cournoyer@* Copyright @copyright{} 2017, 2018, 2019 Tobias Geerinckx-Rice@* Copyright @copyright{} 2017 George Clemmer@* Copyright @copyright{} 2017 Andy Wingo@* @@ -13048,8 +13048,9 @@ This is the data type for the NTP service configuration. @table @asis @item @code{servers} (default: @code{%ntp-servers}) -This is the list of servers (host names) with which @command{ntpd} will be -synchronized. +This is the list of servers (@code{} records) with which +@command{ntpd} will be synchronized. See the @code{ntp-server} data type +definition below. @item @code{allow-large-adjustment?} (default: @code{#t}) This determines whether @command{ntpd} is allowed to make an initial @@ -13065,6 +13066,32 @@ List of host names used as the default NTP servers. These are servers of the @uref{https://www.ntppool.org/en/, NTP Pool Project}. @end defvr +@deftp {Data Type} ntp-server +The data type representing the configuration of a NTP server. + +@table @asis +@item @code{type} (default: @code{'server}) +The type of the NTP server, given as a symbol. One of @code{'pool}, +@code{'server}, @code{'peer}, @code{'broadcast} or @code{'manycastclient}. + +@item @code{address} +The address of the server, as a string. + +@item @code{options} +NTPD options to use with that specific server, given as a list of option names +and/or of option names and values tuples. The following example define a server +to use with the options @option{iburst} and @option{prefer}, as well as +@option{version} 3 and a @option{maxpoll} time of 16 seconds. + +@example +(ntp-server + (type 'server) + (address "some.ntp.server.org") + (options `(iburst (version 3) (maxpoll 16) prefer)))) +@end example +@end table +@end deftp + @cindex OpenNTPD @deffn {Scheme Procedure} openntpd-service-type Run the @command{ntpd}, the Network Time Protocol (NTP) daemon, as implemented @@ -13084,6 +13111,11 @@ clock synchronized with that of the given servers. @end lisp @end deffn +@defvr {Scheme Variable} %openntpd-servers +This variable is a list of the server addresses defined in +@var{%ntp-servers}. +@end defvr + @deftp {Data Type} openntpd-configuration @table @asis @item @code{openntpd} (default: @code{(file-append openntpd "/sbin/ntpd")}) @@ -13097,9 +13129,9 @@ Specify a list of timedelta sensor devices ntpd should use. @code{ntpd} will listen to each sensor that actually exists and ignore non-existent ones. See @uref{https://man.openbsd.org/ntpd.conf, upstream documentation} for more information. -@item @code{server} (default: @var{%ntp-servers}) +@item @code{server} (default: @code{'()}) Specify a list of IP addresses or hostnames of NTP servers to synchronize to. -@item @code{servers} (default: @code{'()}) +@item @code{servers} (default: @var{%openntp-servers}) Specify a list of IP addresses or hostnames of NTP pools to synchronize to. @item @code{constraint-from} (default: @code{'()}) @code{ntpd} can be configured to query the ‘Date’ from trusted HTTPS servers via TLS. diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 13a5c6c98d..c45bfcdad9 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -51,6 +51,7 @@ #:use-module (guix records) #:use-module (guix modules) #:use-module (guix deprecation) + #:use-module (rnrs enums) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) @@ -72,13 +73,22 @@ dhcpd-configuration-pid-file dhcpd-configuration-interfaces - %ntp-servers - ntp-configuration ntp-configuration? + ntp-configuration-ntp + ntp-configuration-servers + ntp-allow-large-adjustment? + + %ntp-servers + ntp-server + ntp-server-type + ntp-server-address + ntp-server-options + ntp-service ntp-service-type + %openntpd-servers openntpd-configuration openntpd-configuration? openntpd-service-type @@ -292,31 +302,87 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (list (service-extension shepherd-root-service-type dhcpd-shepherd-service) (service-extension activation-service-type dhcpd-activation))))) -(define %ntp-servers - ;; Default set of NTP servers. These URLs are managed by the NTP Pool project. - ;; Within Guix, Leo Famulari is the administrative contact - ;; for this NTP pool "zone". - '("0.guix.pool.ntp.org" - "1.guix.pool.ntp.org" - "2.guix.pool.ntp.org" - "3.guix.pool.ntp.org")) - ;;; ;;; NTP. ;;; -;; TODO: Export. +(define ntp-server-types (make-enumeration + '(pool + server + peer + broadcast + manycastclient))) + +(define-record-type* + ntp-server make-ntp-server + ntp-server? + ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration. + (type ntp-server-type + (default 'server)) + (address ntp-server-address) ; a string + ;; The list of options can contain single option names or tuples in the form + ;; '(name value). + (options ntp-server-options + (default '()))) + +(define (ntp-server->string ntp-server) + ;; Serialize the NTP server object as a string, ready to use in the NTP + ;; configuration file. + (define (flatten lst) + (reverse + (let loop ((x lst) + (res '())) + (if (list? x) + (fold loop res x) + (cons (format #f "~s" x) res))))) + + (match ntp-server + (($ type address options) + ;; XXX: It'd be neater if fields were validated at the syntax level (for + ;; static ones at least). Perhaps the Guix record type could support a + ;; predicate property on a field? + (unless (enum-set-member? type ntp-server-types) + (error "Invalid NTP server type" type)) + (string-join (cons* (symbol->string type) + address + (flatten options)))))) + +(define %ntp-servers + ;; Default set of NTP servers. These URLs are managed by the NTP Pool project. + ;; Within Guix, Leo Famulari is the administrative contact + ;; for this NTP pool "zone". + (list + (ntp-server + (type 'pool) + (address "0.guix.pool.ntp.org") + (options '("iburst"))))) ;as recommended in the ntpd manual + (define-record-type* ntp-configuration make-ntp-configuration ntp-configuration? (ntp ntp-configuration-ntp (default ntp)) - (servers ntp-configuration-servers + (servers %ntp-configuration-servers ;list of objects (default %ntp-servers)) (allow-large-adjustment? ntp-allow-large-adjustment? (default #t))) ;as recommended in the ntpd manual +(define (ntp-configuration-servers ntp-configuration) + ;; A wrapper to support the deprecated form of this field. + (let ((ntp-servers (%ntp-configuration-servers ntp-configuration))) + (match ntp-servers + (((? string?) (? string?) ...) + (format (current-error-port) "warning: Defining NTP servers as strings is \ +deprecated. Please use records instead.\n") + (map (lambda (addr) + (ntp-server + (type 'server) + (address addr) + (options '()))) ntp-servers)) + ((($ ) ($ ) ...) + ntp-servers)))) + (define ntp-shepherd-service (match-lambda (($ ntp servers allow-large-adjustment?) @@ -324,8 +390,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." ;; TODO: Add authentication support. (define config (string-append "driftfile /var/run/ntpd/ntp.drift\n" - (string-join (map (cut string-append "server " <>) - servers) + (string-join (map ntp-server->string servers) "\n") " # Disable status queries as a workaround for CVE-2013-5211: @@ -335,7 +400,11 @@ restrict -6 default kod nomodify notrap nopeer noquery limited # Yet, allow use of the local 'ntpq'. restrict 127.0.0.1 -restrict -6 ::1\n")) +restrict -6 ::1 + +# This is required to use servers from a pool directive when using the 'nopeer' +# option by default, as documented in the 'ntp.conf' manual. +restrict source notrap nomodify noquery\n")) (define ntpd.conf (plain-file "ntpd.conf" config)) @@ -409,6 +478,9 @@ make an initial adjustment of more than 1,000 seconds." ;;; OpenNTPD. ;;; +(define %openntpd-servers + (map ntp-server-address %ntp-servers)) + (define-record-type* openntpd-configuration make-openntpd-configuration openntpd-configuration? @@ -422,9 +494,9 @@ make an initial adjustment of more than 1,000 seconds." (sensor openntpd-sensor (default '())) (server openntpd-server - (default %ntp-servers)) - (servers openntpd-servers (default '())) + (servers openntpd-servers + (default %openntpd-servers)) (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from diff --git a/tests/networking.scm b/tests/networking.scm new file mode 100644 index 0000000000..001d7df74d --- /dev/null +++ b/tests/networking.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Maxim Cournoyer +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (tests networking) + #:use-module (gnu services networking) + #:use-module (srfi srfi-64)) + +;;; Tests for the (gnu services networking) module. + +(define ntp-server->string (@@ (gnu services networking) ntp-server->string)) + +(define %ntp-server-sample + (ntp-server + (type 'server) + (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") + +(test-equal "ntp configuration servers deprecated form" + (ntp-configuration-servers + (ntp-configuration + (servers (list (ntp-server + (type 'server) + (address "example.pool.ntp.org") + (options '())))))) + (ntp-configuration-servers + (ntp-configuration + (servers (list "example.pool.ntp.org"))))) + +(test-end "networking") -- cgit 1.4.1 From 2625abc6aa5df66a6503e906b7592691452954f5 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 7 Sep 2019 09:24:43 +0900 Subject: services: openntpd: Add test for issue #3731. See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=37318. * gnu/services/networking.scm (openntpd-configuration->string): New procedure, extracted from top of the `openntpd-shepherd-service' to make it testable. (openntpd-shepherd-service): Adapt following the move of the code to the above procedure. * tests/networking.scm: Add a test for the `openntpd-configuration->string' procedure. --- gnu/services/networking.scm | 40 ++++++++++++++------------- tests/networking.scm | 67 +++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 86 insertions(+), 21 deletions(-) (limited to 'tests') 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 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 . (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") -- cgit 1.4.1