From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Fri, 1 Nov 2019 03:20:22 +0000 (-0400)
Subject: services: ntp: Fix a crash when using legacy configuration.
X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/commitdiff_plain/f37ad658eada78384764c7d6db3a7f3ad8ad283e

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

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 841fbd741e..a1c1aad9f6 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