services: networking: Add 'version' field to dhcp-client-configuration.

* gnu/services/networking.scm (<dhcp-client-configuration>)
[version]: New field.
(dhcp-client-shepherd-service): Use 'match-record' instead of various
accessors.  Honor the new 'version field'.  Include the version the PID file
name when a non-default version is used.
* doc/guix.texi (Networking Setup) <dhcp-client-configuration>
[version]: Document it.

Change-Id: I6236ae160967c95fe7a2c1785821cc9b0c183e77

2 files changed, 76 insertions, 62 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 52e36e4354..9734408347 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49,7 +49,7 @@ Copyright @copyright{} 2017 humanitiesNerd@*
 Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
 Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@*
 Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@*
-Copyright @copyright{} 2017, 2019, 2020, 2021, 2022, 2023 Maxim Cournoyer@*
+Copyright @copyright{} 2017, 2019, 2020, 2021, 2022, 2023, 2024 Maxim Cournoyer@*
 Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@*
 Copyright @copyright{} 2017 George Clemmer@*
 Copyright @copyright{} 2017 Andy Wingo@*
@@ -21085,6 +21085,11 @@ ISC DHCP client listens only on the specified interfaces.
 @item @code{config-file} (default: @code{#f})
 The configuration file for the ISC DHCP client.
 
+@item @code{version} (default: @code{"4"})
+The DHCP protocol version to use, as a string.  Accepted values are
+@code{"4"} or @code{"6"} for DHCPv4 or DHCPv6, respectively, as well as
+@code{"4o6"}, for DHCPv4 over DHCPv6 (as specified by RFC 7341).
+
 @item @code{shepherd-requirement} (default: @code{'()})
 @itemx @code{shepherd-provision} (default: @code{'(networking)})
 This option can be used to provide a list of symbols naming Shepherd services
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 12d8934e43..a1f5f37564 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -10,7 +10,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
-;;; Copyright © 2019, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
@@ -94,6 +94,7 @@
             dhcp-client-configuration-config-file
             dhcp-client-configuration-shepherd-provision
             dhcp-client-configuration-shepherd-requirement
+            dhcp-client-configuration-version
 
             dhcpd-service-type
             dhcpd-configuration
@@ -323,70 +324,78 @@
   (config-file dhcp-client-configuration-config-file
                (default #f))
   (interfaces   dhcp-client-configuration-interfaces
-                (default 'all)))                  ;'all | list of strings
+                (default 'all))         ;'all | list of strings
+  (version dhcp-client-configuration-version ;"4", "6", or "4o6"
+           (default "4")))
 
 (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))
-           (config-file (dhcp-client-configuration-config-file config))
-           (pid-file "/var/run/dhclient.pid"))
-       (list (shepherd-service
-              (documentation "Set up networking via DHCP.")
-              (requirement `(user-processes udev ,@requirement))
-              (provision provision)
-
-              ;; 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
-                         ;; non-loopback interfaces *that are up*.  However, the relevant
-                         ;; interfaces are typically down at this point.  Thus we perform
-                         ;; our own interface discovery here.
-                         (define valid?
-                           (lambda (interface)
-                             (and (arp-network-interface? interface)
-                                  (not (loopback-network-interface? interface))
-                                  ;; XXX: Make sure the interfaces are up so that
-                                  ;; 'dhclient' can actually send/receive over them.
-                                  ;; Ignore those that cannot be activated.
-                                  (false-if-exception
-                                   (set-network-interface-up interface)))))
-                         (define ifaces
-                           (filter valid?
-                                   #$(match interfaces
-                                       ('all
-                                        #~(all-network-interface-names))
-                                       (_
-                                        #~'#$interfaces))))
-
-                         (define config-file-args
-                           (if #$config-file
-                               (list "-cf" #$config-file)
-                               '()))
-
-                         (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>.
-                                     `(,dhclient "-nw" "-I"
-                                                 "-pf" ,#$pid-file
-                                                 ,@config-file-args
-                                                 ,@ifaces))))
-                           (and (zero? (cdr (waitpid pid)))
-                                (read-pid-file #$pid-file)))))
-              (stop #~(make-kill-destructor))))))
+     (match-record config <dhcp-client-configuration>
+                   (package shepherd-requirement shepherd-provision
+                            interfaces config-file version)
+       ;; Version the PID file to avoid conflicts in case multiple DHCP
+       ;; clients are run concurrently.
+       (let ((pid-file (if (string=? "4" version)
+                           "/var/run/dhclient.pid"
+                           (string-append "/var/run/dhclient-" version ".pid"))))
+         (list (shepherd-service
+                (documentation "Set up networking via DHCP.")
+                (requirement `(user-processes udev ,@shepherd-requirement))
+                (provision shepherd-provision)
+
+                ;; 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 non-loopback interfaces *that are
+                           ;; up*.  However, the relevant interfaces are
+                           ;; typically down at this point.  Thus we perform
+                           ;; our own interface discovery here.
+                           (define valid?
+                             (lambda (interface)
+                               (and (arp-network-interface? interface)
+                                    (not (loopback-network-interface? interface))
+                                    ;; XXX: Make sure the interfaces are up so
+                                    ;; that 'dhclient' can actually
+                                    ;; send/receive over them.  Ignore those
+                                    ;; that cannot be activated.
+                                    (false-if-exception
+                                     (set-network-interface-up interface)))))
+                           (define ifaces
+                             (filter valid?
+                                     #$(match interfaces
+                                         ('all
+                                          #~(all-network-interface-names))
+                                         (_
+                                          #~'#$interfaces))))
+
+                           (define config-file-args
+                             (if #$config-file
+                                 (list "-cf" #$config-file)
+                                 '()))
+
+                           (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>.
+                                       `(,dhclient "-nw" "-I"
+                                                   #$(string-append "-" version)
+                                                   "-pf" ,#$pid-file
+                                                   ,@config-file-args
+                                                   ,@ifaces))))
+                             (and (zero? (cdr (waitpid pid)))
+                                  (read-pid-file #$pid-file)))))
+                (stop #~(make-kill-destructor)))))))
     (package
      (warning (G_ "'dhcp-client' service now expects a \
 'dhcp-client-configuration' record~%"))