[bug#37295] services: ntp: Support different NTP server types and options.
diff mbox series

Message ID 8736hd1sfb.fsf@x200.i-did-not-set--mail-host-address--so-tickle-me
State New
Headers show
  • [bug#37295] services: ntp: Support different NTP server types and options.
Related show

Commit Message

Maxim Cournoyer Sept. 3, 2019, 12:21 p.m. UTC

This patch series aims at improving our NTP service.

While traveling, my date wouldn't be synchronized correctly, due to my
hardware clock (the one configurable through the BIOS) was more than
1000 s off the time queried from the NTP servers, and 'ntpd' was not
configured by default to allow an initial correction larger than 1000 s.

This patch series fixes this use case (travelling across timezones) and
further the ntp-configuration record to allow specifying different types
of NTP servers as well as their options.

diff mbox series

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

* 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

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
+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.
+ (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 @@ 
-            %ntp-servers
+            ntp-configuration-ntp
+            ntp-configuration-servers
+            ntp-allow-large-adjustment?
+            %ntp-servers
+            ntp-server
+            ntp-server-type
+            ntp-server-address
+            ntp-server-options
@@ -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      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
     (($ <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)
 # 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 -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 <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
+;;; 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")