diff options
| -rw-r--r-- | doc/guix.texi | 20 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 123 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 |
3 files changed, 97 insertions, 47 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index eeec4dec2c..6691ae5844 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19230,10 +19230,26 @@ 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 the DHCP client service. + +@table @asis +@item @code{package} (default: @code{isc-dhcp}) +DHCP client package to use. + +@item @code{interfaces} (default: @code{'all}) +Either @code{'all} or the list of interface names that the DHCP client +should listen on---e.g., @code{'("eno1")}. + +When set to @code{'all}, the DHCP client listens on all the available +non-loopback interfaces that can be activated. Otherwise the DHCP +client listens only on the specified interfaces. +@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..19aba8c266 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -66,6 +66,9 @@ #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix deprecation) + #:use-module (guix diagnostics) + #:autoload (guix ui) (display-hint) + #:use-module (guix i18n) #:use-module (rnrs enums) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -77,6 +80,10 @@ 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 +266,78 @@ fe80::1%lo0 connect.facebook.net 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)) + (interfaces dhcp-client-configuration-interfaces + (default 'all))) ;'all | list of strings + +(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? + #$(match interfaces + ('all + #~(all-network-interface-names)) + (_ + #~'#$interfaces)))) + + (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)))))) + (package + (warning (G_ "'dhcp-client' service now expects a \ +'dhcp-client-configuration' record~%")) + (display-hint (G_ "The value associated with instances of +@code{dhcp-client-service-type} must now be a @code{dhcp-client-configuration} +record instead of a package. Please adjust your configuration accordingly.")) + (dhcp-client-shepherd-service + (dhcp-client-configuration + (package package)))))) + (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> diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 4050a4c7ae..ed3fdb6be0 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -5,6 +5,7 @@ gnu/packages.scm gnu/services.scm gnu/system.scm gnu/services/configuration.scm +gnu/services/networking.scm gnu/services/shepherd.scm gnu/services/samba.scm gnu/home/services.scm |