me
/
guix
Archived
1
0
Fork 0
Code

services: ntp-service-type: Remove deprecated server as strings support. 

* gnu/services/networking.scm (<ntp-configuration>)[servers]: Rename accessor to ntp-configuration-servers.
(ntp-configuration-servers): Remove helper procedure.
(ntp-shepherd-service): Remove helper procedure usage.
* tests/networking.scm: Remove obsolete test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
master
Bruno Victal 2023-02-27 00:11:36 +00:00 committed by Ludovic Courtès
parent 0425c91a92
commit b92880d011
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
gnu/services/networking.scm
View File

@ -486,36 +486,19 @@ daemon is responsible for allocating IP addresses to its client.")))
ntp-configuration? ntp-configuration?
(ntp ntp-configuration-ntp (ntp ntp-configuration-ntp
(default ntp)) (default ntp))
(servers %ntp-configuration-servers ;list of <ntp-server> objects (servers ntp-configuration-servers ;list of <ntp-server> objects
(default %ntp-servers)) (default %ntp-servers))
(allow-large-adjustment? ntp-allow-large-adjustment? (allow-large-adjustment? ntp-allow-large-adjustment?
(default #t))) ;as recommended in the ntpd manual (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 config) (define (ntp-shepherd-service config)
(match-record config <ntp-configuration> (match-record config <ntp-configuration>
(ntp servers allow-large-adjustment?) (ntp servers allow-large-adjustment?)
(let ((servers (ntp-configuration-servers config))) ;; TODO: Add authentication support.
;; TODO: Add authentication support. (define config
(define config (string-append "driftfile /var/run/ntpd/ntp.drift\n"
(string-append "driftfile /var/run/ntpd/ntp.drift\n" (string-join (map ntp-server->string servers) "\n")
(string-join (map ntp-server->string servers) "
"\n")
"
# Disable status queries as a workaround for CVE-2013-5211: # Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>. # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
restrict default kod nomodify notrap nopeer noquery limited restrict default kod nomodify notrap nopeer noquery limited
@ -529,22 +512,22 @@ restrict -6 ::1
# option by default, as documented in the 'ntp.conf' manual. # option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n")) restrict source notrap nomodify noquery\n"))
(define ntpd.conf (define ntpd.conf
(plain-file "ntpd.conf" config)) (plain-file "ntpd.conf" config))
(list (shepherd-service (list (shepherd-service
(provision '(ntpd)) (provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.") (documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking)) (requirement '(user-processes networking))
(actions (list (shepherd-configuration-action ntpd.conf))) (actions (list (shepherd-configuration-action ntpd.conf)))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$ntp "/bin/ntpd") "-n" (list (string-append #$ntp "/bin/ntpd") "-n"
"-c" #$ntpd.conf "-u" "ntpd" "-c" #$ntpd.conf "-u" "ntpd"
#$@(if allow-large-adjustment? #$@(if allow-large-adjustment?
'("-g") '("-g")
'())) '()))
#:log-file "/var/log/ntpd.log")) #:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor))))))
(define %ntp-accounts (define %ntp-accounts
(list (user-account (list (user-account

11
tests/networking.scm
View File

@ -43,17 +43,6 @@
"server some.ntp.server.org iburst version 3 maxpoll 16 prefer" "server some.ntp.server.org iburst version 3 maxpoll 16 prefer"
(ntp-server->string %ntp-server-sample)) (ntp-server->string %ntp-server-sample))
(test-equal "ntp configuration servers deprecated form"
(ntp-configuration-servers
(ntp-configuration
(servers (list "example.pool.ntp.org"))))
(ntp-configuration-servers
(ntp-configuration
(servers (list (ntp-server
(type 'server)
(address "example.pool.ntp.org")
(options '())))))))
;;; ;;;
;;; OpenNTPD ;;; OpenNTPD