~ruther/guix-local

6954cc6c7a211e24b4e2ec8cd67d880318bd04f8 — Maxim Cournoyer 2 years ago 3e9ebe7
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(-)

M doc/guix.texi
M gnu/services/networking.scm
M doc/guix.texi => doc/guix.texi +6 -1
@@ 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

M gnu/services/networking.scm => gnu/services/networking.scm +70 -61
@@ 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~%"))