[bug#29732] [PATCH 1/1] services: Add dhcpd-service-type and <dhcpd-configuration>.

[Chris Marusich]

* doc/guix.texi (Networking Services): Document it.
* gnu/services/networking.scm (dhcpd-service-type): Add it.
(dhcpd-configuration, dhcpd-configuration?): Add it.
(dhcpd-configuration-package): Add it.
(dhcpd-configuration-config-file): Add it.
(dhcpd-configuration-ip-version): Add it.
(dhcpd-configuration-run-directory): Add it.
(dhcpd-configuration-lease-file): Add it.
(dhcpd-configuration-pid-file): Add it.
(dhcpd-configuration-interfaces): Add it.
---
 doc/guix.texi               | 17 +++++++++++
 gnu/services/networking.scm | 72 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 89 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 64f73b38a..3b62a0578 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10357,6 +10357,23 @@ Return a service that runs @var{dhcp}, a Dynamic Host 
Configuration
 Protocol (DHCP) client, on all the non-loopback network interfaces.
 @end deffn
 
address@hidden {Scheme Procedure} dhcpd-service-type
+This type defines a DHCP daemon.  To create a service of this type, you
+must supply a @code{<dhcpd-configuration>}.  For example:
+
address@hidden
+(service dhcpd-service-type
+         (dhcpd-configuration (config-file (local-file "my-dhcpd.conf"))
+                              (interfaces '("enp2s0f0"))))
address@hidden example
+
+Here, @file{my-dhcpd.conf} is a local file that defines a valid
address@hidden configuration.  Any ``file-like'' object will do here.
+For example, you could use @code{plain-file} instead of
address@hidden if you prefer to embed the @code{dhcpd} configuration
+file in your scheme code.
address@hidden deffn
+
 @defvr {Scheme Variable} static-networking-service-type
 This is the type for statically-configured network interfaces.
 @c TODO Document <static-networking> data structures.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index b0c23aafc..d562b7011 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -55,6 +55,18 @@
             static-networking-service
             static-networking-service-type
             dhcp-client-service
+
+            dhcpd-service-type
+            dhcpd-configuration
+            dhcpd-configuration?
+            dhcpd-configuration-package
+            dhcpd-configuration-config-file
+            dhcpd-configuration-ip-version
+            dhcpd-configuration-run-directory
+            dhcpd-configuration-lease-file
+            dhcpd-configuration-pid-file
+            dhcpd-configuration-interfaces
+
             %ntp-servers
 
             ntp-configuration
@@ -338,6 +350,66 @@ to handle."
 Protocol (DHCP) client, on all the non-loopback network interfaces."
   (service dhcp-client-service-type dhcp))
 
+(define-record-type* <dhcpd-configuration> dhcpd-configuration
+  make-dhcpd-configuration
+  dhcpd-configuration?
+  (package   dhcpd-configuration-package ;<package>
+             (default isc-dhcp))
+  (config-file   dhcpd-configuration-config-file ;file-like
+                 (default #f))
+  (ip-version dhcpd-ip-version          ; either "4" or "6"
+              (default "4"))
+  (run-directory dhcpd-run-directory
+                 (default "/run/dhcpd"))
+  (lease-file dhcpd-lease-file
+              (default "/var/db/dhcpd.leases"))
+  (pid-file dhcpd-pid-file
+            (default "/run/dhcpd/dhcpd.pid"))
+  (interfaces dhcpd-interfaces ; list of strings, e.g. (list "enp0s25")
+              (default '())))
+
+(define dhcpd-shepherd-service
+  (match-lambda
+    (($ <dhcpd-configuration> package config-file ip-version _ lease-file 
pid-file interfaces)
+     (when (null-list? interfaces)
+       (error "Must specify at least one interface for DHCP daemon to use"))
+     (unless config-file
+       (error "Must supply a config-file"))
+     (list (shepherd-service
+            (provision '(dhcp-daemon))
+            (documentation "Run the DHCP daemon.")
+            (requirement '(networking))
+            (start #~(make-forkexec-constructor
+                      '(#$(file-append package "/sbin/dhcpd")
+                          #$(string-append "-" ip-version)
+                          "-lf" #$lease-file
+                          "-pf" #$pid-file
+                          "-cf" #$config-file
+                          address@hidden)
+                      #:pid-file #$pid-file))
+            (stop #~(make-kill-destructor)))))))
+
+(define dhcpd-activation
+  (match-lambda
+    (($ <dhcpd-configuration> package config-file _ run-directory lease-file _ 
_)
+     #~(begin
+         (unless (file-exists? #$run-directory)
+           (mkdir #$run-directory))
+         ;; According to the DHCP manual (man dhcpd.leases), the lease
+         ;; database must be present for dhcpd to start successfully.
+         (unless (file-exists? #$lease-file)
+           (with-output-to-file #$lease-file
+             (lambda _ (display ""))))
+         ;; Validate the config.
+         (zero? (system* #$(file-append package "/sbin/dhcpd") "-t" "-cf" 
#$config-file))))))
+
+(define dhcpd-service-type
+  (service-type
+   (name 'dhcpd)
+   (extensions
+    (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
+          (service-extension activation-service-type dhcpd-activation)))))
+
 (define %ntp-servers
   ;; Default set of NTP servers. These URLs are managed by the NTP Pool 
project.
   ;; Within Guix, Leo Famulari <address@hidden> is the administrative contact
-- 
2.15.1