[bug#75100] [PATCH 2/3] services: static-networking: Fail when devices don’t show up.

[Ludovic Courtès]

Fixes <https://issues.guix.gnu.org/71173>.

* gnu/services/base.scm (network-set-up/linux): Define
‘max-set-up-duration’ and use it.
* gnu/tests/networking.scm (%static-networking-with-nonexistent-device):
New variable.
(run-static-networking-failure-test): New procedure.
(%test-static-networking-failure): New variable.

Change-Id: Idba9b36750aa8c6368c8f6d1bc1358066f7432e4
---
 gnu/services/base.scm    | 17 ++++++++--
 gnu/tests/networking.scm | 71 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 84 insertions(+), 4 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index f6d1da61cd..15497b23f7 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -3092,6 +3092,10 @@ (define (network-tear-down/hurd config)
                       #f))))
 
 (define (network-set-up/linux config)
+  (define max-set-up-duration
+    ;; Maximum waiting time in seconds for devices to be up.
+    60)
+
   (match-record config <static-networking>
     (addresses links routes)
     (program-file "set-up-network"
@@ -3169,12 +3173,19 @@ (define (network-set-up/linux config)
                                              (format #t (G_ "Interface with 
mac-address '~a' not found~%") #$mac-address)))))))
                                 links)
 
+                        ;; 'wait-for-link' below could wait forever when
+                        ;; passed a non-existent device.  To ensure timely
+                        ;; completion, install an alarm.
+                        (alarm #$max-set-up-duration)
+
                         #$@(map (lambda (address)
-                                  #~(begin
+                                  #~(let ((device
+                                           #$(network-address-device address)))
                                       ;; Before going any further, wait for the
                                       ;; device to show up.
-                                      (wait-for-link
-                                       #$(network-address-device address))
+                                      (format #t "Waiting for network device 
'~a'...~%"
+                                              device)
+                                      (wait-for-link device)
 
                                       (addr-add #$(network-address-device 
address)
                                                 #$(network-address-value 
address)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index b1ab43efb6..e7c02b9e00 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
-;;; Copyright © 2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +39,7 @@ (define-module (gnu tests networking)
   #:use-module (gnu services shepherd)
   #:use-module (ice-9 match)
   #:export (%test-static-networking
+            %test-static-networking-failure
             %test-static-networking-advanced
             %test-inetd
             %test-openvswitch
@@ -124,7 +125,75 @@ (define %test-static-networking
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-static-networking-test (virtual-machine os))))))
+
 
+(define %static-networking-with-nonexistent-device
+  ;; Similar to %QEMU-STATIC-NETWORKING except that the device does not exist.
+  (static-networking
+   (addresses (list (network-address
+                     (device "does-not-exist")    ;<- really
+                     (value "10.0.2.15/24"))))
+   (routes (list (network-route
+                  (destination "default")
+                  (gateway "10.0.2.2"))))
+   (requirement '())
+   (provision '(networking))
+   (name-servers '("10.0.2.3"))))
+
+(define (run-static-networking-failure-test vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "static-networking")
+
+          (test-equal "service fails to start"
+            #f
+            ;; The 'start' method of the 'networking' service should fail
+            ;; within a minute or so.  Previously it would never complete:
+            ;; <https://issues.guix.gnu.org/71173>.
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (alarm 180)                 ;must complete in a timely fashion
+                (start-service 'networking))
+             marionette))
+
+          (test-equal "network interfaces"
+            '("lo")
+            (marionette-eval
+             '(begin
+                (use-modules (guix build syscalls))
+                (network-interface-names))
+             marionette))
+
+          (test-end))))
+
+  (gexp->derivation "static-networking-failure" test))
+
+(define %test-static-networking-failure
+  (system-test
+   (name "static-networking-failure")
+   (description "Test the behavior of the 'static-networking' service when
+passed an invalid device.")
+   (value
+    (let ((os (marionette-operating-system
+               (simple-operating-system
+                (service static-networking-service-type
+                         (list %static-networking-with-nonexistent-device)))
+               #:imported-modules '((gnu services herd)
+                                    (guix combinators)))))
+      (run-static-networking-failure-test (virtual-machine os))))))
+
+
 (define (run-static-networking-advanced-test vm)
   (define test
     (with-imported-modules '((gnu build marionette)
-- 
2.46.0