diff options
Diffstat (limited to 'gnu/tests')
-rw-r--r-- | gnu/tests/audio.scm | 7 | ||||
-rw-r--r-- | gnu/tests/base.scm | 45 | ||||
-rw-r--r-- | gnu/tests/ci.scm | 9 | ||||
-rw-r--r-- | gnu/tests/cups.scm | 7 | ||||
-rw-r--r-- | gnu/tests/databases.scm | 24 | ||||
-rw-r--r-- | gnu/tests/desktop.scm | 9 | ||||
-rw-r--r-- | gnu/tests/dict.scm | 9 | ||||
-rw-r--r-- | gnu/tests/docker.scm | 65 | ||||
-rw-r--r-- | gnu/tests/file-sharing.scm | 7 | ||||
-rw-r--r-- | gnu/tests/ganeti.scm | 39 | ||||
-rw-r--r-- | gnu/tests/guix.scm | 14 | ||||
-rw-r--r-- | gnu/tests/install.scm | 24 | ||||
-rw-r--r-- | gnu/tests/ldap.scm | 7 | ||||
-rw-r--r-- | gnu/tests/linux-modules.scm | 11 | ||||
-rw-r--r-- | gnu/tests/mail.scm | 30 | ||||
-rw-r--r-- | gnu/tests/messaging.scm | 23 | ||||
-rw-r--r-- | gnu/tests/monitoring.scm | 15 | ||||
-rw-r--r-- | gnu/tests/networking.scm | 179 | ||||
-rw-r--r-- | gnu/tests/nfs.scm | 204 | ||||
-rw-r--r-- | gnu/tests/package-management.scm | 8 | ||||
-rw-r--r-- | gnu/tests/reconfigure.scm | 25 | ||||
-rw-r--r-- | gnu/tests/rsync.scm | 47 | ||||
-rw-r--r-- | gnu/tests/security-token.scm | 7 | ||||
-rw-r--r-- | gnu/tests/singularity.scm | 9 | ||||
-rw-r--r-- | gnu/tests/ssh.scm | 9 | ||||
-rw-r--r-- | gnu/tests/telephony.scm | 11 | ||||
-rw-r--r-- | gnu/tests/version-control.scm | 33 | ||||
-rw-r--r-- | gnu/tests/virtualization.scm | 16 | ||||
-rw-r--r-- | gnu/tests/web.scm | 43 |
29 files changed, 468 insertions, 468 deletions
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm index 7bf7d4ef14..8aa6d1e818 100644 --- a/gnu/tests/audio.scm +++ b/gnu/tests/audio.scm @@ -48,9 +48,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "mpd") (test-assert "service is running" @@ -70,8 +68,7 @@ '(system* #$(file-append mpd-mpc "/bin/mpc")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "mpd-test" test)) (define %test-mpd diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 9429a10b75..38d4317e52 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -87,6 +87,7 @@ Otherwise assume that there is no password for root." (use-modules (gnu build marionette) (guix build syscalls) (srfi srfi-1) + (srfi srfi-19) (srfi srfi-26) (srfi srfi-64) (ice-9 match)) @@ -94,9 +95,7 @@ Otherwise assume that there is no password for root." (define marionette (make-marionette #$command)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "basic") #$(and initialization @@ -198,6 +197,16 @@ info --version") (pk 'services services) '(root #$@(operating-system-shepherd-service-names os))))) + (test-equal "libc honors /etc/localtime" + -7200 ;CEST = GMT+2 + ;; Assume OS is configured to have a CEST timezone. + (let* ((sept-2021 (time-second + (date->time-utc + (make-date 0 0 00 12 01 09 2021 7200))))) + (marionette-eval + `(tm:gmtoff (localtime ,sept-2021)) + marionette))) + (test-equal "/var/log/messages is not world-readable" #o640 ;<https://bugs.gnu.org/40405> (begin @@ -486,10 +495,11 @@ info --version") (test-assert "screendump" (begin - (marionette-control (string-append "screendump " #$output - "/tty1.ppm") - marionette) - (file-exists? "tty1.ppm"))) + (let ((capture + (string-append #$output "/tty1.ppm"))) + (marionette-control + (string-append "screendump " capture) marionette) + (file-exists? capture)))) (test-assert "screen text" (let ((text (marionette-screen-text marionette @@ -505,8 +515,7 @@ info --version") "root@" #$(operating-system-host-name os)))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -642,9 +651,7 @@ in a loop. See <http://bugs.gnu.org/26931>.") (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "cleanup") (test-assert "dirty service worked" @@ -657,8 +664,7 @@ in a loop. See <http://bugs.gnu.org/26931>.") (scandir "/tmp")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cleanup" test)) @@ -713,9 +719,7 @@ non-ASCII names from /tmp.") (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "mcron") (test-assert "service running" @@ -752,8 +756,7 @@ non-ASCII names from /tmp.") result) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -824,6 +827,7 @@ non-ASCII names from /tmp.") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "avahi") (test-assert "nscd PID file is created" @@ -902,8 +906,7 @@ non-ASCII names from /tmp.") (= (hostent:addrtype result) AF_INET))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "nss-mdns" test)) diff --git a/gnu/tests/ci.scm b/gnu/tests/ci.scm index a8b39fcd01..5294514c66 100644 --- a/gnu/tests/ci.scm +++ b/gnu/tests/ci.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Christopher Baines <[email protected]> ;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]> ;;; Copyright © 2018 Pierre-Antoine Rouby <[email protected]> @@ -70,9 +70,7 @@ HTTP-PORT." ;; port 8080 in the host. (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "laminar") (test-assert "service running" @@ -116,8 +114,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "laminar-test" test)) diff --git a/gnu/tests/cups.scm b/gnu/tests/cups.scm index 4e922e5023..4c7d78b7c8 100644 --- a/gnu/tests/cups.scm +++ b/gnu/tests/cups.scm @@ -54,9 +54,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "cups") ;; Wait for the web interface to become ready. @@ -80,8 +78,7 @@ #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cups-test" test)) diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm index c8d11e10c0..a20de1a8c7 100644 --- a/gnu/tests/databases.scm +++ b/gnu/tests/databases.scm @@ -61,9 +61,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "memcached") ;; Wait for memcached to be up and running. @@ -115,8 +113,7 @@ '(file-exists? "/var/log/memcached") marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "memcached-test" test)) @@ -179,9 +176,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "postgresql") (test-assert "service running" @@ -233,16 +228,14 @@ (let* ((port (open-pipe* OPEN_READ #$(file-append postgresql "/bin/psql") - "-tAh" "/tmp" - "-c" "SELECT 1 FROM pg_database WHERE + "-tA" "-c" "SELECT 1 FROM pg_database WHERE datname='root'")) (output (get-string-all port))) (close-pipe port) (string-contains output "1"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "postgresql-test" test)) @@ -283,9 +276,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "mysql") (test-assert "service running" @@ -341,8 +332,7 @@ output)) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "mysql-test" test)) diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm index 6aa22fd49b..57069c0ede 100644 --- a/gnu/tests/desktop.scm +++ b/gnu/tests/desktop.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2021 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -43,9 +43,7 @@ (define marionette (make-marionette '(#$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "elogind") ;; Log in as root on tty1, and check what 'loginctl' returns. @@ -83,8 +81,7 @@ (guest-file "/root/seats") (guest-file "/root/users"))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "elogind" test)) diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm index c50e3cd6da..4d9702360c 100644 --- a/gnu/tests/dict.scm +++ b/gnu/tests/dict.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2018, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2018 Clément Lassieur <[email protected]> ;;; ;;; This file is part of GNU Guix. @@ -79,9 +79,7 @@ (define %dico-socket (socket PF_INET SOCK_STREAM 0)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "dicod") ;; Wait for the service to be started. @@ -117,8 +115,7 @@ (string-contains result "hello") result)))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dicod" test)) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 92611b0a8d..6302bd0727 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -18,9 +18,11 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu tests docker) + #:use-module (gnu image) #:use-module (gnu tests) #:use-module (gnu system) #:use-module (gnu system file-systems) + #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services dbus) @@ -35,7 +37,7 @@ #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix profiles) - #:use-module (guix scripts pack) + #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (guix tests) #:use-module (guix build-system trivial) @@ -56,15 +58,18 @@ inside %DOCKER-OS." (define os (marionette-operating-system - %docker-os + (operating-system-with-gc-roots + %docker-os + (list docker-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) (define vm (virtual-machine (operating-system os) - (memory-size 700) - (disk-image-size (* 1500 (expt 2 20))) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) (port-forwardings '()))) (define test @@ -76,9 +81,7 @@ inside %DOCKER-OS." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "docker") (test-assert "service running" @@ -143,8 +146,7 @@ inside %DOCKER-OS." (string->number response4)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "docker-test" test)) @@ -176,11 +178,12 @@ standard output device and then enters a new line.") guest-script-package)) #:hooks '() #:locales? #f)) - (tarball (docker-image "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) + (tarball (pack:docker-image + "docker-pack" profile + #:symlinks '(("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm")) + #:entry-point "bin/guile" + #:localstatedir? #t))) (run-docker-test tarball))) (define %test-docker @@ -195,19 +198,18 @@ standard output device and then enters a new line.") inside %DOCKER-OS." (define os (marionette-operating-system - %docker-os + (operating-system-with-gc-roots + %docker-os + (list tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) (define vm (virtual-machine (operating-system os) - ;; FIXME: Because we're using the volatile-root setup where the root file - ;; system is a tmpfs overlaid over a small root file system, 'docker - ;; load' must be able to store the whole image into memory, hence the - ;; huge memory requirements. We should avoid the volatile-root setup - ;; instead. - (memory-size 4500) + (volatile? #f) + (disk-image-size (* 5000 (expt 2 20))) + (memory-size 2048) (port-forwardings '()))) (define test @@ -221,9 +223,7 @@ inside %DOCKER-OS." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "docker") (test-assert "service running" @@ -288,8 +288,7 @@ inside %DOCKER-OS." "status" "guix-daemon"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "docker-system-test" test)) @@ -299,10 +298,12 @@ inside %DOCKER-OS." (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") (value (with-monad %store-monad - (>>= (system-docker-image (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:memory-size 1024) + (>>= (lower-object + (system-image (os->image + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + #:type docker-image-type))) run-docker-system-test))))) diff --git a/gnu/tests/file-sharing.scm b/gnu/tests/file-sharing.scm index 9a8ee6a593..d1343e2eba 100644 --- a/gnu/tests/file-sharing.scm +++ b/gnu/tests/file-sharing.scm @@ -91,9 +91,7 @@ (port-forwardings `((9091 . ,%transmission-daemon-rpc-port))))))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "transmission-daemon") ;; Make sure the "transmission" user and group have been created. @@ -259,8 +257,7 @@ "--auth" auth-string "--session-info")))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "transmission-daemon-test" test)) diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm index b64a332dde..f647e9554c 100644 --- a/gnu/tests/ganeti.scm +++ b/gnu/tests/ganeti.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Marius Bakke <[email protected]>. +;;; Copyright © 2020, 2021 Marius Bakke <[email protected]> ;;; Copyright © 2020 Brice Waegeneire <[email protected]> ;;; ;;; This file is part of GNU Guix. @@ -52,18 +52,15 @@ (hosts-file (plain-file "hosts" (format #f " 127.0.0.1 localhost ::1 localhost -10.0.2.2 gnt1.example.com gnt1 +10.0.2.15 gnt1.example.com gnt1 192.168.254.254 ganeti.example.com "))) (packages (append (list ganeti-instance-debootstrap ganeti-instance-guix) %base-packages)) (services - (append (list (static-networking-service "eth0" "10.0.2.2" - #:netmask "255.255.255.0" - #:gateway "10.0.2.1" - #:name-servers '("10.0.2.1")) - + (append (list (service static-networking-service-type + (list %qemu-static-networking)) (service openssh-service-type (openssh-configuration (permit-root-login 'prohibit-password))) @@ -83,8 +80,7 @@ (master-netdev "eth0") (hvparams '()) (extra-packages '()) - (rapi-port 5080) - (noded-port 1811)) + (rapi-port 5080)) "Run tests in %GANETI-OS." (define os (marionette-operating-system @@ -96,7 +92,6 @@ (guix combinators)))) (define %forwarded-rapi-port 5080) - (define %forwarded-noded-port 1811) (define vm (virtual-machine @@ -104,22 +99,20 @@ ;; Some of the daemons are fairly memory-hungry. (memory-size 512) ;; Forward HTTP ports so we can access them from the "outside". - (port-forwardings `((,%forwarded-rapi-port . ,rapi-port) - (,%forwarded-noded-port . ,noded-port))))) + (port-forwardings `((,%forwarded-rapi-port . ,rapi-port))))) (define test (with-imported-modules '((gnu build marionette)) #~(begin (use-modules (srfi srfi-11) (srfi srfi-64) (web uri) (web client) (web response) + (ice-9 iconv) (gnu build marionette)) (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "ganeti") ;; Ganeti uses the Shepherd to start/stop daemons, so make sure @@ -213,18 +206,19 @@ "watcher" "continue")) marionette)) - ;; Try accessing the RAPI. This causes an expected failure: - ;; https://github.com/ganeti/ganeti/issues/1502 - ;; Run it anyway for easy testing of potential fixes. + ;; Try accessing the RAPI. (test-equal "http-get RAPI version" - '(200 "2") + '(200 "2\n") (let-values (((response text) (http-get #$(simple-format #f "http://localhost:~A/version" %forwarded-rapi-port) - #:decode-body? #t))) - (list (response-code response) text))) + #:decode-body? #f))) + (list (response-code response) + ;; The API response lacks a content-type, so + ;; (http-client) won't decode it for us. + (bytevector->string text "UTF-8")))) (test-equal "gnt-os list" "debootstrap+default\nguix+default\n" @@ -248,8 +242,7 @@ "destroy" "--yes-do-it")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 1))))) + (test-end)))) (gexp->derivation (string-append "ganeti-" hypervisor "-test") test)) diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index af7d8f0b21..69cac7c1aa 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -74,9 +74,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "guix-build-coordinator") (test-assert "service running" @@ -99,8 +97,7 @@ #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "guix-build-coordinator-test" test)) @@ -199,9 +196,7 @@ host all all ::1/128 trust")))))) (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "guix-data-service") (test-assert "service running" @@ -235,8 +230,7 @@ host all all ::1/128 trust")))))) #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "guix-data-service-test" test)) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 98de4c8359..ae8c6051f1 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <[email protected]> ;;; Copyright © 2020 Mathieu Othacehe <[email protected]> ;;; Copyright © 2020 Danny Milosavljevic <[email protected]> @@ -31,7 +31,7 @@ #:use-module (gnu system image) #:use-module (gnu system install) #:use-module (gnu system vm) - #:use-module ((gnu build vm) #:select (qemu-command)) + #:use-module ((gnu build marionette) #:select (qemu-command)) #:use-module (gnu packages admin) #:use-module (gnu packages bootloaders) #:use-module (gnu packages commencement) ;for 'guile-final' @@ -355,7 +355,7 @@ IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." (format #t "creating writable image from '~a'...~%" image) (unless (zero? (system* #+(file-append qemu-minimal "/bin/qemu-img") - "create" "-f" "qcow2" + "create" "-f" "qcow2" "-F" "qcow2" "-o" (string-append "backing_file=" image) "disk.img")) @@ -925,7 +925,7 @@ reboot\n") (operating-system (host-name "bootroot") - (timezone "Europe/Madrid") + (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration @@ -1168,7 +1168,7 @@ RAID-0 (stripe) root partition.") (operating-system (host-name "hurd") - (timezone "America/Montreal") + (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) @@ -1679,11 +1679,15 @@ build (current-guix) and then store a couple of full system images.") ;; encryption support. The installer produces a UUID for the partition; ;; this "UUID" is explicitly set in 'gui-test-program' to the value shown ;; below. - (swap-devices (if encrypted? - '() - (list (uuid "11111111-2222-3333-4444-123456789abc")))) - (services (cons (service dhcp-client-service-type) - (operating-system-user-services %minimal-os-on-vda))))) + (swap-devices + (if encrypted? + '() + (list + (swap-space + (target (uuid "11111111-2222-3333-4444-123456789abc")))))) + (services (cons* (service dhcp-client-service-type) + (service ntp-service-type) + (operating-system-user-services %minimal-os-on-vda))))) (define* (installation-target-desktop-os-for-gui-tests #:key (encrypted? #f)) diff --git a/gnu/tests/ldap.scm b/gnu/tests/ldap.scm index 197c1bfb28..d5403b3539 100644 --- a/gnu/tests/ldap.scm +++ b/gnu/tests/ldap.scm @@ -69,9 +69,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "ldap") ;; Set up LDAP directory server @@ -148,8 +146,7 @@ suffix = dc=example,dc=com"))) #$(file-append coreutils "/bin/true"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "ldap-test" test)) diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm index fc8945b77f..69cb013267 100644 --- a/gnu/tests/linux-modules.scm +++ b/gnu/tests/linux-modules.scm @@ -76,23 +76,26 @@ that MODULES are actually loaded." (marionette-operating-system base-os #:imported-modules '((guix combinators)))) + (define vm (virtual-machine os)) + (define (test script) (with-imported-modules '((gnu build marionette)) #~(begin (use-modules (gnu build marionette) (srfi srfi-64)) + (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) + + (test-runner-current (system-test-runner #$output)) (test-begin "loadable-kernel-modules") (test-assert "script successfully evaluated" (marionette-eval '(primitive-load #$script) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) + (gexp->derivation "loadable-kernel-modules" (test (modules-loaded?-program os module-names)))) diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index eb8952b33a..f13751b72f 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Sou Bunnbu <[email protected]> ;;; Copyright © 2017 Carlo Zancanaro <[email protected]> -;;; Copyright © 2017, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2018 Oleg Pykhalov <[email protected]> ;;; Copyright © 2018 Clément Lassieur <[email protected]> ;;; Copyright © 2019 Christopher Baines <[email protected]> @@ -85,9 +85,7 @@ match from any for local action inbound code (read-reply-code port)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "opensmptd") (test-assert "service is running" @@ -157,8 +155,7 @@ match from any for local action inbound (sleep 1) (wait (- n 1)))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "opensmtpd-test" test)) @@ -230,9 +227,7 @@ acl_check_data: (define smtp (socket AF_INET SOCK_STREAM 0)) (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "exim") (test-assert "service is running" @@ -285,8 +280,7 @@ acl_check_data: (lambda (x) (not (string-prefix? "." x)))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "exim-test" test)) @@ -338,9 +332,7 @@ acl_check_data: (define message "From: [email protected]\n\ Subject: Hello Nice to meet you!") - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "dovecot") ;; Wait for dovecot to be up and running. @@ -399,8 +391,7 @@ Subject: Hello Nice to meet you!") get-string-all))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dovecot-test" test)) @@ -489,9 +480,7 @@ Subject: Hello Nice to meet you!") (define message "From: [email protected]\n\ Subject: Hello Nice to meet you!") - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "getmail") ;; Wait for dovecot to be up and running. @@ -577,8 +566,7 @@ Subject: Hello Nice to meet you!") marionette) message)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "getmail-test" test)) diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index 176e3d08cb..202a1c2f73 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]> -;;; Copyright © 2017, 2018 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2018, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2018 Efraim Flashner <[email protected]> ;;; ;;; This file is part of GNU Guix. @@ -98,9 +98,7 @@ (else (error "file didn't show up" file))))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "xmpp") ;; Wait for XMPP service to be up and running. @@ -128,8 +126,7 @@ (system* freetalk-bin "-s" #$script.ft) (host-wait-for-file #$witness))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -191,9 +188,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "bitlbee") (test-assert "service started" @@ -231,8 +226,7 @@ (->bool (string-contains (pk 'message (read-line sock)) "BitlBee")))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "bitlbee-test" test)) @@ -264,9 +258,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "quassel") (test-assert "service started" @@ -281,8 +273,7 @@ '(file-exists? "/var/lib/quassel/quasselCert.pem") marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "quassel-test" test)) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index 8630f5818c..ae0a8e0845 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -63,9 +63,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin #$name) (test-assert "prometheus-node-exporter running" @@ -87,8 +85,7 @@ (http-get "http://localhost:8080"))) (response-code response)))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -165,9 +162,7 @@ cat ~a | sudo -u zabbix psql zabbix; (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin #$name) ;; XXX: Shepherd reads the config file *before* binding its control @@ -296,9 +291,7 @@ zabbix||{} (test-url "/") (test-url "/does-not-exist" 404)) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 453e63f52d..3f3f653b8a 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Chris Marusich <[email protected]> ;;; Copyright © 2018 Arun Isaac <[email protected]> ;;; Copyright © 2021 Maxime Devos <[email protected]> +;;; Copyright © 2021 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,8 +38,96 @@ #:use-module (gnu packages guile) #:use-module (gnu services shepherd) #:use-module (ice-9 match) - #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables - %test-ipfs)) + #:export (%test-static-networking + %test-inetd + %test-openvswitch + %test-dhcpd + %test-tor + %test-iptables + %test-ipfs)) + + +;;; +;;; Static networking. +;;; + +(define (run-static-networking-test vm) + (define test + (with-imported-modules '((gnu build marionette) + (guix build syscalls)) + #~(begin + (use-modules (gnu build marionette) + (guix build syscalls) + (srfi srfi-64)) + + (define marionette + (make-marionette + '(#$vm "-nic" "user,model=virtio-net-pci"))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "static-networking") + + (test-assert "service is up" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'networking)) + marionette)) + + (test-assert "network interfaces" + (marionette-eval + '(begin + (use-modules (guix build syscalls)) + (network-interface-names)) + marionette)) + + (test-equal "address of eth0" + "10.0.2.15" + (marionette-eval + '(let* ((sock (socket AF_INET SOCK_STREAM 0)) + (addr (network-interface-address sock "eth0"))) + (close-port sock) + (inet-ntop (sockaddr:fam addr) (sockaddr:addr addr))) + marionette)) + + (test-equal "netmask of eth0" + "255.255.255.0" + (marionette-eval + '(let* ((sock (socket AF_INET SOCK_STREAM 0)) + (mask (network-interface-netmask sock "eth0"))) + (close-port sock) + (inet-ntop (sockaddr:fam mask) (sockaddr:addr mask))) + marionette)) + + (test-equal "eth0 is up" + IFF_UP + (marionette-eval + '(let* ((sock (socket AF_INET SOCK_STREAM 0)) + (flags (network-interface-flags sock "eth0"))) + (logand flags IFF_UP)) + marionette)) + + (test-end)))) + + (gexp->derivation "static-networking" test)) + +(define %test-static-networking + (system-test + (name "static-networking") + (description "Test the 'static-networking' service.") + (value + (let ((os (marionette-operating-system + (simple-operating-system + (service static-networking-service-type + (list %qemu-static-networking))) + #:imported-modules '((gnu services herd) + (guix combinators))))) + (run-static-networking-test (virtual-machine os)))))) + + +;;; +;;; Inetd. +;;; (define %inetd-os ;; Operating system with 2 inetd services. @@ -104,9 +193,7 @@ port 7, and a dict service on port 2628." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "inetd") ;; Make sure the PID file is created. @@ -137,8 +224,7 @@ port 7, and a dict service on port 2628." (close dict) response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "inetd-test" test)) @@ -180,9 +266,13 @@ port 7, and a dict service on port 2628." (define %openvswitch-os (operating-system (inherit (simple-operating-system - (static-networking-service "ovs0" "10.1.1.1" - #:netmask "255.255.255.252" - #:requirement '(openvswitch-configuration)) + (simple-service 'openswitch-networking + static-networking-service-type + (list (static-networking + (addresses (list (network-address + (value "10.1.1.1/24") + (device "ovs0")))) + (requirement '(openvswitch-configuration))))) (service openvswitch-service-type) openvswitch-configuration-service)) ;; Ensure the interface name does not change depending on the driver. @@ -191,12 +281,15 @@ port 7, and a dict service on port 2628." (define (run-openvswitch-test) (define os (marionette-operating-system %openvswitch-os - #:imported-modules '((gnu services herd)))) + #:imported-modules '((gnu services herd) + (guix build syscalls)))) (define test - (with-imported-modules '((gnu build marionette)) + (with-imported-modules '((gnu build marionette) + (guix build syscalls)) #~(begin (use-modules (gnu build marionette) + (guix build syscalls) (ice-9 popen) (ice-9 rdelim) (srfi srfi-64)) @@ -204,9 +297,7 @@ port 7, and a dict service on port 2628." (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "openvswitch") ;; Make sure the bridge is created. @@ -239,13 +330,24 @@ port 7, and a dict service on port 2628." (srfi srfi-1)) (live-service-running (find (lambda (live) - (memq 'networking-ovs0 + (memq 'networking (live-service-provision live))) (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-equal "ovs0 is up" + IFF_UP + (marionette-eval + '(begin + (use-modules (guix build syscalls)) + + (let* ((sock (socket AF_INET SOCK_STREAM 0)) + (flags (network-interface-flags sock "ovs0"))) + (close-port sock) + (logand flags IFF_UP))) + marionette)) + + (test-end)))) (gexp->derivation "openvswitch-test" test)) @@ -282,10 +384,15 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (define %dhcpd-os (simple-operating-system - (static-networking-service "ens3" "192.168.1.4" - #:netmask "255.255.255.0" - #:gateway "192.168.1.1" - #:name-servers '("192.168.1.2" "192.168.1.3")) + (service static-networking-service-type + (list (static-networking + (addresses (list (network-address + (value "192.168.1.4/24") + (device "ens3")))) + (routes (list (network-route + (destination "default") + (gateway "192.168.1.1")))) + (name-servers '("192.168.1.2" "192.168.1.3"))))) (service dhcpd-service-type dhcpd-v4-configuration))) (define (run-dhcpd-test) @@ -304,9 +411,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "dhcpd") (test-assert "pid file exists" @@ -339,8 +444,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dhcpd-test" test)) @@ -399,9 +503,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (current-services)))) marionette)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "tor") ;; Test the usual Tor service. @@ -433,8 +535,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (wait-for-unix-socket "/var/run/tor/socks-sock" marionette/unix-socks-socket))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "tor-test" test)) @@ -526,9 +627,7 @@ COMMIT (loop (read-line in))))))))) marionette)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "iptables") (test-equal "iptables-save dumps the same rules that were loaded" @@ -557,8 +656,7 @@ COMMIT ;; marionette) ;; (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "iptables" test)) @@ -622,9 +720,7 @@ COMMIT marionette)) (marionette-eval '(use-modules (guix ipfs)) marionette) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "ipfs") ;; Test the IPFS service. @@ -644,8 +740,7 @@ COMMIT test-bv (read-contents (add-data test-bv))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "ipfs-test" test)) (define %test-ipfs diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index a0c091eadb..0d9972e0e9 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2016, 2017, 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2016 John Darrington <[email protected]> ;;; Copyright © 2017 Mathieu Othacehe <[email protected]> ;;; Copyright © 2017 Tobias Geerinckx-Rice <[email protected]> @@ -33,6 +33,7 @@ #:use-module (gnu services base) #:use-module (gnu services nfs) #:use-module (gnu services networking) + #:use-module (gnu packages admin) #:use-module (gnu packages onc-rpc) #:use-module (gnu packages nfs) #:use-module (guix gexp) @@ -40,7 +41,7 @@ #:use-module (guix monads) #:export (%test-nfs %test-nfs-server - %test-nfs-root-fs)) + %test-nfs-full)) (define %base-os (operating-system @@ -92,9 +93,7 @@ (error "Socket didn't show up: " ,file)))) marionette)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "rpc-daemon") ;; Wait for the rpcbind daemon to be up and running. @@ -130,8 +129,7 @@ '(zero? (system* "rpcinfo" "-p")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -198,9 +196,7 @@ (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "nfs-daemon") (marionette-eval '(begin @@ -252,8 +248,7 @@ "nfs-server:/" "/remote" "-v")) (file-exists? "/remote/hello"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "nfs-server-test" test)) @@ -265,41 +260,63 @@ directories can be mounted.") (value (run-nfs-server-test)))) -(define (run-nfs-root-fs-test) +(define (run-nfs-full-test) "Run a test of an OS mounting its root file system via NFS." (define nfs-root-server-os - (marionette-operating-system - (operating-system - (inherit %nfs-os) - (services - (modify-services (operating-system-user-services %nfs-os) - (nfs-service-type config => - (nfs-configuration - (debug '(nfs nfsd mountd)) - ;;; Note: Adding the following line causes Guix to hang. - ;(rpcmountd-port 20001) - ;;; Note: Adding the following line causes Guix to hang. - ;(rpcstatd-port 20002) ; FIXME: Set broadcast port AND listening port. - (nfsd-port 2049) - (nfs-versions '("4.2")) - (exports '(("/export" - "*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,insecure,async)")))))))) - #:requirements '(nscd) - #:imported-modules '((gnu services herd) - (guix combinators)))) + (let ((os (simple-operating-system))) + (marionette-operating-system + (operating-system + (inherit os) + (services + (cons* + (service static-networking-service-type + (list + (static-networking + (addresses (list (network-address + (device "ens5") + (value "10.0.2.15/24"))))))) + (simple-service 'export activation-service-type + #~(begin + (mkdir-p "/export") + (chmod "/export" #o777))) + (service nfs-service-type + (nfs-configuration + (nfsd-port 2049) + (nfs-versions '("4.2")) + (exports '(("/export" + "*(rw,insecure,no_subtree_check,\ +crossmnt,fsid=root,no_root_squash,insecure,async)"))))) + (modify-services (operating-system-user-services os) + (syslog-service-type config + => + (syslog-configuration + (inherit config) + (config-file + (plain-file + "syslog.conf" + "*.* /dev/console\n")))))))) + #:requirements '(nscd) + #:imported-modules '((gnu services herd) + (guix combinators))))) (define nfs-root-client-os (marionette-operating-system - (operating-system - (inherit (simple-operating-system (service dhcp-client-service-type))) - (kernel-arguments '("ip=dhcp")) - (file-systems (cons - (file-system - (type "nfs") - (mount-point "/") - (device ":/export") - (options "addr=127.0.0.1,vers=4.2")) - %base-file-systems))) + (simple-operating-system + (service static-networking-service-type + (list + (static-networking + (addresses + (list (network-address + (device "ens5") + (value "10.0.2.16/24"))))))) + (service nfs-service-type + (nfs-configuration + (nfsd-port 2049) + (nfs-versions '("4.2")))) + (simple-service 'export activation-service-type + #~(begin + (mkdir-p "/export") + (chmod "/export" #o777)))) #:requirements '(nscd) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -310,90 +327,60 @@ directories can be mounted.") (use-modules (gnu build marionette) (srfi srfi-64)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "start-nfs-boot-test") ;;; Start up NFS server host. - (mkdir "/tmp/server") (define server-marionette - (make-marionette (list #$(virtual-machine - nfs-root-server-os - ;(operating-system nfs-root-server-os) - ;(port-forwardings '( ; (111 . 111) - ; (2049 . 2049) - ; (20001 . 20001) - ; (20002 . 20002))) -)) - #:socket-directory "/tmp/server")) - - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (current-output-port - (open-file "/dev/console" "w0")) - ;; FIXME: Instead statfs "/" and "/export" and wait until they - ;; are different file systems. But Guile doesn't seem to have - ;; statfs. - (sleep 5) - (chmod "/export" #o777) - (symlink "/gnu" "/export/gnu") - (start-service 'nscd) - (start-service 'networking) - (start-service 'nfs)) - server-marionette) + (make-marionette + (cons* #$(virtual-machine + (operating-system nfs-root-server-os) + (volatile? #f)) + '("-device" "e1000,netdev=n1,mac=52:54:00:12:34:56" + "-netdev" "socket,id=n1,listen=:1234")) + #:socket-directory "/tmp/server")) ;;; Wait for the NFS services to be up and running. - (test-assert "nfs services are running" - (wait-for-file "/var/run/rpc.statd.pid" server-marionette)) + (wait-for-file "/var/run/rpc.statd.pid" server-marionette)) (test-assert "NFS port is ready" (wait-for-tcp-port 2049 server-marionette)) - (test-assert "NFS statd port is ready" - (wait-for-tcp-port 20002 server-marionette)) - - (test-assert "NFS mountd port is ready" - (wait-for-tcp-port 20001 server-marionette)) - - ;;; FIXME: (test-assert "NFS portmapper port is ready" - ;;; FIXME: (wait-for-tcp-port 111 server-marionette)) - ;;; Start up NFS client host. - + (mkdir "/tmp/client") (define client-marionette - (make-marionette (list #$(virtual-machine - nfs-root-client-os - ;(port-forwardings '((111 . 111) - ; (2049 . 2049) - ; (20001 . 20001) - ; (20002 . 20002))) - )))) + (make-marionette + (cons* #$(virtual-machine + (operating-system nfs-root-client-os) + (volatile? #f)) + '("-device" "e1000,netdev=n2,mac=52:54:00:12:34:57" + "-netdev" "socket,id=n2,connect=127.0.0.1:1234")) + #:socket-directory "/tmp/client")) + + (test-assert "NFS port is ready" + (wait-for-tcp-port 2049 client-marionette)) (marionette-eval '(begin - (use-modules (gnu services herd)) (use-modules (rnrs io ports)) - (current-output-port (open-file "/dev/console" "w0")) - (let ((content (call-with-input-file "/proc/mounts" get-string-all))) - (call-with-output-file "/mounts.new" - (lambda (port) - (display content port)))) - (chmod "/mounts.new" #o777) - (rename-file "/mounts.new" "/mounts")) + (and + (system* (string-append #$nfs-utils "/sbin/mount.nfs") + "10.0.2.15:/export" "/export" "-v") + (let ((content (call-with-input-file "/proc/mounts" + get-string-all))) + (call-with-output-file "/export/mounts" + (lambda (port) + (display content port)))))) client-marionette) - (test-assert "nfs-root-client booted") - ;;; Check whether NFS client host communicated with NFS server host. - (test-assert "nfs client deposited file" - (wait-for-file "/export/mounts" server-marionette)) + (wait-for-file "/export/mounts" server-marionette)) + (marionette-eval '(begin (current-output-port @@ -401,14 +388,13 @@ directories can be mounted.") (call-with-input-file "/export/mounts" display)) server-marionette) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) - (gexp->derivation "nfs-root-fs-test" test)) + (gexp->derivation "nfs-full-test" test)) -(define %test-nfs-root-fs +(define %test-nfs-full (system-test - (name "nfs-root-fs") + (name "nfs-full") (description "Test that an NFS server can be started and the exported -directory can be used as root file system.") - (value (run-nfs-root-fs-test)))) +directory can be used by another machine.") + (value (run-nfs-full-test)))) diff --git a/gnu/tests/package-management.scm b/gnu/tests/package-management.scm index 087eaf923e..fe897944d0 100644 --- a/gnu/tests/package-management.scm +++ b/gnu/tests/package-management.scm @@ -60,9 +60,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin #$name) ;; XXX: Shepherd reads the config file *before* binding its control @@ -105,9 +103,7 @@ derivation { "guix-test.nix"))) marionette)) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index 001b5d185a..ec845fe4b0 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -79,9 +79,7 @@ generation of the system profile." entries))) marionette)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "switch-to-system") (let ((generations-prior (system-generations marionette))) @@ -112,8 +110,7 @@ generation of the system profile." "jakob") marionette))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "switch-to-system" (test (switch-system-program os)))) @@ -153,9 +150,7 @@ Shepherd (PID 1) by unloading obsolete services and loading new services." (map live-service-canonical-name (current-services))) marionette)) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "upgrade-services") (let ((services-prior (running-services marionette))) @@ -176,8 +171,7 @@ Shepherd (PID 1) by unloading obsolete services and loading new services." (test-assert "script stopped obsolete service" (not (memq 'dummy (running-services marionette))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "upgrade-services" @@ -195,7 +189,9 @@ bootloader's configuration file." #:imported-modules '((gnu services herd) (guix combinators)))) - (define vm (virtual-machine os)) + (define vm (virtual-machine + (operating-system os) + (volatile? #f))) (define (test script) (with-imported-modules '((gnu build marionette)) @@ -220,9 +216,7 @@ bootloader's configuration file." (second (string-split (match:substring parameter) #\=))) (list-matches "system=[^ ]*" grub-cfg)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "install-bootloader") (test-assert "no prior menu entry for system generation" @@ -236,8 +230,7 @@ bootloader's configuration file." (test-assert "menu entry created for system generation" (member #$os (generations-in-grub-cfg marionette))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (let* ((bootloader ((compose bootloader-configuration-bootloader operating-system-bootloader) diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm index 24e60d9d9d..ea53a157bb 100644 --- a/gnu/tests/rsync.scm +++ b/gnu/tests/rsync.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Christopher Baines <[email protected]> ;;; Copyright © 2018 Clément Lassieur <[email protected]> +;;; Copyright © 2021 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,9 +55,7 @@ PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "rsync") ;; Wait for rsync to be up and running. @@ -106,8 +105,36 @@ PORT." (read-line port)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-equal "Test file not copied to read-only share" + 1 ;see "EXIT VALUES" in rsync(1) + (marionette-eval + '(status:exit-val + (system* "rsync" "/tmp/input" + (string-append "rsync://localhost:" + (number->string #$rsync-port) + "/read-only/input"))) + marionette)) + + (test-equal "Test file correctly received from read-only share" + "\"Hi!\" from the read-only share." + (marionette-eval + '(begin + (use-modules (ice-9 rdelim)) + + (call-with-output-file "/srv/read-only/the-file" + (lambda (port) + (display "\"Hi!\" from the read-only share." port))) + + (zero? + (system* "rsync" + (string-append "rsync://localhost:" + (number->string #$rsync-port) + "/read-only/the-file") + "/tmp/output")) + (call-with-input-file "/tmp/output" read-line)) + marionette)) + + (test-end)))) (gexp->derivation "rsync-test" test)) @@ -116,7 +143,15 @@ PORT." (let ((base-os (simple-operating-system (service dhcp-client-service-type) - (service rsync-service-type)))) + (service rsync-service-type + (rsync-configuration + (modules (list (rsync-module + (name "read-only") + (file-name "/srv/read-only")) + (rsync-module + (name "files") + (file-name "/srv/read-write") + (read-only? #f))))))))) (operating-system (inherit base-os) (packages (cons* rsync diff --git a/gnu/tests/security-token.scm b/gnu/tests/security-token.scm index 1169a4b9fd..07270c0bfd 100644 --- a/gnu/tests/security-token.scm +++ b/gnu/tests/security-token.scm @@ -44,9 +44,7 @@ (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "pcscd") (test-assert "pcscd is alive" @@ -59,8 +57,7 @@ (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "pcscd" test)) diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm index 1fc2773a00..f4b9776b48 100644 --- a/gnu/tests/singularity.scm +++ b/gnu/tests/singularity.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2019, 2021 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -72,9 +72,7 @@ (define marionette (make-marionette (list #$(virtual-machine os)))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "singularity") (test-assert "singularity exec /bin/guile (as root)" @@ -126,8 +124,7 @@ "--debug" "run" #$image "-c" "(use-modules (json))")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "singularity-test" test)) diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index 10438ad22a..791ff7b73f 100644 --- a/gnu/tests/ssh.scm +++ b/gnu/tests/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]> ;;; Copyright © 2017 Marius Bakke <[email protected]> ;;; @@ -108,9 +108,7 @@ root with an empty password." ('denied (loop rest))))))))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "ssh-daemon") ;; Wait for sshd to be up and running. @@ -209,8 +207,7 @@ root with an empty password." (channel-request-exec channel "path-witness") (zero? (channel-get-exit-status channel)))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0)))))) + (test-end))))) (gexp->derivation name test)) diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm index aeb6500c47..bc464a431a 100644 --- a/gnu/tests/telephony.scm +++ b/gnu/tests/telephony.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Maxim Cournoyer <[email protected]>. +;;; Copyright © 2021, 2022 Maxim Cournoyer <[email protected]>. ;;; ;;; This file is part of GNU Guix. ;;; @@ -138,9 +138,7 @@ accounts provisioning feature of the service." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "jami") (test-assert "service is running" @@ -176,7 +174,7 @@ accounts provisioning feature of the service." ;; in the service; use retries. (with-retries 20 1 (not (zero? (status:exit-val - (system* "pgrep" "dring"))))))) + (system* "pgrep" "jamid"))))))) marionette)) (test-assert "service can be restarted" @@ -341,8 +339,7 @@ accounts provisioning feature of the service." account-details))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (if provisioning? "jami-provisioning-test" diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index a7cde1f163..fd3dba88ba 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Oleg Pykhalov <[email protected]> -;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]> ;;; Copyright © 2018 Christopher Baines <[email protected]> ;;; @@ -132,9 +132,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "cgit") ;; XXX: Shepherd reads the config file *before* binding its control @@ -210,8 +208,7 @@ HTTP-PORT." (test-url "/test/tree/does-not-exist" 404) (test-url "/does-not-exist" 404)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cgit-test" test)) @@ -270,9 +267,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "git-http") ;; Wait for nginx to be up and running. @@ -302,8 +297,7 @@ HTTP-PORT." (call-with-input-file "/tmp/clone/README" get-string-all))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "git-http" test)) @@ -367,9 +361,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "gitolite") ;; Wait for sshd to be up and running. @@ -410,8 +402,7 @@ HTTP-PORT." (test-assert "pushing, and the associated hooks" (invoke #$(file-append git "/bin/git") "push"))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "gitolite" test)) @@ -458,7 +449,8 @@ HTTP-PORT." (define vm (virtual-machine (operating-system os) - (port-forwardings `((8081 . ,http-port))))) + (port-forwardings `((8081 . ,http-port))) + (memory-size 1024))) (define test (with-imported-modules '((gnu build marionette)) @@ -472,9 +464,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "gitile") ;; XXX: Shepherd reads the config file *before* binding its control @@ -540,8 +530,7 @@ HTTP-PORT." (test-url "/test/tree/-/does-not-exist" 404) (test-url "/does-not-exist" 404)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "gitile-test" test)) diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 9f9d3a5e26..628cd0549b 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Christopher Baines <[email protected]> -;;; Copyright © 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2020, 2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]> ;;; Copyright © 2021 Pierre Langlois <[email protected]> ;;; @@ -73,9 +73,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "libvirt") (test-assert "service running" @@ -107,8 +105,7 @@ "-c" "qemu:///system" "connect")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "libvirt-test" test)) @@ -193,9 +190,7 @@ (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "childhurd") (test-assert "service running" @@ -250,8 +245,7 @@ (open-input-pipe #$run-uname-over-ssh))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "childhurd-test" test)) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 518c9c1ff3..4e8eceaa2b 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2017, 2020-2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2017, 2019 Christopher Baines <[email protected]> ;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]> ;;; Copyright © 2018 Pierre-Antoine Rouby <[email protected]> @@ -113,9 +113,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin #$name) (test-assert #$(string-append name " service running") @@ -150,8 +148,7 @@ HTTP-PORT." marionette))) '()) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -309,9 +306,7 @@ HTTP-PORT, along with php-fpm." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "php-fpm") (test-assert "php-fpm running" @@ -350,9 +345,7 @@ HTTP-PORT, along with php-fpm." (and matches (match:substring matches 0)))))) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "php-fpm-test" test)) @@ -394,9 +387,7 @@ HTTP-PORT, along with php-fpm." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin #$name) (test-assert "hpcguix-web running" @@ -422,8 +413,7 @@ HTTP-PORT, along with php-fpm." #:times 10 #:delay 5))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -438,7 +428,8 @@ HTTP-PORT, along with php-fpm." (service dhcp-client-service-type) (service hpcguix-web-service-type (hpcguix-web-configuration - (specs %hpcguix-web-specs))))) + (specs %hpcguix-web-specs) + (address "0.0.0.0"))))) (define %test-hpcguix-web (system-test @@ -486,9 +477,7 @@ HTTP-PORT." ;; port 8080 in the host. (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "tailon") (test-assert "service running" @@ -512,8 +501,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "tailon-test" test)) @@ -576,7 +564,7 @@ HTTP-PORT." (listen '("8080")))))) (service postgresql-service-type (postgresql-configuration - (postgresql postgresql-10))) + (postgresql postgresql))) (service patchwork-service-type (patchwork-configuration (patchwork patchwork) @@ -630,9 +618,7 @@ HTTP-PORT." (define marionette (make-marionette (list #$vm))) - (mkdir #$output) - (chdir #$output) - + (test-runner-current (system-test-runner #$output)) (test-begin "patchwork") (test-assert "patchwork-postgresql-user-and-service started" @@ -667,8 +653,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "patchwork-test" test)) |