From 1bb5a1b4d513eb449188402ff192d24d2b490997 Mon Sep 17 00:00:00 2001 From: Jakub Czajka Date: Tue, 14 Jul 2026 10:00:45 +0000 Subject: [PATCH] [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 --- tests/vps-base.scm | 135 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 135 insertions(+) create mode 100644 tests/vps-base.scm diff --git a/tests/vps-base.scm b/tests/vps-base.scm new file mode 100644 index 0000000..0a94cb0 --- /dev/null +++ b/tests/vps-base.scm @@ -0,0 +1,135 @@ +;;; Copyright (c) 2026 Jakub Czajka +;;; 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))))) -- 2.47.3