From 5dd2e6853f1a332e55f3a4ba69b9baf199458fcb Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sat, 16 Dec 2017 00:52:42 -0800 Subject: [PATCH] services: Add dhcpd-service-type and . * 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 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{}. 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 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 make-dhcpd-configuration + dhcpd-configuration? + (package dhcpd-configuration-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 + (($ 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 + address@hidden) + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define dhcpd-activation + (match-lambda + (($ 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 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)))) + + +;;; +;;; 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