diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/install.scm | 15 | ||||
| -rw-r--r-- | gnu/tests/telephony.scm | 53 | ||||
| -rw-r--r-- | gnu/tests/virtualization.scm | 84 |
3 files changed, 129 insertions, 23 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 3754966140..fbb97d451c 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -152,15 +152,6 @@ (guix combinators))))) %base-services)))) -(define (operating-system-with-current-guix os) - "Return a variant of OS that uses the current Guix." - (operating-system - (inherit os) - (services (modify-services (operating-system-user-services os) - (guix-service-type config => - (guix-configuration - (inherit config) - (guix (current-guix)))))))) (define MiB (expt 2 20)) @@ -232,8 +223,7 @@ reboot\n") ;; Since the image has no network access, use the ;; current Guix so the store items we need are in ;; the image and add packages provided. - (inherit (operating-system-with-current-guix - installation-os)) + (inherit installation-os) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) (gnu installer tests) @@ -1865,8 +1855,7 @@ build (current-guix) and then store a couple of full system images.") (operating-system (inherit (operating-system-with-console-syslog (operating-system-add-packages - (operating-system-with-current-guix - installation-os) + installation-os %extra-packages))) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm index 16ee313f69..83fa7228c8 100644 --- a/gnu/tests/telephony.scm +++ b/gnu/tests/telephony.scm @@ -31,7 +31,8 @@ #:use-module (guix gexp) #:use-module (guix modules) #:export (%test-jami - %test-jami-provisioning)) + %test-jami-provisioning + %test-jami-provisioning-partial)) ;;; ;;; Jami daemon. @@ -67,7 +68,18 @@ "fallback.another.host")) (name-server-uri "https://my.name.server"))) -(define* (make-jami-os #:key provisioning?) +;;; Like %dummy-jami-account, but with allowed-contacts and moderators left +;;; unset (thus taking the value *unspecified*). +(define %dummy-jami-account-partial + (jami-account + (archive %dummy-jami-account-archive) + (rendezvous-point? #t) + (peer-discovery? #f) + (bootstrap-hostnames '("bootstrap.me" + "fallback.another.host")) + (name-server-uri "https://my.name.server"))) + +(define* (make-jami-os #:key provisioning? partial?) (operating-system (host-name "jami") (timezone "America/Montreal") @@ -87,7 +99,10 @@ (if provisioning? (jami-configuration (debug? #t) - (accounts (list %dummy-jami-account))) + (accounts + (list (if partial? + %dummy-jami-account-partial + %dummy-jami-account)))) (jami-configuration (debug? #t)))) (service dbus-root-service-type) @@ -109,12 +124,18 @@ (define %jami-os-provisioning (make-jami-os #:provisioning? #t)) -(define* (run-jami-test #:key provisioning?) - "Run tests in %JAMI-OS. When PROVISIONING? is true, test the -accounts provisioning feature of the service." +(define %jami-os-provisioning-partial + (make-jami-os #:provisioning? #t #:partial? #t)) + +(define* (run-jami-test #:key provisioning? partial?) + "Run tests in %JAMI-OS. When PROVISIONING? is true, test the accounts +provisioning feature of the service. When PARTIAL? is #t, some fields of the +jami account used as part of the jami configuration are left *unspecified*." (define os (marionette-operating-system (if provisioning? - %jami-os-provisioning + (if partial? + %jami-os-provisioning-partial + %jami-os-provisioning) %jami-os) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -202,7 +223,7 @@ accounts provisioning feature of the service." "Account.username"))))))) marionette)) - (unless #$provisioning? (test-skip 1)) + (unless #$(and provisioning? (not partial?)) (test-skip 1)) (test-assert "jami accounts provisioning, allowed-contacts" (marionette-eval '(begin @@ -224,7 +245,7 @@ accounts provisioning feature of the service." (assert (lset= string-ci=? contacts '#$%allowed-contacts))))) marionette)) - (unless #$provisioning? (test-skip 1)) + (unless #$(and provisioning? (not partial?)) (test-skip 1)) (test-assert "jami accounts provisioning, moderators" (marionette-eval '(begin @@ -326,7 +347,9 @@ accounts provisioning feature of the service." (test-end))))) (gexp->derivation (if provisioning? - "jami-provisioning-test" + (if partial? + "jami-provisioning-partial-test" + "jami-provisioning-partial") "jami-test") test)) @@ -341,3 +364,13 @@ accounts provisioning feature of the service." (name "jami-provisioning") (description "Provisioning test for the jami service.") (value (run-jami-test #:provisioning? #t)))) + +;;; Thi test verifies that <jami-account> values can be left unspecified +;;; without causing any issue (see: https://issues.guix.gnu.org/56799). +(define %test-jami-provisioning-partial + (system-test + (name "jami-provisioning-partial") + (description "Provisioning test for the jami service, when some of the +'maybe' fields aren't provided (such that their value end up being +*unspecified*.") + (value (run-jami-test #:provisioning? #t #:partial? #t)))) 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)) @@ -117,6 +118,89 @@ ;;; +;;; 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. ;;; |