[tests] Add VPS test harness.

Create tests/vps-base.scm as the framework for Guix system tests.
It defines the test OS (marionette-operating-system wrapping
%simple-os with the VPS services), VM configuration (port forwarding
2222->72), SSH session helper (call-with-connected-session), and the
test harness (run-vps-test) that splices test case gexps into one
derivation.

The SSH config is inlined from conf/vps/sshd.scm with a test
authorized key injected.  %test-vps starts with an empty test case
list -- test cases are added in subsequent commits.

Co-Authored-By: Claude <noreply@anthropic.com>

diff --git a/tests/vps-base.scm b/tests/vps-base.scm
new file mode 100644 (file)
index 0000000..0a94cb0
--- /dev/null
+++ b/tests/vps-base.scm
@@ -0,0 +1,135 @@
+;;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
+;;; License: GPL-3.0 or later.
+;;;
+;;; VPS test harness -- one VM for all test sections.
+
+(define-module (tests vps-base)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services networking)
+  #:use-module (gnu packages ssh)
+  #:use-module (conf vps sshd)
+  #:use-module (guix gexp)
+  #:export (%test-vps %vps-test-os call-with-connected-session run-vps-test))
+
+;;;
+;;; Placeholder key -- replaced by a generated keypair in a later
+;;; commit.
+;;;
+
+(define %test-ssh-public-key
+  "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIPlaceholderKeyForTestingDoNotUse")
+
+;;;
+;;; Test operating system.
+;;;
+
+(define %test-openssh-config
+  ;; Production config from conf/vps/sshd.scm plus a test authorized
+  ;; key so the test VM can authenticate.  All other fields -- port 72,
+  ;; openssh-sans-x, extra-content, accepted-environment,
+  ;; password-auth #f -- are identical.
+  (let ((authorized-key-file (plain-file "test-authorized_keys"
+                                         %test-ssh-public-key)))
+    (openssh-configuration (openssh openssh-sans-x)
+                           (port-number 72)
+                           (password-authentication? #f)
+                           (accepted-environment '("LANG" "LC_*"))
+                           (extra-content (string-append "PrintMotd no\n"
+                                           "ClientAliveInterval 120\n"
+                                           "ClientAliveCountMax 1\n"
+                                           "UseDNS no\n"))
+                           (authorized-keys `(("root" ,authorized-key-file))))))
+
+;; Operating system based on %simple-os with the VPS services and a
+;; test authorized key injected into the OpenSSH configuration.
+(define %vps-test-os
+  (marionette-operating-system (operating-system
+                                 (inherit %simple-os)
+                                 (packages (cons* openssh
+                                                  (operating-system-packages
+                                                   %simple-os)))
+                                 (services
+                                  (cons* (service dhcpcd-service-type)
+                                         (service openssh-service-type
+                                                  %test-openssh-config)
+                                         (service ntp-service-type)
+                                         %base-services)))
+                               #:imported-modules '((gnu services herd)
+                                                    (guix combinators))))
+
+;;;
+;;; SSH session helper -- used by SSH test cases to connect to the VM
+;;; through the forwarded port.
+;;;
+
+(define (call-with-connected-session proc key-file)
+  "Return a gexp that opens an SSH session to the guest on
+localhost:2222, authenticates with the private key at KEY-FILE, calls
+PROC with the session, and disconnects."
+  #~(lambda ()
+      (let ((s (make-session #:user "root"
+                             #:port 2222
+                             #:host "localhost")))
+        (connect! s)
+        (match (userauth-public-key! s
+                                     (make-key-from-file #$key-file))
+          ('success (let ((result (#$proc
+                                   s)))
+                      (disconnect! s) result))
+          (other (disconnect! s)
+                 (error "ssh key auth failed" other))))))
+
+;;;
+;;; Test harness.
+;;;
+
+(define (run-vps-test test-cases)
+  "Return a derivation that boots a VM with %vps-test-os and runs
+every function in TEST-CASES.  Each element is a function
+(marionette-gexp) -> gexp that returns a (test-begin ... test-end)
+block."
+  (define os
+    %vps-test-os)
+  (define vm
+    (virtual-machine (operating-system
+                       os)
+                     (port-forwardings '((2222 . 72)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+                           (with-extensions (list guile-ssh)
+                                            #~(begin
+                                                (use-modules (gnu build
+                                                                  marionette)
+                                                             (srfi srfi-64)
+                                                             (ssh session)
+                                                             (ssh auth)
+                                                             (ssh channel)
+                                                             (ssh key))
+
+                                                (define marionette
+                                                  (make-marionette (list #$vm)))
+
+                                                (define runner
+                                                  (system-test-runner #$output))
+
+                                                (test-runner-current runner)
+
+                                                #$@(map (lambda (tc)
+                                                          (tc #~marionette))
+                                                        test-cases)))))
+  (gexp->derivation "vps-test" test))
+
+;;;
+;;; System test record.
+;;;
+
+(define %test-vps
+  (system-test (name "vps")
+               (description "VPS test suite.")
+               (value (run-vps-test (list)))))