summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi20
-rw-r--r--gnu/services/networking.scm123
-rw-r--r--po/guix/POTFILES.in1
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