diff options
Diffstat (limited to 'gnu/services/networking.scm')
| -rw-r--r-- | gnu/services/networking.scm | 50 |
1 files changed, 48 insertions, 2 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 6a7d194659..d532fc8d99 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -25,6 +25,7 @@ #:use-module (guix gexp) #:use-module (guix monads) #:export (static-networking-service + dhcp-client-service tor-service)) ;;; Commentary: @@ -50,9 +51,15 @@ gateway." (with-monad %store-monad (return (service + + ;; Unless we're providing the loopback interface, wait for udev to be up + ;; and running so that INTERFACE is actually usable. + (requirement (if (memq 'loopback provision) + '() + '(udev))) + (documentation - (string-append "Set up networking on the '" interface - "' interface using a static IP address.")) + "Bring up the networking interface using a static IP address.") (provision provision) (start #~(lambda _ ;; Return #t if successfully started. @@ -88,6 +95,45 @@ gateway." #t))))) (respawn? #f))))) +(define* (dhcp-client-service #:key (dhcp isc-dhcp)) + "Return a service that runs @var{dhcp}, a Dynamic Host Configuration +Protocol (DHCP) client, on all the non-loopback network interfaces." + + (define dhclient + #~(string-append #$dhcp "/sbin/dhclient")) + + (define pid-file + "/var/run/dhclient.pid") + + (with-monad %store-monad + (return (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. + (let* ((valid? (negate loopback-network-interface?)) + (ifaces (filter valid? + (all-network-interfaces))) + (pid (fork+exec-command + (cons* #$dhclient "-nw" + "-pf" #$pid-file + ifaces)))) + (and (zero? (cdr (waitpid pid))) + (call-with-input-file #$pid-file read))))) + (stop #~(make-kill-destructor)))))) + (define* (tor-service #:key (tor tor)) "Return a service to run the @uref{https://torproject.org,Tor} daemon. |