diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 42 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 108 | ||||
| -rw-r--r-- | tests/networking.scm | 50 |
4 files changed, 178 insertions, 23 deletions
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{<ntp-server>} 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 <leo@famulari.name> 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> + 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 + (($ <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 <leo@famulari.name> 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> ntp-configuration make-ntp-configuration ntp-configuration? (ntp ntp-configuration-ntp (default ntp)) - (servers ntp-configuration-servers + (servers %ntp-configuration-servers ;list of <ntp-server> 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 <ntp-server> records instead.\n") + (map (lambda (addr) + (ntp-server + (type 'server) + (address addr) + (options '()))) ntp-servers)) + ((($ <ntp-server>) ($ <ntp-server>) ...) + ntp-servers)))) + (define ntp-shepherd-service (match-lambda (($ <ntp-configuration> 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> 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 <maxim.cournoyer@gmail.com> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(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") |