From 26e74f556c121f24241c3b7b7df5ae1a93d22b2d Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 3 Sep 2019 10:14:59 +0900 Subject: [PATCH 4/4] 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 about the now deprecated server format. (): Use it. * tests/networking.scm: Test it. * doc/guix.texi: Document it. --- doc/guix.texi | 31 ++++++++++- gnu/services/networking.scm | 100 ++++++++++++++++++++++++++++++------ tests/networking.scm | 50 ++++++++++++++++++ 3 files changed, 163 insertions(+), 18 deletions(-) create mode 100644 tests/networking.scm diff --git a/doc/guix.texi b/doc/guix.texi index 9de0957d14..e76c9322d8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12988,8 +12988,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 @@ -13005,6 +13006,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 diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 13a5c6c98d..752a165941 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,10 +73,18 @@ 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 @@ -292,31 +301,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 +389,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 +399,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)) 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") -- 2.23.0