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>
This commit is contained in:
		
							parent
							
								
									be0279ca84
								
							
						
					
					
						commit
						d67753c69e
					
				
					 2 changed files with 21 additions and 49 deletions
				
			
		| 
						 | 
				
			
			@ -486,36 +486,19 @@ daemon is responsible for allocating IP addresses to its client.")))
 | 
			
		|||
  ntp-configuration?
 | 
			
		||||
  (ntp      ntp-configuration-ntp
 | 
			
		||||
            (default ntp))
 | 
			
		||||
  (servers  %ntp-configuration-servers   ;list of <ntp-server> objects
 | 
			
		||||
  (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 config)
 | 
			
		||||
  (match-record config <ntp-configuration>
 | 
			
		||||
    (ntp servers allow-large-adjustment?)
 | 
			
		||||
    (let ((servers (ntp-configuration-servers config)))
 | 
			
		||||
      ;; TODO: Add authentication support.
 | 
			
		||||
      (define config
 | 
			
		||||
        (string-append "driftfile /var/run/ntpd/ntp.drift\n"
 | 
			
		||||
                       (string-join (map ntp-server->string servers)
 | 
			
		||||
                                    "\n")
 | 
			
		||||
                       "
 | 
			
		||||
    ;; TODO: Add authentication support.
 | 
			
		||||
    (define config
 | 
			
		||||
      (string-append "driftfile /var/run/ntpd/ntp.drift\n"
 | 
			
		||||
                     (string-join (map ntp-server->string servers) "\n")
 | 
			
		||||
                     "
 | 
			
		||||
# Disable status queries as a workaround for CVE-2013-5211:
 | 
			
		||||
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 | 
			
		||||
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.
 | 
			
		||||
restrict source notrap nomodify noquery\n"))
 | 
			
		||||
 | 
			
		||||
      (define ntpd.conf
 | 
			
		||||
        (plain-file "ntpd.conf" config))
 | 
			
		||||
    (define ntpd.conf
 | 
			
		||||
      (plain-file "ntpd.conf" config))
 | 
			
		||||
 | 
			
		||||
      (list (shepherd-service
 | 
			
		||||
             (provision '(ntpd))
 | 
			
		||||
             (documentation "Run the Network Time Protocol (NTP) daemon.")
 | 
			
		||||
             (requirement '(user-processes networking))
 | 
			
		||||
             (actions (list (shepherd-configuration-action ntpd.conf)))
 | 
			
		||||
             (start #~(make-forkexec-constructor
 | 
			
		||||
                       (list (string-append #$ntp "/bin/ntpd") "-n"
 | 
			
		||||
                             "-c" #$ntpd.conf "-u" "ntpd"
 | 
			
		||||
                             #$@(if allow-large-adjustment?
 | 
			
		||||
                                    '("-g")
 | 
			
		||||
                                    '()))
 | 
			
		||||
                       #:log-file "/var/log/ntpd.log"))
 | 
			
		||||
             (stop #~(make-kill-destructor)))))))
 | 
			
		||||
    (list (shepherd-service
 | 
			
		||||
           (provision '(ntpd))
 | 
			
		||||
           (documentation "Run the Network Time Protocol (NTP) daemon.")
 | 
			
		||||
           (requirement '(user-processes networking))
 | 
			
		||||
           (actions (list (shepherd-configuration-action ntpd.conf)))
 | 
			
		||||
           (start #~(make-forkexec-constructor
 | 
			
		||||
                     (list (string-append #$ntp "/bin/ntpd") "-n"
 | 
			
		||||
                           "-c" #$ntpd.conf "-u" "ntpd"
 | 
			
		||||
                           #$@(if allow-large-adjustment?
 | 
			
		||||
                                  '("-g")
 | 
			
		||||
                                  '()))
 | 
			
		||||
                     #:log-file "/var/log/ntpd.log"))
 | 
			
		||||
           (stop #~(make-kill-destructor))))))
 | 
			
		||||
 | 
			
		||||
(define %ntp-accounts
 | 
			
		||||
  (list (user-account
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -43,17 +43,6 @@
 | 
			
		|||
  "server some.ntp.server.org iburst version 3 maxpoll 16 prefer"
 | 
			
		||||
  (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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue