From fd74fe6325eb54a48e496b3afe5001005b15d802 Mon Sep 17 00:00:00 2001 From: Timotej Lazar Date: Thu, 28 Jul 2022 17:03:26 +0200 Subject: tests: Add qemu-guest-agent system test. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Enable the QEMU guest agent interface in marionette VMs, run the qemu-guest-agent service in one and try talking to it. * gnu/build/marionette.scm (make-marionette): Enable the guest agent device. * gnu/tests/virtualization.scm (run-qemu-guest-agent-test): New procedure. (%test-qemu-guest-agent): New variable. Signed-off-by: Ludovic Courtès --- gnu/tests/virtualization.scm | 84 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) (limited to 'gnu/tests') diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 299acc4945..4bd56e5d9d 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -37,6 +37,7 @@ #:use-module (guix records) #:use-module (guix store) #:export (%test-libvirt + %test-qemu-guest-agent %test-childhurd)) @@ -115,6 +116,89 @@ (description "Connect to the running LIBVIRT service.") (value (run-libvirt-test)))) + +;;; +;;; QEMU Guest Agent service. +;;; + +(define %qemu-guest-agent-os + (simple-operating-system + (service qemu-guest-agent-service-type))) + +(define (run-qemu-guest-agent-test) + "Run tests in %QEMU-GUEST-AGENT-OS." + (define os + (marionette-operating-system + %qemu-guest-agent-os + #:imported-modules '((gnu services herd)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (ice-9 rdelim) + (srfi srfi-64)) + + (define marionette + ;; Ensure we look for the socket in the correct place below. + (make-marionette (list #$vm) #:socket-directory "/tmp")) + + (define* (try-read port #:optional (attempts 10)) + ;; Try reading from a port several times before giving up. + (cond ((char-ready? port) + (let ((response (read-line port))) + (close-port port) + response)) + ((> attempts 1) + (sleep 1) + (try-read port (- attempts 1))) + (else ""))) + + (define (run command) + ;; Run a QEMU guest agent command and return the response. + (let ((s (socket PF_UNIX SOCK_STREAM 0))) + (connect s AF_UNIX "/tmp/qemu-ga") + (display command s) + (try-read s))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "qemu-guest-agent") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'qemu-guest-agent) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((pid) (number? pid)))))) + marionette)) + + (test-equal "ping guest" + "{\"return\": {}}" + (run "{\"execute\": \"guest-ping\"}")) + + (test-assert "get network interfaces" + (string-contains + (run "{\"execute\": \"guest-network-get-interfaces\"}") + "127.0.0.1")) + + (test-end)))) + + (gexp->derivation "qemu-guest-agent-test" test)) + +(define %test-qemu-guest-agent + (system-test + (name "qemu-guest-agent") + (description "Run commands in a virtual machine using QEMU guest agent.") + (value (run-qemu-guest-agent-test)))) + ;;; ;;; GNU/Hurd virtual machines, aka. childhurds. -- cgit v1.2.3