From 26e74f556c121f24241c3b7b7df5ae1a93d22b2d Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
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.
(<ntp-server>): New record type.
(ntp-server->string): New procedure.
(%ntp-servers): Define in terms of <htp-server> 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.
(<ntp-configuration>): 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
@@ -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{<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
@@ -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
@@ -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 <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 +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))
new file mode 100644
@@ -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")
--
2.23.0