[bug#58223] [PATCH 1/1] services: dhcp-client: Implement and use a configuration record

[Alexey Abramov]

* gnu/services/networking.scm (dhcp-client-configuration): New record
configuration.
(dhcp-client-shepherd-service): Implement a shepher service. Provide a
deprication message for legacy configurations.
(dhcp-client-service-type): Use dhcp-client-shepherd-service.
* doc/guix.texi: Update documentation
---
 doc/guix.texi               |  18 +++++-
 gnu/services/networking.scm | 114 ++++++++++++++++++++++--------------
 2 files changed, 85 insertions(+), 47 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 30eb7f4cbf..e425d98d26 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19227,10 +19227,24 @@ the user mode network stack,,, QEMU, QEMU 
Documentation}).
 @cindex DHCP, networking service
 @defvr {Scheme Variable} dhcp-client-service-type
 This is the type of services that run @var{dhcp}, a Dynamic Host Configuration
-Protocol (DHCP) client, on all the non-loopback network interfaces.  Its value
-is the DHCP client package to use, @code{isc-dhcp} by default.
+Protocol (DHCP) client.
 @end defvr
 
+@deftp {Data Type} dhcp-client-configuration
+Data type representing the configuration of dhcp client network service.
+
+@table @asis
+@item @code{package} (default: @code{isc-dhcp})
+DHCP client package to use.
+
+@item @code{interfaces} (default: @code{'()})
+List of strings of interface names that dhcp client should listen on. By
+default dhcp client will listen on all available non-loopback interfaces
+that can be activated (meaning, to set them up). (default: @code{'()})
+
+@end table
+@end deftp
+
 @cindex NetworkManager
 
 @defvr {Scheme Variable} network-manager-service-type
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 9d85728371..1185f7e57d 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -77,6 +77,10 @@ (define-module (gnu services networking)
                static-networking-service-type)
   #:export (%facebook-host-aliases
             dhcp-client-service-type
+            dhcp-client-configuration
+            dhcp-client-configuration?
+            dhcp-client-configuration-package
+            dhcp-client-configuration-interfaces
 
             dhcpd-service-type
             dhcpd-configuration
@@ -259,52 +263,72 @@ (define %facebook-host-aliases
 fe80::1%lo0 www.connect.facebook.net
 fe80::1%lo0 apps.facebook.com\n")
 
+
+(define-record-type* <dhcp-client-configuration>
+  dhcp-client-configuration make-dhcp-client-configuration
+  dhcp-client-configuration?
+  (package      dhcp-client-configuration-package ;file-like
+                (default isc-dhcp))
+  ;; Empty list (means any) or a list of valid interfaces
+  (interfaces   dhcp-client-configuration-interfaces
+                (default '())))
+
+(define dhcp-client-shepherd-service
+  (match-lambda
+    (($ <dhcp-client-configuration> package interfaces)
+     (let ((pid-file "/var/run/dhclient.pid"))
+       (list (shepherd-service
+              (documentation "Set up networking via DHCP.")
+              (requirement '(user-processes udev))
+
+              ;; 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.
+              (provision '(networking))
+
+              (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? (or '#$interfaces
+                                              (all-network-interface-names))))
+
+                         (false-if-exception (delete-file #$pid-file))
+                         (let ((pid (fork+exec-command
+                                     (cons* dhclient "-nw"
+                                            "-pf" #$pid-file ifaces))))
+                           (and (zero? (cdr (waitpid pid)))
+                                (read-pid-file #$pid-file)))))
+              (stop #~(make-kill-destructor))))))
+    (anything
+     (format (current-error-port) "warning: Defining dhcp-client service with
+a single argument value being a client package to use, is deprecated.  Please
+use <dhcp-client-configuration> record instead.\n")
+     (dhcp-client-shepherd-service
+      (dhcp-client-configuration
+       (package anything))))))
+
 (define dhcp-client-service-type
-  (shepherd-service-type
-   'dhcp-client
-   (lambda (dhcp)
-     (define dhclient
-       (file-append dhcp "/sbin/dhclient"))
-
-     (define pid-file
-       "/var/run/dhclient.pid")
-
-     (shepherd-service
-      (documentation "Set up networking via DHCP.")
-      (requirement '(user-processes udev))
-
-      ;; 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.
-      (provision '(networking))
-
-      (start #~(lambda _
-                 ;; 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? (all-network-interface-names)))
-
-                 (false-if-exception (delete-file #$pid-file))
-                 (let ((pid (fork+exec-command
-                             (cons* #$dhclient "-nw"
-                                    "-pf" #$pid-file ifaces))))
-                   (and (zero? (cdr (waitpid pid)))
-                        (read-pid-file #$pid-file)))))
-      (stop #~(make-kill-destructor))))
-   isc-dhcp
-   (description "Run @command{dhcp}, a Dynamic Host Configuration
+  (service-type (name 'dhcp-client)
+                (extensions
+                 (list (service-extension shepherd-root-service-type 
dhcp-client-shepherd-service)))
+                (default-value (dhcp-client-configuration))
+                (description "Run @command{dhcp}, a Dynamic Host Configuration
 Protocol (DHCP) client, on all the non-loopback network interfaces.")))
 
 (define-record-type* <dhcpd-configuration>
-- 
2.36.1