Merge branch 'master' into core-updates-frozen

2 files changed, 131 insertions, 17 deletions

diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 41996678dd..f647e9554c 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -59,11 +59,8 @@
     (packages (append (list ganeti-instance-debootstrap ganeti-instance-guix)
                       %base-packages))
     (services
-     (append (list (static-networking-service "eth0" "10.0.2.15"
-                                              #:netmask "255.255.255.0"
-                                              #:gateway "10.0.2.2"
-                                              #:name-servers '("10.0.2.3"))
-
+     (append (list (service static-networking-service-type
+                            (list %qemu-static-networking))
                    (service openssh-service-type
                             (openssh-configuration
                              (permit-root-login 'prohibit-password)))
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index cebba7c7ca..2bcc7f70dc 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -4,6 +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 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,8 +38,100 @@
   #:use-module (gnu packages guile)
   #:use-module (gnu services shepherd)
   #:use-module (ice-9 match)
-  #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables
-                        %test-ipfs))
+  #:export (%test-static-networking
+            %test-inetd
+            %test-openvswitch
+            %test-dhcpd
+            %test-tor
+            %test-iptables
+            %test-ipfs))
+
+
+;;;
+;;; Static networking.
+;;;
+
+(define (run-static-networking-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 "-nic" "user,model=virtio-net-pci")))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "static-networking")
+
+          (test-assert "service is up"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'networking))
+             marionette))
+
+          (test-assert "network interfaces"
+            (marionette-eval
+             '(begin
+                (use-modules (guix build syscalls))
+                (network-interface-names))
+             marionette))
+
+          (test-equal "address of eth0"
+            "10.0.2.15"
+            (marionette-eval
+             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
+                     (addr (network-interface-address sock "eth0")))
+                (close-port sock)
+                (inet-ntop (sockaddr:fam addr) (sockaddr:addr addr)))
+             marionette))
+
+          (test-equal "netmask of eth0"
+            "255.255.255.0"
+            (marionette-eval
+             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
+                     (mask (network-interface-netmask sock "eth0")))
+                (close-port sock)
+                (inet-ntop (sockaddr:fam mask) (sockaddr:addr mask)))
+             marionette))
+
+          (test-equal "eth0 is up"
+            IFF_UP
+            (marionette-eval
+             '(let* ((sock  (socket AF_INET SOCK_STREAM 0))
+                     (flags (network-interface-flags sock "eth0")))
+                (logand flags IFF_UP))
+             marionette))
+
+          (test-end)
+
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "static-networking" test))
+
+(define %test-static-networking
+  (system-test
+   (name "static-networking")
+   (description "Test the 'static-networking' service.")
+   (value
+    (let ((os (marionette-operating-system
+               (simple-operating-system
+                (service static-networking-service-type
+                         (list %qemu-static-networking)))
+               #:imported-modules '((gnu services herd)
+                                    (guix combinators)))))
+      (run-static-networking-test (virtual-machine os))))))
+
+
+;;;
+;;; Inetd.
+;;;
 
 (define %inetd-os
   ;; Operating system with 2 inetd services.
@@ -177,9 +270,13 @@ port 7, and a dict service on port 2628."
 (define %openvswitch-os
   (operating-system
     (inherit (simple-operating-system
-              (static-networking-service "ovs0" "10.1.1.1"
-                                         #:netmask "255.255.255.252"
-                                         #:requirement '(openvswitch-configuration))
+              (simple-service 'openswitch-networking
+                              static-networking-service-type
+                              (list (static-networking
+                                     (addresses (list (network-address
+                                                       (value "10.1.1.1/24")
+                                                       (device "ovs0"))))
+                                     (requirement '(openvswitch-configuration)))))
               (service openvswitch-service-type)
               openvswitch-configuration-service))
     ;; Ensure the interface name does not change depending on the driver.
@@ -188,12 +285,15 @@ port 7, and a dict service on port 2628."
 (define (run-openvswitch-test)
   (define os
     (marionette-operating-system %openvswitch-os
-                                 #:imported-modules '((gnu services herd))))
+                                 #:imported-modules '((gnu services herd)
+                                                      (guix build syscalls))))
 
   (define test
-    (with-imported-modules '((gnu build marionette))
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
       #~(begin
           (use-modules (gnu build marionette)
+                       (guix build syscalls)
                        (ice-9 popen)
                        (ice-9 rdelim)
                        (srfi srfi-64))
@@ -234,11 +334,23 @@ port 7, and a dict service on port 2628."
                              (srfi srfi-1))
                 (live-service-running
                  (find (lambda (live)
-                         (memq 'networking-ovs0
+                         (memq 'networking
                                (live-service-provision live)))
                        (current-services))))
              marionette))
 
+          (test-equal "ovs0 is up"
+            IFF_UP
+            (marionette-eval
+             '(begin
+                (use-modules (guix build syscalls))
+
+                (let* ((sock  (socket AF_INET SOCK_STREAM 0))
+                       (flags (network-interface-flags sock "ovs0")))
+                  (close-port sock)
+                  (logand flags IFF_UP)))
+             marionette))
+
           (test-end))))
 
   (gexp->derivation "openvswitch-test" test))
@@ -276,10 +388,15 @@ subnet 192.168.1.0 netmask 255.255.255.0 {
 
 (define %dhcpd-os
   (simple-operating-system
-   (static-networking-service "ens3" "192.168.1.4"
-                              #:netmask "255.255.255.0"
-                              #:gateway "192.168.1.1"
-                              #:name-servers '("192.168.1.2" "192.168.1.3"))
+   (service static-networking-service-type
+            (list (static-networking
+                   (addresses (list (network-address
+                                     (value "192.168.1.4/24")
+                                     (device "ens3"))))
+                   (routes (list (network-route
+                                  (destination "default")
+                                  (gateway "192.168.1.1"))))
+                   (name-servers '("192.168.1.2" "192.168.1.3")))))
    (service dhcpd-service-type dhcpd-v4-configuration)))
 
 (define (run-dhcpd-test)