[bug#29483] [PATCH] services: Add openntpd service.

[Efraim Flashner <efraim@flashner.co.il>]

[-- Attachment #1.1: Type: text/plain, Size: 2417 bytes --]

On Mon, Feb 05, 2018 at 04:26:52PM +0100, Ludovic Courtès wrote:
> Heya Efraim,
> 
> > +(define openntpd-shepherd-service
> > +  (match-lambda
> > +    (($ <openntpd-configuration> openntpd openntpd-listen-on
> > +        openntpd-query-from openntpd-sensor openntpd-server
> > +        openntpd-servers openntpd-constraint-from
> > +        openntpd-constraints-from allow-large-adjustment?)
> 
> This is error prone (you could be matching the wrong fields), could you
> change that to ‘match-record’?
> 

I think this is the only thing left over. I compared my fields to
murmur, and for murmur we're looking at true/false or a single value.
Other than 'openntpd' and 'allow-large-adjustment?' each are lists
because they can all be lists, and I didn't want to make the logic phase
of generating the config file to be immensely long.

currently:

(match-lambda
  (($ <openntpd-configuration> openntpd openntpd-listen-on
      openntpd-query-from openntpd-sensor openntpd-server
      openntpd-servers openntpd-constraint-from
      openntpd-constraints-from allow-large-adjustment?)
   (let ()
     (define config
       (string-join
         (filter-map (lambda (field value)
                (string-join
                  (map (cut string-append field <> "\n")
                       value)))
              '("listen on " "query from " "sensor " "server " "servers "
                "constraint from ")
              (list openntpd-listen-on openntpd-query-from openntpd-sensor
                    openntpd-server openntpd-servers openntpd-constraint-from))
         ;; The 'constraints from' field needs to be enclosed in double quotes.
         (string-join
           (map (cut string-append "constraints from \"" <> "\"\n")
                openntpd-constraints-from))))

Other wise I suppose I'd be looking more at [the following] for most fields:

(match-record
...
  (if (not (null-list? openntpd-listen-on))
    (lambda (value)
      (string-append "listen on " value "\n")
     value)
     '())
...

currently to use the defaults I have
  (service openntpd-service-type (openntpd-configuration))
which obviously isn't ideal.
    

-- 
Efraim Flashner   <efraim@flashner.co.il>   אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted

[-- Attachment #1.2: 0001-services-Add-openntpd-service.patch --]
[-- Type: text/plain, Size: 11277 bytes --]

From 7db57baceadf509407068cd969d24f107ee8a027 Mon Sep 17 00:00:00 2001
From: Efraim Flashner <efraim@flashner.co.il>
Date: Tue, 28 Nov 2017 10:19:11 +0200
Subject: [PATCH] services: Add openntpd service.

* gnu/packages/ntp.scm (openntpd)[arguments]: Add 'configure-flags to
set openntpd daemon's user and localstatedir. Add a custom phase to not
try to create said directory at install time.
* gnu/services/networking.scm (<openntpd-configuration>): New record type.
(openntpd-shepherd-service, openntpd-service-activation): New procedures.
(openntpd-service-type): New variable.
* doc/guix.texi (Networking Services): Add openntpd documentation.
---
 doc/guix.texi               | 55 ++++++++++++++++++++++++-
 gnu/packages/ntp.scm        | 13 +++++-
 gnu/services/networking.scm | 98 ++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 163 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f9d7e13e2..100b23215 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24,7 +24,7 @@ Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
 Copyright @copyright{} 2016, 2017 Chris Marusich@*
-Copyright @copyright{} 2016, 2017 Efraim Flashner@*
+Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@*
 Copyright @copyright{} 2016 John Darrington@*
 Copyright @copyright{} 2016, 2017 ng0@*
 Copyright @copyright{} 2016, 2017 Jan Nieuwenhuizen@*
@@ -10718,6 +10718,59 @@ make an initial adjustment of more than 1,000 seconds.
 List of host names used as the default NTP servers.
 @end defvr
 
+@cindex OpenNTPD
+@deffn {Scheme Procedure} openntpd-service-type
+Run the @command{ntpd}, the Network Time Protocol (NTP) daemon, as implemented
+by @uref{http://www.openntpd.org, OpenNTPD}.  The daemon will keep the system
+clock synchronized with that of the given servers.
+
+@example
+(service
+ openntpd-service-type
+ (openntpd-configuration
+  (listen-on '("127.0.0.1" "::1"))
+  (sensor '("udcf0 correction 70000"))
+  (constraint-from '("www.gnu.org"))
+  (constraints-from '("https://www.google.com/"))
+  (allow-large-adjustment? #t)))
+
+@end example
+@end deffn
+
+@deftp {Data Type} openntpd-configuration
+@table @asis
+@item @code{openntpd} (default: @code{(file-append openntpd "/sbin/ntpd")})
+The openntpd executable to use.
+@item @code{listen-on} (default: @code{'("127.0.0.1" "::1")})
+A list of local IP addresses or hostnames the ntpd daemon should listen on.
+@item @code{query-from} (default: @code{'()})
+A list of local IP address the ntpd daemon should use for outgoing queries.
+@item @code{sensor} (default: @code{'()})
+Specify a list of timedelta sensor devices ntpd should use.  @code{ntpd}
+will listen to each sensor that acutally exists and ignore non-existant ones.
+See @uref{https://man.openbsd.org/ntpd.conf, upstream documentation} for more
+information.
+@item @code{server} (default: @var{%ntp-servers})
+Specify a list of IP addresses or hostnames of NTP servers to synchronize to.
+@item @code{servers} (default: @code{'()})
+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.
+This time information is not used for precision but acts as an authenticated
+constraint, thereby reducing the impact of unauthenticated NTP
+man-in-the-middle attacks.
+Specify a list of URLs, IP addresses or hostnames of HTTPS servers to provide
+a constraint.
+@item @code{constraints-from} (default: @code{'()})
+As with constraint from, specify a list of URLs, IP addresses or hostnames of
+HTTPS servers to provide a constraint.  Should the hostname resolve to multiple
+IP addresses, @code{ntpd} will calculate a median constraint from all of them.
+@item @code{allow-large-adjustment?} (default: @code{#f})
+Determines if @code{ntpd} is allowed to make an initial adjustment of more
+than 180 seconds.
+@end table
+@end deftp
+
 @cindex inetd
 @deffn {Scheme variable} inetd-service-type
 This service runs the @command{inetd} (@pxref{inetd invocation,,,
diff --git a/gnu/packages/ntp.scm b/gnu/packages/ntp.scm
index d270f513d..1c3b8cd31 100644
--- a/gnu/packages/ntp.scm
+++ b/gnu/packages/ntp.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -107,6 +107,17 @@ computers over a network.")
                (base32
                 "0fn12i4kzsi0zkr4qp3dp9bycmirnfapajqvdfx02zhr4hanj0kv"))))
     (build-system gnu-build-system)
+    (arguments
+     '(#:configure-flags '("--with-privsep-user=ntpd"
+                           "--localstatedir=/var")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'modify-install-locations
+           (lambda _
+             ;; Don't try to create /var/run or /var/db
+             (substitute* "src/Makefile.in"
+               (("DESTDIR\\)\\$\\(localstatedir") "TMPDIR"))
+             #t)))))
     (inputs
      `(("libressl" ,libressl))) ; enable TLS time constraints. See ntpd.conf(5).
     (home-page "http://www.openntpd.org/")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 5ba3c5eed..c59ff85bc 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
@@ -64,6 +64,10 @@
             ntp-service
             ntp-service-type
 
+            openntpd-configuration
+            openntpd-configuration?
+            openntpd-service-type
+
             inetd-configuration
             inetd-entry
             inetd-service-type
@@ -446,6 +450,98 @@ make an initial adjustment of more than 1,000 seconds."
                               (allow-large-adjustment?
                                allow-large-adjustment?))))
 
+(define-record-type* <openntpd-configuration>
+  openntpd-configuration make-openntpd-configuration
+  openntpd-configuration?
+  (openntpd                openntpd-configuration-openntpd
+                           (default openntpd))
+  (listen-on               openntpd-listen-on
+                           (default '("127.0.0.1"
+                                      "::1")))
+  (query-from              openntpd-query-from
+                           (default '()))
+  (sensor                  openntpd-sensor
+                           (default '()))
+  (server                  openntpd-server
+                           (default %ntp-servers))
+  (servers                 openntpd-servers
+                           (default '()))
+  (constraint-from         openntpd-constraint-from
+                           (default '()))
+  (constraints-from        openntpd-constriants-from
+                           (default '()))
+  (allow-large-adjustment? openntpd-allow-large-adjustment?
+                           (default #f))) ; upstream default
+
+(define openntpd-shepherd-service
+  (match-lambda
+    (($ <openntpd-configuration> openntpd openntpd-listen-on
+        openntpd-query-from openntpd-sensor openntpd-server
+        openntpd-servers openntpd-constraint-from
+        openntpd-constraints-from allow-large-adjustment?)
+     (let ()
+       (define config
+         (string-join
+           (filter-map (lambda (field value)
+                  (string-join
+                    (map (cut string-append field <> "\n")
+                         value)))
+                '("listen on " "query from " "sensor " "server " "servers "
+                  "constraint from ")
+                (list openntpd-listen-on openntpd-query-from openntpd-sensor
+                      openntpd-server openntpd-servers openntpd-constraint-from))
+           ;; The 'constraints from' field needs to be enclosed in double quotes.
+           (string-join
+             (map (cut string-append "constraints from \"" <> "\"\n")
+                  openntpd-constraints-from))))
+
+       (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 #$openntpd "/sbin/ntpd")
+                              "-f" #$ntpd.conf
+                              "-d" ;; don't daemonize
+                              #$@(if allow-large-adjustment?
+                                     '("-s")
+                                     '()))
+                        ;; When ntpd is daemonized it repeatedly tries to respawn
+                        ;; while running, leading shepherd to disable it.  To
+                        ;; prevent spamming stderr, redirect output to logfile.
+                        #:log-file "/var/log/ntpd"))
+              (stop #~(make-kill-destructor))))))))
+
+(define (openntpd-service-activation config)
+  "Return the activation gexp for CONFIG."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (mkdir-p "/var/db")
+        (mkdir-p "/var/run")
+        (unless (file-exists? "/var/db/ntpd.drift")
+          (with-output-to-file "/var/db/ntpd.drift"
+                               (lambda _
+                                 (format #t "0.0")))))))
+
+(define openntpd-service-type
+  (service-type (name 'openntpd)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          openntpd-shepherd-service)
+                       (service-extension account-service-type
+                                          (const %ntp-accounts))
+                       (service-extension activation-service-type
+                                          openntpd-service-activation)))
+                (description
+                 "Run the @command{ntpd}, the Network Time Protocol (NTP)
+daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}.  The
+daemon will keep the system clock synchronized with that of the given servers.")))
+
 \f
 ;;;
 ;;; Inetd.
-- 
2.16.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]