aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/networking.scm78
-rw-r--r--gnu/tests/networking.scm97
2 files changed, 174 insertions, 1 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 6ac440fd26..be34f32395 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,72 @@ 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)
+ (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 d7d9166fa7..171c636e5f 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))))
+
+
+;;;
+;;; 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))))