rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
the now deprecated server format.
(<ntp-configuration>): Use it.
(%openntpd-servers): New variable,
(<openntpd-configuration>): 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.
This commit is contained in:
Maxim Cournoyer 2019-09-03 10:14:59 +09:00
parent ac73f504cf
commit 5658ae8a0a
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
4 changed files with 178 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -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 \

42
doc/guix.texi
View File

@ -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.

108
gnu/services/networking.scm
View File

@ -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

50
tests/networking.scm Normal file
View File

@ -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")