Package: guix-patches;
Reported by: soeren <at> soeren-tempel.net
Date: Wed, 29 Jan 2025 20:51:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: soeren <at> soeren-tempel.net To: guix-patches <at> gnu.org Cc: Quelln <at> protonmail.com, ludo <at> gnu.org Subject: [PATCH] services: networking: Add dhcpcd service. Date: Wed, 29 Jan 2025 21:45:22 +0100
From: Sören Tempel <soeren <at> soeren-tempel.net>
This is intended as an alternative to dhcp-client-service-type as
isc-dhcp has reached its end-of-life in 2022 (three years ago!),
see #68619 for more details. Long-term, this services is therefore
intended to replace dhcp-client-service-type.
* gnu/services/networking.scm (dhcpcd-service-type): New service.
(dhcpcd-shepherd-service): New procedure.
(dhcpcd-account-service): New variable.
(dhcpcd-config-file): New procedure.
(dhcpcd-configuration): New record type.
(dhcpcd-serialize-list-of-strings, dhcpcd-serialize-boolean)
(dhcpcd-serialize-string): New procedures.
* gnu/tests/networking.scm (run-dhcpcd-test): New procedure.
(%dhcpcd-os, %test-dhcpcd): New variables.
* doc/guix.texi (Networking Services): Document it.
---
Previously, an integration into the dhcp-client-service-type was
attempted. However, the discussion there established that a new
entirely separate service would be a better fit.
See https://issues.guix.gnu.org/68675 for the prior discussion.
doc/guix.texi | 57 ++++++++++++++
gnu/services/networking.scm | 147 ++++++++++++++++++++++++++++++++++++
gnu/tests/networking.scm | 106 ++++++++++++++++++++++++++
3 files changed, 310 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index b1b6d98e74..6f51d1e1f6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21468,6 +21468,63 @@ which provides the @code{networking} Shepherd service.
@end table
@end deftp
+@cindex DHCPCD, networking service
+
+@defvar dhcpcd-service-type
+This is a service which runs @var{dhcpcd}, an alternative Dynamic
+Host Configuration Protocol (DHCP) client.
+@end defvar
+
+@deftp {Data Type} dhcpcd-configuration
+Available @code{dhcpcd-configuration} fields are:
+
+@table @asis
+@item @code{interfaces} (default: @code{()}) (type: list)
+List of interfaces to start a DHCP client for.
+
+@item @code{command-args} (default: @code{("-q" "-q")}) (type: list)
+List of additional command-line options.
+
+@item @code{hostname} (default: @code{""}) (type: maybe-string)
+Hostname to send via DHCP, defaults to the current system hostname.
+
+@item @code{duid} (default: @code{""}) (type: maybe-string)
+Use and generate a DHCP Unique Identifier.
+
+@item @code{persistent} (default: @code{#t}) (type: boolean)
+Do not de-configure on shutdown.
+
+@item @code{option} (default: @code{("rapid_commit" "domain_name_servers" "domain_name" "domain_search" "host_name" "classless_static_routes" "interface_mtu")}) (type: list-of-strings)
+List of options to request from the server.
+
+@item @code{require} (default: @code{("dhcp_server_identifier")}) (type: list-of-strings)
+List of options to require in responses.
+
+@item @code{slaac} (default: @code{"private"}) (type: maybe-string)
+Interface identifier used for SLAAC generated IPv6 addresses.
+
+@item @code{nooption} (default: @code{()}) (type: list-of-strings)
+List of options to remove from the message before it's processed.
+
+@item @code{nohook} (default: @code{()}) (type: list-of-strings)
+List of hook script which should not be invoked.
+
+@item @code{static} (default: @code{()}) (type: list-of-strings)
+Configure a static value (e.g. ip_address).
+
+@item @code{vendorclassid} (type: maybe-string)
+Set the DHCP Vendor Class.
+
+@item @code{clientid} (type: maybe-string)
+Use the interface hardware address or the given string as a Client ID.
+
+@item @code{extra-content} (type: maybe-string)
+Extra content to append to the configuration as-is.
+
+@end table
+@end deftp
+
+
@cindex NetworkManager
@defvar network-manager-service-type
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index af28bd0626..c97d50eccf 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -108,6 +108,24 @@ (define-module (gnu services networking)
dhcpd-configuration-pid-file
dhcpd-configuration-interfaces
+ dhcpcd-service-type
+ dhcpcd-configuration
+ dhcpcd-configuration?
+ dhcpcd-configuration-interfaces
+ dhcpcd-configuration-command-args
+ dhcpcd-configuration-hostname
+ dhcpcd-configuration-duid
+ dhcpcd-configuration-persistent
+ dhcpcd-configuration-option
+ dhcpcd-configuration-require
+ dhcpcd-configuration-slaac
+ dhcpcd-configuration-nooption
+ dhcpcd-configuration-nohook
+ dhcpcd-configuration-static
+ dhcpcd-configuration-vendorclassid
+ dhcpcd-configuration-clientid
+ dhcpcd-configuration-extra-content
+
ntp-configuration
ntp-configuration?
ntp-configuration-ntp
@@ -491,6 +509,135 @@ (define dhcpd-service-type
(description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The
daemon is responsible for allocating IP addresses to its client.")))
+
+;;
+;; DHCPCD.
+;;
+
+(define (dhcpcd-serialize-string field-name value)
+ (let ((field (object->string field-name)))
+ (if (string=? field "extra-content")
+ #~(string-append #$value "\n")
+ #~(format #f "~a ~a~%" #$field #$value))))
+
+(define (dhcpcd-serialize-boolean field-name value)
+ (if value
+ #~(format #f "~a~%" #$(object->string field-name))
+ ""))
+
+(define (dhcpcd-serialize-list-of-strings field-name value)
+ #~(string-append #$@(map (cut dhcpcd-serialize-string field-name <>) value)))
+
+;; Some fields (e.g. hostname) can be specified with an empty string argument.
+;; Therefore, we need a maybe type to differentiate disabled/empty-string.
+(define-maybe string (prefix dhcpcd-))
+
+(define-configuration dhcpcd-configuration
+ (interfaces
+ (list '())
+ "List of interfaces to start a DHCP client for."
+ empty-serializer)
+ (command-args
+ (list '("-q" "-q"))
+ "List of additional command-line options."
+ empty-serializer)
+
+ ;; The following defaults replicate the default dhcpcd configuration file.
+ ;;
+ ;; See https://github.com/NetworkConfiguration/dhcpcd/tree/v10.0.10#configuration
+ (hostname
+ (maybe-string "")
+ "Hostname to send via DHCP, defaults to the current system hostname.")
+ (duid
+ (maybe-string "")
+ "Use and generate a DHCP Unique Identifier.")
+ (persistent
+ (boolean #t)
+ "Do not de-configure on shutdown.")
+ (option
+ (list-of-strings
+ '("rapid_commit"
+ "domain_name_servers"
+ "domain_name"
+ "domain_search"
+ "host_name"
+ "classless_static_routes"
+ "interface_mtu"))
+ "List of options to request from the server.")
+ (require
+ (list-of-strings '("dhcp_server_identifier"))
+ "List of options to require in responses.")
+ (slaac
+ (maybe-string "private")
+ "Interface identifier used for SLAAC generated IPv6 addresses.")
+
+ ;; Common options not set in the default configuration file.
+ (nooption
+ (list-of-strings '())
+ "List of options to remove from the message before it's processed.")
+ (nohook
+ (list-of-strings '())
+ "List of hook script which should not be invoked.")
+ (static
+ (list-of-strings '())
+ "Configure a static value (e.g. ip_address).")
+ (vendorclassid
+ maybe-string
+ "Set the DHCP Vendor Class.")
+ (clientid
+ maybe-string
+ "Use the interface hardware address or the given string as a Client ID.")
+
+ ;; Escape hatch for the generated configuration file.
+ (extra-content
+ maybe-string
+ "Extra content to append to the configuration as-is.")
+
+ (prefix dhcpcd-))
+
+(define (dhcpcd-config-file config)
+ (mixed-text-file "dhcpcd.conf"
+ (serialize-configuration
+ config
+ dhcpcd-configuration-fields)))
+
+(define dhcpcd-account-service
+ (list (user-group (name "dhcpcd") (system? #t))
+ (user-account
+ (name "dhcpcd")
+ (group "dhcpcd")
+ (system? #t)
+ (comment "dhcpcd daemon user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define (dhcpcd-shepherd-service config)
+ (let* ((config-file (dhcpcd-config-file config))
+ (command-args (dhcpcd-configuration-command-args config))
+ (ifaces (dhcpcd-configuration-interfaces config)))
+ (list (shepherd-service
+ (documentation "dhcpcd daemon.")
+ (provision '(networking))
+ (requirement '(user-processes udev))
+ (actions (list (shepherd-configuration-action config-file)))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list (string-append #$dhcpcd "/sbin/dhcpcd")
+ #$@command-args "-B" "-f" #$config-file #$@ifaces))))
+ (stop #~(make-kill-destructor))))))
+
+(define dhcpcd-service-type
+ (service-type (name 'dhcpcd)
+ (description "Run the dhcpcd daemon.")
+ (extensions
+ (list (service-extension account-service-type
+ (const dhcpcd-account-service))
+ (service-extension shepherd-root-service-type
+ dhcpcd-shepherd-service)))
+ (compose concatenate)
+ (default-value (dhcpcd-configuration))))
+
;;;
;;; NTP.
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index e7c02b9e00..720f123953 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -32,6 +32,7 @@ (define-module (gnu tests networking)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix modules)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages networking)
@@ -44,6 +45,7 @@ (define-module (gnu tests networking)
%test-inetd
%test-openvswitch
%test-dhcpd
+ %test-dhcpcd
%test-tor
%test-iptables
%test-ipfs))
@@ -673,6 +675,110 @@ (define %test-dhcpd
(description "Test a running DHCP daemon configuration.")
(value (run-dhcpd-test))))
+
+;;;
+;;; DHCPCD Daemon
+;;;
+
+(define %dhcpcd-os
+ (let ((base-os
+ (simple-operating-system
+ (service dhcpcd-service-type
+ (dhcpcd-configuration
+ (command-args '("--debug" "--logfile" "/dev/console"))
+ (interfaces '("ens3")))))))
+ (operating-system
+ (inherit base-os)
+ (packages
+ (append (list dhcpcd iproute)
+ (operating-system-packages base-os))))))
+
+(define (run-dhcpcd-test)
+ "Run tests in %dhcpcd-os with a running dhcpcd daemon on localhost."
+ (define os
+ (marionette-operating-system
+ %dhcpcd-os
+ #:imported-modules '((gnu services herd))))
+
+ (define vm
+ (virtual-machine os))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-64)
+ (gnu build marionette))
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (define (wait-for-lease)
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen) (ice-9 rdelim))
+
+ (let loop ((i 15))
+ (if (> i 0)
+ (let* ((port (open-input-pipe "dhcpcd --dumplease ens3"))
+ (output (read-string port)))
+ (close-port port)
+ (unless (string-contains output "reason=BOUND")
+ (sleep 1)
+ (loop (- i 1))))
+ (error "failed to obtain a DHCP lease"))))
+ marionette))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "dhcpcd")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ ;; Make sure the 'dhcpcd' command is found.
+ (setenv "PATH" "/run/current-system/profile/sbin")
+
+ (wait-for-service 'networking))
+ marionette))
+
+ (test-assert "IPC socket exists"
+ (marionette-eval
+ '(file-exists? "/var/run/dhcpcd/ens3.sock")
+ marionette))
+
+ (test-equal "IPC is functional"
+ 0
+ (marionette-eval
+ '(status:exit-val
+ (system* "dhcpcd" "--dumplease" "ens3"))
+ marionette))
+
+ (test-equal "aquires IPv4 address via DHCP"
+ 1
+ (and
+ (wait-for-lease)
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen) (ice-9 rdelim))
+
+ (let* ((port (open-input-pipe "ip -4 address show dev ens3"))
+ (lines (string-split (read-string port) #\newline)))
+ (close-port port)
+ (length
+ (filter (lambda (line)
+ (string-contains line "scope global dynamic"))
+ lines))))
+ marionette)))
+
+ (test-end))))
+ (gexp->derivation "dhcpcd-test" test))
+
+(define %test-dhcpcd
+ (system-test
+ (name "dhcpcd")
+ (description "Test that the dhcpcd obtains IP DHCP leases.")
+ (value (run-dhcpcd-test))))
+
;;;
;;; Services related to Tor
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.