diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/networking.scm | 78 | ||||
| -rw-r--r-- | gnu/tests/networking.scm | 97 |
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)))) |