[PATCH 2/2] services: Add tlsdate-service.

[ng0]

* gnu/services/networking.scm (<tlsdate-configuration>): New record type.
(%tlsdate-accounts): New variables.
(tlsdate-shepherd-service): New procedure.
(tlsdate-service-type): New variable.
* doc/guix.texi (Networking Services): Document it.
---
 doc/guix.texi               | 32 +++++++++++++++++
 gnu/services/networking.scm | 84 ++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 115 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4d7f96d90..f6efd040d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8594,6 +8594,38 @@ make an initial adjustment of more than 1,000 seconds.
 List of host names used as the default NTP servers.
 @end defvr
 
address@hidden tlsdate
address@hidden {Scheme Procedure} tlsdate-service [#:config 
(tlsdate-configuration)]
+
+Return a service that runs @command{tlsdate}, a simple TCP based time service.
+The daemon will synchronize the system clock with a server of your
+choice via TCP at boot.
+
+The optional @var{config} argument should be a
address@hidden<tlsdate-configuration>} object, by default it syncs the time 
with gnu.org.
+
address@hidden deffn
+
address@hidden {Data Type} tlsdate-configuration
+Data type representing the configuration of tlsdate.
+
address@hidden @asis
address@hidden @code{package} (default: @var{tlsdate})
+Package object of the tlsdate time service.
+
address@hidden @code{port} (default: @var{'()})
+Set the port of the remote hostname which should be used.
+
address@hidden @code{host} (default: @var{"gnu.org"})
+Set the remote hostname which will be queried. Defaults to @code{gnu.org}.
+
address@hidden @code{extra-options} (default: @var{'()})
+Extra options will be passed to @code{tlsdate}, please run
address@hidden tlsdate} for more information.
+
address@hidden table
address@hidden deftp
+
 @cindex Tor
 @deffn {Scheme Procedure} tor-service address@hidden [#:tor @var{tor}]
 Return a service to run the @uref{https://torproject.org, Tor} anonymous
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index d672ecf68..ab19bcb0e 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;; Copyright © 2016 Efraim Flashner <address@hidden>
 ;;; Copyright © 2016 John Darrington <address@hidden>
+;;; Copyright © 2016 ng0 <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -66,7 +67,13 @@
             wicd-service
             network-manager-service
             connman-service
-            wpa-supplicant-service-type))
+            wpa-supplicant-service-type
+
+            tlsdate-service
+            tlsdate-configuration
+            tlsdate-service-type
+            tlsdate-configuration?
+            tlsdate-configuration))
 
 ;;; Commentary:
 ;;;
@@ -360,6 +367,81 @@ make an initial adjustment of more than 1,000 seconds."
 
 
 ;;;
+;;; tlsdate
+;;;
+
+(define-record-type* <tlsdate-configuration>
+  tlsdate-configuration make-tlsdate-configuration
+  tlsdate-configuration?
+  (package        tlsdate-configuration-package
+                  (default tlsdate))
+  (host           tlsdate-configuration-host
+                  (default "gnu.org"))
+  (port           tlsdate-configuration-port
+                  (default #f))
+  (extra-options  tlsdate-configuration-extra-options
+                  (default '())))
+
+(define %tlsdate-accounts
+  (list (user-group (name "tlsdate") (system? #t))
+        (user-account
+         (name "tlsdate")
+         (group "tlsdate")
+         (system? #t)
+         (comment "tlsdate daemon user")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define tlsdate-shepherd-service
+  (match-lambda
+    (($ <tlsdate-configuration>
+        package host port extra-options)
+     (let* ((tlsdate (file-append package "/bin/tlsdate"))
+            (command `(,tlsdate
+                       "-l" ; leap
+                       "-t" ; timewarp
+                       ,@(if host
+                             `(,(string-append
+                                 "-H" " " host))
+                             '())
+                       ,@(if port
+                             `(,(string-append
+                                 "-p" " " (number->string port)))
+                             '())
+                       ,@extra-options)))
+       (list (shepherd-service
+              ;;(provision '(tlsdate))
+              (provision '(ntp))
+              ;; tlsdate needs at least one network interface to be up, hence 
the
+              ;; dependency on 'loopback'.
+              (requirement '(user-processes dbus-system loopback syslogd))
+
+              (start #~(make-forkexec-constructor '#$command
+                                                  #:user "tlsdate"
+                                                  #:group "tlsdate"))
+              (stop #~(make-kill-destructor))
+              (documentation "Run the tlsdate service.")))))))
+
+(define tlsdate-service-type
+  (service-type
+   (name 'tlsdate)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             tlsdate-shepherd-service)
+          (service-extension account-service-type
+                             (const %tlsdate-accounts))))))
+
+(define* (tlsdate-service #:key (config (tlsdate-configuration)))
+  "Return a service that runs @command{tlsdate}, a simple TCP based
+time service.
+
+The optional @var{config} argument should be a
address@hidden<tlsdate-configuration>} object, by default it querries gnu.org
+for time once at boot."
+  (service tlsdate-service-type config))
+
+
+;;;
 ;;; Tor.
 ;;;
 
-- 
2.11.0