mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-30 22:36:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: static-networking: Fail when devices don’t show up.

Browse source 
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
This commit is contained in:
Ludovic Courtès 2024-12-25 21:54:16 +01:00
parent 8d649a8d17
commit 431ab10344
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 84 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gnu/services/base.scm
View file

@ -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 (alist->keyword+value alist)
(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)

71
gnu/tests/networking.scm
View file

@ -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)