3 files changed, 356 insertions, 0 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 6844470ce2f..6529865c090 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21594,6 +21594,95 @@ which provides the @code{networking} Shepherd service.
 @end table
 @end deftp
 
+@cindex DHCPCD, networking service
+
+@defvar dhcpcd-service-type
+This the type for a service running @command{dhcpcd}, a @acronym{DHCP,
+Dynamic Host Configuration Protocol} client that can be used as a
+replacement for the historical ISC client supported by
+@code{dhcp-client-service-type}.
+
+Its value must be a @code{dhcpcd-configuration} record, as described
+below.  As an example, consider the following setup which runs
+@command{dhcpcd} with a local @acronym{DNS, Domain Name System}
+resolver:
+
+@lisp
+(service dhcpcd-service-type
+  (dhcpcd-configuration
+    (option '("rapid_commit" "interface_mtu"))
+    (no-option '("nd_rdnss"
+                 "dhcp6_name_servers"
+                 "domain_name_servers"
+                 "domain_name"
+                 "domain_search"))
+    (static '("domain_name_servers=127.0.0.1"))
+    (no-hook '("hostname")))))
+@end lisp
+@end defvar
+
+@deftp {Data Type} dhcpcd-configuration
+Available @code{dhcpcd-configuration} fields are:
+
+@table @asis
+@item @code{interfaces} (default: @code{()}) (type: list)
+List of networking interfaces---e.g., @code{"eth0"}---to start a DHCP
+client for.  If no interface is specified (i.e., the list is empty) then
+@command{dhcpcd} discovers available Ethernet interfaces, that can be
+configured, automatically.
+
+@item @code{command-arguments} (default: @code{("-q" "-q")}) (type: list)
+List of additional command-line options.
+
+@item @code{host-name} (default: @code{""}) (type: maybe-string)
+Host name to send via DHCP, defaults to the current system host name.
+
+@item @code{duid} (default: @code{""}) (type: maybe-string)
+DHCPv4 clients require a unique client identifier, this option uses the
+DHCPv6 Unique Identifier as a DHCPv4 client identifier as well.  For
+more information, refer to @uref{https://www.rfc-editor.org/rfc/rfc4361, RFC 4361}
+and @code{dhcpcd.conf(5)}.
+
+@item @code{persistent?} (default: @code{#t}) (type: boolean)
+When true, automatically de-configure the interface when @command{dhcpcd}
+exits.
+
+@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{no-option} (default: @code{()}) (type: list-of-strings)
+List of options to remove from the message before it's processed.
+
+@item @code{no-hook} (default: @code{()}) (type: list-of-strings)
+List of hook script which should not be invoked.
+
+@item @code{static} (default: @code{()}) (type: list-of-strings)
+DHCP client can request different options from a DHCP server, through
+@code{static} it is possible to configure static values for selected
+options.  For example, @code{"domain_name_servers=127.0.0.1"}.
+
+@item @code{vendor-class-id} (type: maybe-string)
+Set the DHCP Vendor Class (e.g., @code{MSFT}).  For more information,
+refer to @uref{https://www.rfc-editor.org/rfc/rfc2132#section-9.13,RFC
+2132}.
+
+@item @code{client-id} (type: maybe-string)
+Use the interface hardware address or the given string as a client
+identifier, this is matually exclusive with the @code{duid} option.
+
+@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 53840c27642..85ad5287f26 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -109,6 +109,24 @@
             dhcpd-configuration-pid-file
             dhcpd-configuration-interfaces
 
+            dhcpcd-service-type
+            dhcpcd-configuration
+            dhcpcd-configuration?
+            dhcpcd-configuration-interfaces
+            dhcpcd-configuration-command-arguments
+            dhcpcd-configuration-host-name
+            dhcpcd-configuration-duid
+            dhcpcd-configuration-persistent?
+            dhcpcd-configuration-option
+            dhcpcd-configuration-require
+            dhcpcd-configuration-slaac
+            dhcpcd-configuration-no-option
+            dhcpcd-configuration-no-hook
+            dhcpcd-configuration-static
+            dhcpcd-configuration-vendor-class-id
+            dhcpcd-configuration-client-id
+            dhcpcd-configuration-extra-content
+
             ntp-configuration
             ntp-configuration?
             ntp-configuration-ntp
@@ -493,6 +511,149 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
 daemon is responsible for allocating IP addresses to its client.")))
 
 
+;;
+;; DHCPCD.
+;;
+
+(define (serialize-field-name field-name)
+  (let ((str (symbol->string field-name)))
+    (string-replace-substring
+      (if (string-suffix? "?" str)
+        (string-drop-right str 1)
+        str)
+      "-" "")))
+
+(define (dhcpcd-serialize-string field-name value)
+  (if (equal? field-name 'extra-content)
+      #~(string-append #$value "\n")
+      #~(format #f "~a ~a~%" #$(serialize-field-name field-name) #$value)))
+
+(define (dhcpcd-serialize-boolean field-name value)
+  (if value
+    #~(format #f "~a~%" #$(serialize-field-name 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. host-name) 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 networking interfaces---e.g., @code{\"eth0\"}---to start a DHCP client
+for.  If no interface is specified (i.e., the list is empty) then @command{dhcpcd}
+discovers available Ethernet interfaces, that can be configured, automatically."
+    empty-serializer)
+  (command-arguments
+    (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
+  (host-name
+    (maybe-string "")
+    "Host name to send via DHCP, defaults to the current system host name.")
+  (duid
+    (maybe-string "")
+    "DHCPv4 clients require a unique client identifier, this option uses the DHCPv6
+Unique Identifier as a DHCPv4 client identifier as well.  For more information, refer
+to @uref{https://www.rfc-editor.org/rfc/rfc4361, RFC 4361} and @code{dhcpcd.conf(5)}.")
+  (persistent?
+    (boolean #t)
+    "When true, automatically de-configure the interface when @command{dhcpcd} exits.")
+  (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.
+  (no-option
+    (list-of-strings '())
+    "List of options to remove from the message before it's processed.")
+  (no-hook
+    (list-of-strings '())
+    "List of hook script which should not be invoked.")
+  (static
+    (list-of-strings '())
+    "DHCP client can request different options from a DHCP server, through
+@code{static} it is possible to configure static values for selected options.  For
+example, @code{\"domain_name_servers=127.0.0.1\"}.")
+  (vendor-class-id
+    maybe-string
+    "Set the DHCP Vendor Class (e.g., @code{MSFT}).  For more information, refer
+to @uref{https://www.rfc-editor.org/rfc/rfc2132#section-9.13,RFC 2132}.")
+  (client-id
+    maybe-string
+    "Use the interface hardware address or the given string as a client identifier,
+this is matually exclusive with the @code{duid} option.")
+
+  ;; 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-arguments 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
+              #~(make-forkexec-constructor
+                    (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 e7c02b9e009..7d54ebba50e 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -32,6 +32,7 @@
   #: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 @@
             %test-inetd
             %test-openvswitch
             %test-dhcpd
+            %test-dhcpcd
             %test-tor
             %test-iptables
             %test-ipfs))
@@ -675,6 +677,110 @@ subnet 192.168.1.0 netmask 255.255.255.0 {
 
 
 ;;;
+;;; DHCPCD Daemon
+;;;
+
+(define %dhcpcd-os
+  (let ((base-os
+          (simple-operating-system
+            (service dhcpcd-service-type
+                     (dhcpcd-configuration
+                       (command-arguments '("--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
 ;;;