01/01: services: ntp: Fix a crash when using legacy configuration.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit f37ad658eada78384764c7d6db3a7f3ad8ad283e
Author: Maxim Cournoyer <address@hidden>
Date:   Thu Oct 31 23:20:22 2019 -0400

    services: ntp: Fix a crash when using legacy configuration.
    
    Fixes issue #37504 (see: https://bugs.gnu.org/37504).
    
    The bug was caused by the fact that destructuring an <ntp-configuration>
    record using match would bind the 'servers' field without using the
    compatibility accessor.
    
    * gnu/services/networking.scm (ntp-shepherd-service): Replace `match-lambda'
    by distinct `lambda' and `match' calls, so that the 'servers' field can be
    generated by applying the `ntp-configuration-servers' procedure to the
    configuration object.
---
 gnu/services/networking.scm | 45 +++++++++++++++++++++++----------------------
 1 file changed, 23 insertions(+), 22 deletions(-)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 841fbd7..a1c1aad 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -394,15 +394,16 @@ deprecated.  Please use <ntp-server> records instead.\n")
        ntp-servers))))
 
 (define ntp-shepherd-service
-  (match-lambda
-    (($ <ntp-configuration> ntp servers allow-large-adjustment?)
-     (let ()
-       ;; TODO: Add authentication support.
-       (define config
-         (string-append "driftfile /var/run/ntpd/ntp.drift\n"
-                        (string-join (map ntp-server->string servers)
-                                     "\n")
-                        "
+  (lambda (config)
+    (match 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")
+                          "
 # 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
@@ -416,20 +417,20 @@ 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))
-              (start #~(make-forkexec-constructor
-                        (list (string-append #$ntp "/bin/ntpd") "-n"
-                              "-c" #$ntpd.conf "-u" "ntpd"
-                              #$@(if allow-large-adjustment?
-                                     '("-g")
-                                     '()))))
-              (stop #~(make-kill-destructor))))))))
+         (list (shepherd-service
+                (provision '(ntpd))
+                (documentation "Run the Network Time Protocol (NTP) daemon.")
+                (requirement '(user-processes networking))
+                (start #~(make-forkexec-constructor
+                          (list (string-append #$ntp "/bin/ntpd") "-n"
+                                "-c" #$ntpd.conf "-u" "ntpd"
+                                #$@(if allow-large-adjustment?
+                                       '("-g")
+                                       '()))))
+                (stop #~(make-kill-destructor)))))))))
 
 (define %ntp-accounts
   (list (user-account