summary refs log tree commit diff
path: root/gnu/services/networking.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/networking.scm')
-rw-r--r--gnu/services/networking.scm38
1 files changed, 28 insertions, 10 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index af8dd43bd6..102202c853 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -170,15 +170,33 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
                         ;; 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))))
+                        (define valid?
+                          (negate loopback-network-interface?))
+                        (define ifaces
+                          (filter valid? (all-network-interfaces)))
+
+                        ;; XXX: Make sure the interfaces are up so that
+                        ;; 'dhclient' can actually send/receive over them.
+                        (for-each set-network-interface-up ifaces)
+
+                        (false-if-exception (delete-file #$pid-file))
+                        (let ((pid (fork+exec-command
+                                    (cons* #$dhclient "-nw"
+                                           "-pf" #$pid-file ifaces))))
                           (and (zero? (cdr (waitpid pid)))
-                               (call-with-input-file #$pid-file read)))))
+                               (let loop ()
+                                 (catch 'system-error
+                                   (lambda ()
+                                     (call-with-input-file #$pid-file read))
+                                   (lambda args
+                                     ;; 'dhclient' returned before PID-FILE
+                                     ;; was created, so try again.
+                                     (let ((errno (system-error-errno args)))
+                                       (if (= ENOENT errno)
+                                           (begin
+                                             (sleep 1)
+                                             (loop))
+                                           (apply throw args))))))))))
              (stop #~(make-kill-destructor))))))
 
 (define %ntp-servers
@@ -227,7 +245,7 @@ restrict -6 ::1\n"))
                             (comment "NTP daemon user")
                             (home-directory "/var/empty")
                             (shell
-                             "/run/current-system/profile/sbin/nologin"))))))))
+                             #~(string-append #$shadow "/sbin/nologin")))))))))
 
 (define* (tor-service #:key (tor tor))
   "Return a service to run the @uref{https://torproject.org,Tor} daemon.
@@ -257,7 +275,7 @@ policy) as the @code{tor} unprivileged user."
                             (comment "Tor daemon user")
                             (home-directory "/var/empty")
                             (shell
-                             "/run/current-system/profile/sbin/nologin"))))
+                             #~(string-append #$shadow "/sbin/nologin")))))
 
       (documentation "Run the Tor anonymous network overlay.")))))