[tests] Use static networking in test VM; restructure test harness.

QEMU user-mode networking provides DHCP, but dhcpcd can hang during
early boot when the DHCP server is slow to respond, blocking the
marionette REPL from connecting.  Replace it with static networking
(10.0.2.15/24 on eth0, gateway 10.0.2.2).

system-test-runner exits the process after the first test group
completes, so the VPS test must consolidate all assertions into a
single test-begin/test-end wrapping.  Each test module (sshd,
networking, ntp) now returns bare assertions without its own
begin/end pair.

diff --git a/tests/networking.scm b/tests/networking.scm
index 1b95f1361198be984a380e54beb75af60e2e5cc4..d08ad5f9fe4fdca4ba9a830e85554cf3b46def95 100644 (file)
--- a/tests/networking.scm
+++ b/tests/networking.scm
@@ -1,22 +1,22 @@
 ;;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
 ;;; License: GPL-3.0 or later.
 ;;;
-;;; DHCP / networking test cases.
+;;; Static networking test cases.
 
 (define-module (tests networking)
   #:use-module (guix gexp)
   #:export (networking-test-cases))
 
 (define (networking-test-cases marionette)
-  "Return a gexp that tests the DHCP client starts and the network
-comes up."
+  "Return a gexp with static networking test assertions."
   #~(begin
-      (test-begin "networking")
-
-      (test-assert "dhcpcd running"
+      (test-assert "net: service running"
                    (marionette-eval '(begin
                                        (use-modules (gnu services herd))
                                        (start-service 'networking))
                                     #$marionette))
 
-      (test-end)))
+      (test-assert "net: eth0 is up"
+                   (marionette-eval '(file-exists?
+                                      "/sys/class/net/eth0/operstate")
+                                    #$marionette))))

diff --git a/tests/ntp.scm b/tests/ntp.scm
index ee382a32408cf5c03d61cc0e436409300da55eb5..8f3fc255761a5ab10b4d8b781fdd4a22f910f02e 100644 (file)
--- a/tests/ntp.scm
+++ b/tests/ntp.scm
@@ -8,14 +8,10 @@
   #:export (ntp-test-cases))
 
 (define (ntp-test-cases marionette)
-  "Return a gexp that tests the NTP daemon starts."
+  "Return a gexp with NTP daemon test assertion."
   #~(begin
-      (test-begin "ntp")
-
-      (test-assert "ntpd running"
+      (test-assert "ntp: ntpd running"
                    (marionette-eval '(begin
                                        (use-modules (gnu services herd))
                                        (start-service 'ntpd))
-                                    #$marionette))
-
-      (test-end)))
+                                    #$marionette))))

diff --git a/tests/sshd.scm b/tests/sshd.scm
index a3e1a58ba22bcbd505e68664d0765e79db0393d0..044b330586e41243fb398c5750281072b28f0e44 100644 (file)
--- a/tests/sshd.scm
+++ b/tests/sshd.scm
@@ -8,24 +8,18 @@
   #:export (sshd-test-cases))
 
 (define (sshd-test-cases marionette connect-gexp)
-  "Return a gexp testing the SSH daemon.  CONNECT-GEXP is a gexp
-that evaluates to a thunk which, when called, returns the result of a
-shell command run via SSH."
+  "Return a gexp with SSH daemon test assertions."
   #~(begin
-      (test-begin "sshd")
-
-      (test-assert "service running"
+      (test-assert "sshd: service running"
                    (marionette-eval '(begin
                                        (use-modules (gnu services herd))
                                        (start-service 'ssh-daemon))
                                     #$marionette))
 
-      (test-assert "port 72 TCP"
+      (test-assert "sshd: port 72 TCP"
                    (wait-for-tcp-port 72
                                       #$marionette))
 
-      (test-equal "shell command via key auth"
+      (test-equal "sshd: shell command via key auth"
                   'hello
-                  (#$connect-gexp))
-
-      (test-end)))
+                  (#$connect-gexp))))

diff --git a/tests/vps-base.scm b/tests/vps-base.scm
index 4fba22f3d2db5b7137fe9d8b5c14409336a68fc0..ff2be964e8744b5684b2f245bbb7128ea972360f 100644 (file)
--- a/tests/vps-base.scm
+++ b/tests/vps-base.scm
@@ -67,18 +67,33 @@
   ;; extra-content, and accepted-environment mirror production.  Auth
   ;; is relaxed for testing (root login with empty password) following
   ;; the same pattern as %test-openssh in gnu/tests/ssh.scm.
-  (openssh-configuration (openssh openssh-sans-x)
-                         (port-number 72)
-                         (permit-root-login #t)
-                         (allow-empty-passwords? #t)
-                         (accepted-environment '("LANG" "LC_*"))
-                         (extra-content (string-append "PrintMotd no\n"
-                                         "ClientAliveInterval 120\n"
-                                         "ClientAliveCountMax 1\n"
-                                         "UseDNS no\n"))))
-
-;; Operating system based on %simple-os with the VPS services and a
-;; test authorized key injected into the OpenSSH configuration.
+  (let ((key-file %test-authorized-keys-file))
+    (openssh-configuration (openssh openssh-sans-x)
+                           (port-number 72)
+                           (permit-root-login #t)
+                           (allow-empty-passwords? #t)
+                           (accepted-environment '("LANG" "LC_*"))
+                           (extra-content (string-append "PrintMotd no\n"
+                                           "ClientAliveInterval 120\n"
+                                           "ClientAliveCountMax 1\n"
+                                           "UseDNS no\n"))
+                           (authorized-keys `(("root" ,key-file))))))
+
+;; Use static networking instead of DHCP -- QEMU user-mode
+;; networking does provide DHCP but it can be unreliable during
+;; early boot, causing dhcpcd to hang and block the marionette REPL.
+(define %static-network-config
+  (let ((addr (network-address (device "eth0")
+                               (value "10.0.2.15/24")))
+        (route (network-route (destination "default")
+                              (gateway "10.0.2.2"))))
+    (static-networking (addresses (list addr))
+                       (routes (list route)))))
+
+(define %static-networking
+  (service static-networking-service-type
+           (list %static-network-config)))
+
 (define %vps-test-os
   (marionette-operating-system (operating-system
                                  (inherit %simple-os)
@@ -86,7 +101,7 @@
                                                   (operating-system-packages
                                                    %simple-os)))
                                  (services
-                                  (cons* (service dhcpcd-service-type)
+                                  (cons* %static-networking
                                          (service openssh-service-type
                                                   %test-openssh-config)
                                          (service ntp-service-type)
@@ -155,9 +170,13 @@ block."
 
                                                 (test-runner-current runner)
 
+                                                (test-begin "vps")
+
                                                 #$@(map (lambda (tc)
                                                           (tc #~marionette))
-                                                        test-cases)))))
+                                                        test-cases)
+
+                                                (test-end "vps")))))
   (gexp->derivation "vps-test" test))
 
 ;;;
@@ -179,10 +198,13 @@ and returns the result."
     (call-with-connected-session ssh-proc)))
 
 (define %test-vps
-  (let ((cases (list (lambda (m)
-                       (sshd-test-cases m
-                                        (make-ssh-connect m)))
-                     networking-test-cases ntp-test-cases)))
+  (let ((ssh (lambda (m)
+               (sshd-test-cases m
+                                (make-ssh-connect m))))
+        (net (lambda (m)
+               (networking-test-cases m)))
+        (ntp (lambda (m)
+               (ntp-test-cases m))))
     (system-test (name "vps")
-                 (description "VPS test suite: SSH, DHCP, NTP.")
-                 (value (run-vps-test cases)))))
+                 (description "VPS test suite.")
+                 (value (run-vps-test (list ssh net ntp))))))