GNU bug report logs - #68675
[PATCH] Support dhcpcd in dhcp-client-service-type

Previous Next

Full log

View this message in rfc822 format

From: soeren <at> soeren-tempel.net
To: 68675 <at> debbugs.gnu.org
Subject: [bug#68675] [PATCH v3 2/2] services: dhcp: Support the dhcpcd implementation.
Date: Tue, 13 Feb 2024 13:50:43 +0100

From: Sören Tempel <soeren <at> soeren-tempel.net>

Prior to this commit, the isc-dhcp implementation was the only DHCP
implementation supported by dhcp-client-shepherd-service. This is
problematic as the ISC implementation has reached end-of-life in
2022(!). As a first step to migrate away from isc-dhcp, this commit
adds support for dhcpcd to dhcp-client-shepherd-service. Currently,
it has to be enabled explicitly via the package field of the
dhcp-client-configuration. In the future, it is intended to become
the default to migrate away from isc-dhcp.

While at it, also remove isc-dhcp from %base-packages as it is no
longer necessarily needed and it will be pulled in by the DHCP
client service if required.

See also: https://issues.guix.gnu.org/68619

* gnu/services/networking.scm (dhcp-client-shepherd-service): Add
  support for the dhcpcd client implementation.
* gnu/services/networking.scm (dhcp-client-account-service): New
  procedure.
* gnu/services/networking.scm (dhcp-client-service-type): Add optional
  account-service-type extensions (needed for dhcpcd).
* gnu/system.scm (%base-packages-networking): Remove isc-dhcp from
  %base-packages (will be pulled in by dhcp-client-shepherd-service).

Signed-off-by: Sören Tempel <soeren <at> soeren-tempel.net>
---
 gnu/services/networking.scm | 92 +++++++++++++++++++++++++++----------
 1 file changed, 67 insertions(+), 25 deletions(-)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 495d049728..4e058e1880 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -316,25 +316,21 @@ (define-record-type* <dhcp-client-configuration>
 (define dhcp-client-shepherd-service
   (match-lambda
     ((? dhcp-client-configuration? config)
-     (let ((package (dhcp-client-configuration-package config))
-           (requirement (dhcp-client-configuration-shepherd-requirement config))
-           (provision (dhcp-client-configuration-shepherd-provision config))
-           (interfaces (dhcp-client-configuration-interfaces config))
-           (pid-file "/var/run/dhclient.pid"))
+     (let* ((package (dhcp-client-configuration-package config))
+            (client-name (package-name package))
+            (requirement (dhcp-client-configuration-shepherd-requirement config))
+            (provision (dhcp-client-configuration-shepherd-provision config))
+            (interfaces (dhcp-client-configuration-interfaces config)))
        (list (shepherd-service
               (documentation "Set up networking via DHCP.")
               (requirement `(user-processes udev ,@requirement))
               (provision provision)
+              (modules `((ice-9 popen)
+                         (ice-9 rdelim)
+                         ,@%default-modules))
 
-              ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
-              ;; networking is unavailable, but also means that the interface is not up
-              ;; yet when 'start' completes.  To wait for the interface to be ready, one
-              ;; should instead monitor udev events.
               (start #~(lambda _
-                         (define dhclient
-                           (string-append #$package "/sbin/dhclient"))
-
-                         ;; When invoked without any arguments, 'dhclient' discovers all
+                         ;; When invoked without any arguments, the client discovers all
                          ;; non-loopback interfaces *that are up*.  However, the relevant
                          ;; interfaces are typically down at this point.  Thus we perform
                          ;; our own interface discovery here.
@@ -355,17 +351,46 @@ (define dhcp-client-shepherd-service
                                        (_
                                         #~'#$interfaces))))
 
-                         (false-if-exception (delete-file #$pid-file))
-                         (let ((pid (fork+exec-command
-                                     ;; By default dhclient uses a
-                                     ;; pre-standardization implementation of
-                                     ;; DDNS, which is incompatable with
-                                     ;; non-ISC DHCP servers; thus, pass '-I'.
-                                     ;; <https://kb.isc.org/docs/aa-01091>.
-                                     (cons* dhclient "-nw" "-I"
-                                            "-pf" #$pid-file ifaces))))
-                           (and (zero? (cdr (waitpid pid)))
-                                (read-pid-file #$pid-file)))))
+                         ;; Returns the execution configuration for the DHCP client
+                         ;; selected by the package field of dhcp-client-configuration.
+                         ;; The configuration is a pair of pidfile and execution command
+                         ;; where the latter is a list.
+                         (define exec-config
+                           (case (string->symbol #$client-name)
+                             ((isc-dhcp)
+                              (let ((pid-file "/var/run/dhclient.pid"))
+                                (cons
+                                  (cons* (string-append #$package "/sbin/dhclient")
+                                         "-nw" "-I" "-pf" pid-file ifaces)
+                                  pid-file)))
+                             ((dhcpcd)
+                              ;; For dhcpcd, the utilized pid-file depends on the
+                              ;; command-line arguments.  If multiple interfaces are
+                              ;; given, a different pid-file is returned.  Hence, we
+                              ;; consult dhcpcd itself to determine the pid-file.
+                              (let* ((cmd (string-append #$package "/sbin/dhcpcd"))
+                                     (arg (cons* cmd "-b" ifaces)))
+                                (cons arg
+                                  (let* ((pipe (string-join (append arg '("-P")) " "))
+                                         (port (open-input-pipe pipe))
+                                         (path (read-line port)))
+                                    (close-pipe port)
+                                    path))))
+                             (else
+                               (display
+                                 "unknown 'package' value in dhcp-client-configuration"
+                                 (current-error-port))
+                               (newline (current-error-port))
+                               #f)))
+
+                         (and
+                           exec-config
+                           (let ((pid-file (cdr exec-config))
+                                 (exec-cmd (car exec-config)))
+                             (false-if-exception (delete-file pid-file))
+                             (let ((pid (fork+exec-command exec-cmd)))
+                               (and (zero? (cdr (waitpid pid)))
+                                    (read-pid-file pid-file)))))))
               (stop #~(make-kill-destructor))))))
     (package
      (warning (G_ "'dhcp-client' service now expects a \
@@ -377,10 +402,27 @@ (define dhcp-client-shepherd-service
       (dhcp-client-configuration
        (package package))))))
 
+(define (dhcp-client-account-service config)
+  (let ((package (dhcp-client-configuration-package config)))
+    ;; Contrary to other DHCP clients (e.g. dhclient), dhcpcd supports
+    ;; privilege separation.  Hence, we need to create an account here.
+    (if (string=? "dhcpcd" (package-name package))
+      (list (user-group (name "dhcpcd") (system? #t))
+            (user-account
+              (name "dhcpcd")
+              (group "dhcpcd")
+              (system? #t)
+              (comment "dhcpcd daemon user")
+              (home-directory "/var/empty")
+              (shell "/run/current-system/profile/sbin/nologin")))
+      '())))
+
 (define dhcp-client-service-type
   (service-type (name 'dhcp-client)
                 (extensions
-                 (list (service-extension shepherd-root-service-type
+                 (list (service-extension account-service-type
+                                          dhcp-client-account-service)
+                       (service-extension shepherd-root-service-type
                                           dhcp-client-shepherd-service)))
                 (default-value (dhcp-client-configuration))
                 (description "Run @command{dhcp}, a Dynamic Host Configuration

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.