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

[Chris Marusich <cmmarusich@gmail.com>]

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


Hi Clément and Ludo!

Here's a new patch.  It mainly tidies up some formatting, makes it
possible to run more than one version of the DHCP daemon at the same
time (e.g., for IPv4, IPv6, and IPv4 over IPv6), and adds a system test
to verify that the DHCPv4 daemon can start up without error.

I tried adding a test case for DHCPv6, but I ran into complications.
Specifically, I'm not sure how to give an IPv6 address and subnet to the
eth0 interface within the test VM using the static-networking-service.
The DHCPv6 daemon requires the interface to have an IPv6 subnet
configured, so it refuses to run on that interface.

For now, it's nice enough, I think, that we have a DHCPv4 system test!
Please let me know what you think.

-- 
Chris

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-services-Add-dhcpd-service-type-and-dhcpd-configurat.patch --]
[-- Type: text/x-patch, Size: 9924 bytes --]

From 5dd2e6853f1a332e55f3a4ba69b9baf199458fcb Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sat, 16 Dec 2017 00:52:42 -0800
Subject: [PATCH] services: Add dhcpd-service-type and <dhcpd-configuration>.

* 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-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 | 80 ++++++++++++++++++++++++++++++
 gnu/tests/networking.scm    | 97 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 193 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index d825f39e0..1875fb80a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10694,6 +10694,23 @@ Return a service that runs @var{dhcp}, a Dynamic Host Configuration
 Protocol (DHCP) client, on all the non-loopback network interfaces.
 @end deffn
 
+@deffn {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:
+
+@example
+(service dhcpd-service-type
+         (dhcpd-configuration (config-file (local-file "my-dhcpd.conf"))
+                              (interfaces '("enp2s0f0"))))
+@end example
+
+Here, @file{my-dhcpd.conf} is a local file that defines a valid
+@command{dhcpd} configuration.  Any ``file-like'' object will do here.
+For example, you could use @code{plain-file} instead of
+@code{local-file} if you prefer to embed the @code{dhcpd} configuration
+file in your scheme code.
+@end 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 6ac440fd2..7eb031861 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -57,6 +57,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-version
+            dhcpd-configuration-run-directory
+            dhcpd-configuration-lease-file
+            dhcpd-configuration-pid-file
+            dhcpd-configuration-interfaces
+
             %ntp-servers
 
             ntp-configuration
@@ -341,6 +353,74 @@ 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))
+  (version dhcpd-configuration-version ;"4", "6", or "4o6"
+              (default "6"))
+  (run-directory dhcpd-configuration-run-directory
+                 (default "/run/dhcpd"))
+  (lease-file dhcpd-configuration-lease-file
+              (default "/var/db/dhcpd.leases"))
+  (pid-file dhcpd-configuration-pid-file
+            (default "/run/dhcpd/dhcpd.pid"))
+  ;; list of strings, e.g. (list "enp0s25")
+  (interfaces dhcpd-configuration-interfaces
+              (default '())))
+
+(define dhcpd-shepherd-service
+  (match-lambda
+    (($ <dhcpd-configuration> package config-file version run-directory
+                              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
+            ;; Allow users to easily run multiple versions simultaneously.
+            (provision (list (string->symbol
+                              (string-append "dhcpv" version "-daemon"))))
+            (documentation (string-append "Run the DHCPv" version " daemon"))
+            (requirement '(networking))
+            (start #~(make-forkexec-constructor
+                      '(#$(file-append package "/sbin/dhcpd")
+                        #$(string-append "-" version)
+                        "-lf" #$lease-file
+                        "-pf" #$pid-file
+                        "-cf" #$config-file
+                        #$@interfaces)
+                      #:pid-file #$pid-file))
+            (stop #~(make-kill-destructor)))))))
+
+(define dhcpd-activation
+  (match-lambda
+    (($ <dhcpd-configuration> package config-file version run-directory
+                              lease-file pid-file interfaces)
+     (with-imported-modules '((guix build utils))
+       #~(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.
+           (invoke
+            #$(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 <leo@famulari.name> is the administrative contact
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index d7d9166fa..171c636e5 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -29,7 +29,7 @@
   #:use-module (gnu packages bash)
   #:use-module (gnu packages networking)
   #:use-module (gnu services shepherd)
-  #:export (%test-inetd %test-openvswitch))
+  #:export (%test-inetd %test-openvswitch %test-dhcpd))
 
 (define %inetd-os
   ;; Operating system with 2 inetd services.
@@ -243,3 +243,98 @@ port 7, and a dict service on port 2628."
    (name "openvswitch")
    (description "Test a running OpenvSwitch configuration.")
    (value (run-openvswitch-test))))
+
+\f
+;;;
+;;; DHCP Daemon
+;;;
+
+(define minimal-dhcpd-v4-config-file
+  (plain-file "dhcpd.conf"
+              "\
+default-lease-time 600;
+max-lease-time 7200;
+
+subnet 192.168.1.0 netmask 255.255.255.0 {
+ range 192.168.1.100 192.168.1.200;
+ option routers 192.168.1.1;
+ option domain-name-servers 192.168.1.2, 192.168.1.3;
+ option domain-name \"dummy.domain.name.abc123xyz\";
+}
+"))
+
+(define dhcpd-v4-configuration
+  (dhcpd-configuration
+   (config-file minimal-dhcpd-v4-config-file)
+   (version "4")
+   (interfaces '("eth0"))))
+
+(define %dhcpd-os
+  (simple-operating-system
+   (static-networking-service "eth0" "192.168.1.4"
+                              #:netmask "255.255.255.0"
+                              #:gateway "192.168.1.1"
+                              #:name-servers '("192.168.1.2" "192.168.1.3"))
+   (service dhcpd-service-type dhcpd-v4-configuration)))
+
+(define (run-dhcpd-test)
+  (define os
+    (marionette-operating-system %dhcpd-os
+                                 #:imported-modules '((gnu services herd))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (ice-9 popen)
+                       (ice-9 rdelim)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "dhcpd")
+
+          (test-assert "pid file exists"
+            (marionette-eval
+             '(file-exists?
+               #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
+             marionette))
+
+          (test-assert "lease file exists"
+            (marionette-eval
+             '(file-exists?
+               #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
+             marionette))
+
+          (test-assert "run directory exists"
+            (marionette-eval
+             '(file-exists?
+               #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
+             marionette))
+
+          (test-assert "dhcpd is alive"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd)
+                             (srfi srfi-1))
+                (live-service-running
+                 (find (lambda (live)
+                         (memq 'dhcpv4-daemon
+                               (live-service-provision live)))
+                       (current-services))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "dhcpd-test" test))
+
+(define %test-dhcpd
+  (system-test
+   (name "dhcpd")
+   (description "Test a running DHCP daemon configuration.")
+   (value (run-dhcpd-test))))
-- 
2.17.0


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