Merge branch 'master' into staging

13 files changed, 1279 insertions, 852 deletions

diff --git a/gnu/tests/admin.scm b/gnu/tests/admin.scm
new file mode 100644
index 0000000000..3c7deb5426
--- /dev/null
+++ b/gnu/tests/admin.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests admin)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services admin)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:export (%test-tailon))
+
+(define %tailon-os
+  ;; Operating system under test.
+  (simple-operating-system
+   (dhcp-client-service)
+   (service tailon-service-type
+            (tailon-configuration
+             (config-file
+              (tailon-configuration-file
+               (bind "0.0.0.0:8080")))))))
+
+(define* (run-tailon-test #:optional (http-port 8081))
+  "Run tests in %TAILON-OS, which has tailon running and listening on
+HTTP-PORT."
+  (define os
+    (marionette-operating-system
+     %tailon-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((,http-port . 8080)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (ice-9 match)
+                       (gnu build marionette)
+                       (web uri)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            ;; Forward the guest's HTTP-PORT, where tailon is listening, to
+            ;; port 8080 in the host.
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "tailon")
+
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'tailon)
+                'running!)
+             marionette))
+
+          (define* (retry-on-error f #:key times delay)
+            (let loop ((attempt 1))
+              (match (catch
+                      #t
+                      (lambda ()
+                        (cons #t
+                              (f)))
+                      (lambda args
+                        (cons #f
+                              args)))
+                ((#t . return-value)
+                 return-value)
+                ((#f . error-args)
+                 (if (>= attempt times)
+                     error-args
+                     (begin
+                       (sleep delay)
+                       (loop (+ 1 attempt))))))))
+
+          (test-equal "http-get"
+            200
+            (retry-on-error
+             (lambda ()
+               (let-values (((response text)
+                             (http-get #$(format
+                                          #f
+                                          "http://localhost:~A/"
+                                          http-port)
+                                       #:decode-body? #t)))
+                 (response-code response)))
+             #:times 10
+             #:delay 5))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "tailon-test" test))
+
+(define %test-tailon
+  (system-test
+   (name "tailon")
+   (description "Connect to a running Tailon server.")
+   (value (run-tailon-test))))
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
new file mode 100644
index 0000000000..8eadaf02e1
--- /dev/null
+++ b/gnu/tests/audio.scm
@@ -0,0 +1,78 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests audio)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services audio)
+  #:use-module (gnu packages mpd)
+  #:use-module (guix gexp)
+  #:export (%test-mpd))
+
+(define %mpd-os
+  (simple-operating-system
+   (service mpd-service-type
+            (mpd-configuration
+             (user "root")))))
+
+(define (run-mpd-test)
+  "Run tests in %mpd-os, which has mpd running."
+  (define os
+    (marionette-operating-system
+     %mpd-os
+     #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine os))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (gnu build marionette))
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "mpd")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'mpd))
+             marionette))
+
+          (test-assert "mpc connect"
+            (marionette-eval
+             '(zero? (system #$(file-append mpd-mpc "/bin/mpc")))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+  (gexp->derivation "mpd-test" test))
+
+(define %test-mpd
+  (system-test
+   (name "mpd")
+   (description "Test that the mpd can run and be connected to.")
+   (value (run-mpd-test))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 8389b67f68..6132aa96ef 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -34,7 +34,6 @@
   #:use-module (gnu packages package-management)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (srfi srfi-1)
   #:export (run-basic-test
@@ -393,17 +392,16 @@ info --version")
     "Instrument %SIMPLE-OS, run it in a VM, and run a series of basic
 functionality tests.")
    (value
-    (mlet* %store-monad ((os -> (marionette-operating-system
-                                 %simple-os
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                         (run   (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
+    (let* ((os  (marionette-operating-system
+                 %simple-os
+                 #:imported-modules '((gnu services herd)
+                                      (guix combinators))))
+           (vm  (virtual-machine os)))
       ;; XXX: Add call to 'virtualized-operating-system' to get the exact same
       ;; set of services as the OS produced by
       ;; 'system-qemu-image/shared-store-script'.
       (run-basic-test (virtualized-operating-system os '())
-                      #~(list #$run))))))
+                      #~(list #$vm))))))
 
 
 ;;;
@@ -430,60 +428,60 @@ functionality tests.")
      (mcron-service (list job1 job2 job3)))))
 
 (define (run-mcron-test name)
-  (mlet* %store-monad ((os ->   (marionette-operating-system
-                                 %mcron-os
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (gnu build marionette)
-                         (srfi srfi-64)
-                         (ice-9 match))
-
-            (define marionette
-              (make-marionette (list #$command)))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "mcron")
-
-            (test-eq "service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'mcron)
-                  'running!)
-               marionette))
-
-            ;; Make sure root's mcron job runs, has its cwd set to "/root", and
-            ;; runs with the right UID/GID.
-            (test-equal "root's job"
-              '(0 0)
-              (wait-for-file "/root/witness" marionette))
-
-            ;; Likewise for Alice's job.  We cannot know what its GID is since
-            ;; it's chosen by 'groupadd', but it's strictly positive.
-            (test-assert "alice's job"
-              (match (wait-for-file "/home/alice/witness" marionette)
-                ((1000 gid)
-                 (>= gid 100))))
-
-            ;; Last, the job that uses a command; allows us to test whether
-            ;; $PATH is sane.  (Note that 'marionette-eval' stringifies objects
-            ;; that don't have a read syntax, hence the string.)
-            (test-equal "root's job with command"
-              "#<eof>"
-              (wait-for-file "/root/witness-touch" marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation name test)))
+  (define os
+    (marionette-operating-system
+     %mcron-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "mcron")
+
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'mcron)
+                'running!)
+             marionette))
+
+          ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+          ;; runs with the right UID/GID.
+          (test-equal "root's job"
+            '(0 0)
+            (wait-for-file "/root/witness" marionette))
+
+          ;; Likewise for Alice's job.  We cannot know what its GID is since
+          ;; it's chosen by 'groupadd', but it's strictly positive.
+          (test-assert "alice's job"
+            (match (wait-for-file "/home/alice/witness" marionette)
+              ((1000 gid)
+               (>= gid 100))))
+
+          ;; Last, the job that uses a command; allows us to test whether
+          ;; $PATH is sane.  (Note that 'marionette-eval' stringifies objects
+          ;; that don't have a read syntax, hence the string.)
+          (test-equal "root's job with command"
+            "#<eof>"
+            (wait-for-file "/root/witness-touch" marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %test-mcron
   (system-test
@@ -526,102 +524,102 @@ functionality tests.")
   ;; *after* nscd.  Failing to do that, libc will try to connect to nscd,
   ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
   ;; leading to '.local' resolution failures.
-  (mlet* %store-monad ((os -> (marionette-operating-system
-                               %avahi-os
-                               #:requirements '(nscd)
-                               #:imported-modules '((gnu services herd)
-                                                    (guix combinators))))
-                       (run   (system-qemu-image/shared-store-script
-                               os #:graphic? #f)))
-    (define mdns-host-name
-      (string-append (operating-system-host-name os)
-                     ".local"))
-
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (gnu build marionette)
-                         (srfi srfi-1)
-                         (srfi srfi-64)
-                         (ice-9 match))
-
-            (define marionette
-              (make-marionette (list #$run)))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "avahi")
-
-            (test-assert "wait for services"
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
+  (define os
+    (marionette-operating-system
+     %avahi-os
+     #:requirements '(nscd)
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
 
-                  (start-service 'nscd)
-
-                  ;; XXX: Work around a race condition in nscd: nscd creates its
-                  ;; PID file before it is listening on its socket.
-                  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
-                    (let try ()
-                      (catch 'system-error
-                        (lambda ()
-                          (connect sock AF_UNIX "/var/run/nscd/socket")
-                          (close-port sock)
-                          (format #t "nscd is ready~%"))
-                        (lambda args
-                          (format #t "waiting for nscd...~%")
-                          (usleep 500000)
-                          (try)))))
-
-                  ;; Wait for the other useful things.
-                  (start-service 'avahi-daemon)
-                  (start-service 'networking)
-
-                  #t)
-               marionette))
-
-            (test-equal "avahi-resolve-host-name"
-              0
-              (marionette-eval
-               '(system*
-                 "/run/current-system/profile/bin/avahi-resolve-host-name"
-                 "-v" #$mdns-host-name)
-               marionette))
+  (define mdns-host-name
+    (string-append (operating-system-host-name os)
+                   ".local"))
 
-            (test-equal "avahi-browse"
-              0
-              (marionette-eval
-               '(system* "avahi-browse" "-avt")
-               marionette))
-
-            (test-assert "getaddrinfo .local"
-              ;; Wait for the 'avahi-daemon' service and perform a resolution.
-              (match (marionette-eval
-                      '(getaddrinfo #$mdns-host-name)
-                      marionette)
-                (((? vector? addrinfos) ..1)
-                 (pk 'getaddrinfo addrinfos)
-                 (and (any (lambda (ai)
-                             (= AF_INET (addrinfo:fam ai)))
-                           addrinfos)
-                      (any (lambda (ai)
-                             (= AF_INET6 (addrinfo:fam ai)))
-                           addrinfos)))))
-
-            (test-assert "gethostbyname .local"
-              (match (pk 'gethostbyname
-                         (marionette-eval '(gethostbyname #$mdns-host-name)
-                                          marionette))
-                ((? vector? result)
-                 (and (string=? (hostent:name result) #$mdns-host-name)
-                      (= (hostent:addrtype result) AF_INET)))))
-
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "nss-mdns" test)))
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "avahi")
+
+          (test-assert "wait for services"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+
+                (start-service 'nscd)
+
+                ;; XXX: Work around a race condition in nscd: nscd creates its
+                ;; PID file before it is listening on its socket.
+                (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+                  (let try ()
+                    (catch 'system-error
+                      (lambda ()
+                        (connect sock AF_UNIX "/var/run/nscd/socket")
+                        (close-port sock)
+                        (format #t "nscd is ready~%"))
+                      (lambda args
+                        (format #t "waiting for nscd...~%")
+                        (usleep 500000)
+                        (try)))))
+
+                ;; Wait for the other useful things.
+                (start-service 'avahi-daemon)
+                (start-service 'networking)
+
+                #t)
+             marionette))
+
+          (test-equal "avahi-resolve-host-name"
+            0
+            (marionette-eval
+             '(system*
+               "/run/current-system/profile/bin/avahi-resolve-host-name"
+               "-v" #$mdns-host-name)
+             marionette))
+
+          (test-equal "avahi-browse"
+            0
+            (marionette-eval
+             '(system* "avahi-browse" "-avt")
+             marionette))
+
+          (test-assert "getaddrinfo .local"
+            ;; Wait for the 'avahi-daemon' service and perform a resolution.
+            (match (marionette-eval
+                    '(getaddrinfo #$mdns-host-name)
+                    marionette)
+              (((? vector? addrinfos) ..1)
+               (pk 'getaddrinfo addrinfos)
+               (and (any (lambda (ai)
+                           (= AF_INET (addrinfo:fam ai)))
+                         addrinfos)
+                    (any (lambda (ai)
+                           (= AF_INET6 (addrinfo:fam ai)))
+                         addrinfos)))))
+
+          (test-assert "gethostbyname .local"
+            (match (pk 'gethostbyname
+                       (marionette-eval '(gethostbyname #$mdns-host-name)
+                                        marionette))
+              ((? vector? result)
+               (and (string=? (hostent:name result) #$mdns-host-name)
+                    (= (hostent:addrtype result) AF_INET)))))
+
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "nss-mdns" test))
 
 (define %test-nss-mdns
   (system-test
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
new file mode 100644
index 0000000000..9d9a753747
--- /dev/null
+++ b/gnu/tests/databases.scm
@@ -0,0 +1,123 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests databases)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services databases)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:export (%test-memcached))
+
+(define %memcached-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (service memcached-service-type)))
+
+(define* (run-memcached-test #:optional (port 11211))
+  "Run tests in %MEMCACHED-OS, forwarding PORT."
+  (define os
+    (marionette-operating-system
+     %memcached-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((11211 . ,port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette)
+                       (ice-9 rdelim))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "memcached")
+
+          ;; Wait for memcached to be up and running.
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'memcached)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (let* ((ai (car (getaddrinfo "localhost"
+                                       #$(number->string port))))
+                 (s  (socket (addrinfo:fam ai)
+                             (addrinfo:socktype ai)
+                             (addrinfo:protocol ai)))
+                 (key "testkey")
+                 (value "guix"))
+            (connect s (addrinfo:addr ai))
+
+            (test-equal "set"
+              "STORED\r"
+              (begin
+                (simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
+                               key
+                               (string-length value)
+                               value)
+                (read-line s)))
+
+            (test-equal "get"
+              (simple-format #f "VALUE ~A 0 ~A\r~A\r"
+                             key
+                             (string-length value)
+                             value)
+              (begin
+                (simple-format s "get ~A\r\n" key)
+                (string-append
+                 (read-line s)
+                 (read-line s))))
+
+            (close-port s))
+
+          ;; There should be a log file in here.
+          (test-assert "log file"
+            (marionette-eval
+             '(file-exists? "/var/log/memcached")
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "memcached-test" test))
+
+(define %test-memcached
+  (system-test
+   (name "memcached")
+   (description "Connect to a running MEMCACHED server.")
+   (value (run-memcached-test))))
diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm
index 16b6edbd9e..b9c741e3e0 100644
--- a/gnu/tests/dict.scm
+++ b/gnu/tests/dict.scm
@@ -27,7 +27,6 @@
   #:use-module (gnu packages wordnet)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix modules)
   #:export (%test-dicod))
@@ -54,86 +53,90 @@
 
 (define* (run-dicod-test)
   "Run tests of 'dicod-service-type'."
-  (mlet* %store-monad ((os -> (marionette-operating-system
-                               %dicod-os
-                               #:imported-modules
-                               (source-module-closure '((gnu services herd)))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (ice-9 rdelim)
-                         (ice-9 regex)
-                         (srfi srfi-64)
-                         (gnu build marionette))
-            (define marionette
-              ;; Forward the guest's DICT port to local port 8000.
-              (make-marionette (list #$command "-net"
-                                     "user,hostfwd=tcp::8000-:2628")))
-
-            (define %dico-socket
-              (socket PF_INET SOCK_STREAM 0))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "dicod")
-
-            ;; Wait for the service to be started.
-            (test-eq "service is running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'dicod)
-                  'running!)
-               marionette))
-
-            ;; Wait until dicod is actually listening.
-            ;; TODO: Use a PID file instead.
-            (test-assert "connect inside"
-              (marionette-eval
-               '(begin
-                  (use-modules (ice-9 rdelim))
-                  (let ((sock (socket PF_INET SOCK_STREAM 0)))
-                    (let loop ((i 0))
-                      (pk 'try i)
-                      (catch 'system-error
-                        (lambda ()
-                          (connect sock AF_INET INADDR_LOOPBACK 2628))
-                        (lambda args
-                          (pk 'connection-error args)
-                          (when (< i 20)
-                            (sleep 1)
-                            (loop (+ 1 i))))))
-                    (read-line sock 'concat)))
-               marionette))
-
-            (test-assert "connect"
-              (let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
-                (connect %dico-socket addr)
-                (read-line %dico-socket 'concat)))
-
-            (test-equal "CLIENT"
-              "250 ok\r\n"
-              (begin
-                (display "CLIENT \"GNU Guile\"\r\n" %dico-socket)
-                (read-line %dico-socket 'concat)))
-
-            (test-assert "DEFINE"
-              (begin
-                (display "DEFINE ! hello\r\n" %dico-socket)
-                (display "QUIT\r\n" %dico-socket)
-                (let ((result (read-string %dico-socket)))
-                  (and (string-contains result "gcide")
-                       (string-contains result "hello")
-                       result))))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "dicod" test)))
+  (define os
+    (marionette-operating-system
+     %dicod-os
+     #:imported-modules
+     (source-module-closure '((gnu services herd)))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((8000 . 2628)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (ice-9 rdelim)
+                       (ice-9 regex)
+                       (srfi srfi-64)
+                       (gnu build marionette))
+          (define marionette
+            ;; Forward the guest's DICT port to local port 8000.
+            (make-marionette (list #$vm)))
+
+          (define %dico-socket
+            (socket PF_INET SOCK_STREAM 0))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "dicod")
+
+          ;; Wait for the service to be started.
+          (test-eq "service is running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'dicod)
+                'running!)
+             marionette))
+
+          ;; Wait until dicod is actually listening.
+          ;; TODO: Use a PID file instead.
+          (test-assert "connect inside"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (let ((sock (socket PF_INET SOCK_STREAM 0)))
+                  (let loop ((i 0))
+                    (pk 'try i)
+                    (catch 'system-error
+                      (lambda ()
+                        (connect sock AF_INET INADDR_LOOPBACK 2628))
+                      (lambda args
+                        (pk 'connection-error args)
+                        (when (< i 20)
+                          (sleep 1)
+                          (loop (+ 1 i))))))
+                  (read-line sock 'concat)))
+             marionette))
+
+          (test-assert "connect"
+            (let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
+              (connect %dico-socket addr)
+              (read-line %dico-socket 'concat)))
+
+          (test-equal "CLIENT"
+            "250 ok\r\n"
+            (begin
+              (display "CLIENT \"GNU Guile\"\r\n" %dico-socket)
+              (read-line %dico-socket 'concat)))
+
+          (test-assert "DEFINE"
+            (begin
+              (display "DEFINE ! hello\r\n" %dico-socket)
+              (display "QUIT\r\n" %dico-socket)
+              (let ((result (read-string %dico-socket)))
+                (and (string-contains result "gcide")
+                     (string-contains result "hello")
+                     result))))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "dicod" test))
 
 (define %test-dicod
   (system-test
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 7c5d48104e..866bf885ce 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -27,8 +27,8 @@
   #:use-module ((gnu build vm) #:select (qemu-command))
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages ocr)
-  #:use-module (gnu packages qemu)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages virtualization)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix packages)
@@ -59,7 +59,7 @@
     (timezone "Europe/Paris")
     (locale "en_US.UTF-8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device "my-root")
@@ -98,7 +98,7 @@
 
     (bootloader (bootloader-configuration
                  (bootloader extlinux-bootloader-gpt)
-                 (device "/dev/vdb")))
+                 (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device "my-root")
@@ -326,7 +326,7 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.")
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons* (file-system
                            (device "my-root")
@@ -384,7 +384,7 @@ partition.  In particular, home directories must be correctly created (see
     (timezone "Europe/Paris")
     (locale "en_US.UTF-8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons* (file-system
                            (device "root-fs")
@@ -460,7 +460,7 @@ where /gnu lives on a separate partition.")
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (initrd (lambda (file-systems . rest)
               ;; Add a kernel module for RAID-0 (aka. "stripe").
@@ -543,7 +543,7 @@ by 'mdadm'.")
     (timezone "Europe/Paris")
     (locale "en_US.UTF-8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
 
     ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
     ;; detection logic in 'enter-luks-passphrase'.
@@ -670,7 +670,7 @@ build (current-guix) and then store a couple of full system images.")
     (timezone "Europe/Paris")
     (locale "en_US.UTF-8")
 
-    (bootloader (grub-configuration (device "/dev/vdb")))
+    (bootloader (grub-configuration (target "/dev/vdb")))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device "my-root")
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 247f4f667f..312df9b1cd 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,7 +26,6 @@
   #:use-module (gnu services mail)
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
-  #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (ice-9 ftw)
   #:export (%test-opensmtpd
@@ -44,105 +44,105 @@ accept from any for local deliver to mbox
 
 (define (run-opensmtpd-test)
   "Return a test of an OS running OpenSMTPD service."
-  (mlet* %store-monad ((command (system-qemu-image/shared-store-script
-                                 (marionette-operating-system
-                                  %opensmtpd-os
-                                  #:imported-modules '((gnu services herd)))
-                                 #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (rnrs base)
-                         (srfi srfi-64)
-                         (ice-9 rdelim)
-                         (ice-9 regex)
-                         (gnu build marionette))
-
-            (define marionette
-              (make-marionette
-               ;; Enable TCP forwarding of the guest's port 25.
-               '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
-
-            (define (read-reply-code port)
-              "Read a SMTP reply from PORT and return its reply code."
-              (let* ((line      (read-line port))
-                     (mo        (string-match "([0-9]+)([ -]).*" line))
-                     (code      (string->number (match:substring mo 1)))
-                     (finished? (string= " " (match:substring mo 2))))
-                (if finished?
-                    code
-                    (read-reply-code port))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "opensmptd")
-
-            (test-assert "service is running"
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'smtpd)
-                  #t)
-               marionette))
-
-            (test-assert "mbox is empty"
-              (marionette-eval
-               '(and (file-exists? "/var/mail")
-                     (not (file-exists? "/var/mail/root")))
-               marionette))
-
-            (test-eq "accept an email"
-              #t
-              (let* ((smtp (socket AF_INET SOCK_STREAM 0))
-                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
-                (connect smtp addr)
-                ;; Be greeted.
-                (read-reply-code smtp)             ;220
-                ;; Greet the server.
-                (write-line "EHLO somehost" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Set sender email.
-                (write-line "MAIL FROM: <someone>" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Set recipient email.
-                (write-line "RCPT TO: <root>" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Send message.
-                (write-line "DATA" smtp)
-                (read-reply-code smtp)             ;354
-                (write-line "Subject: Hello" smtp)
-                (newline smtp)
-                (write-line "Nice to meet you!" smtp)
-                (write-line "." smtp)
-                (read-reply-code smtp)             ;250
-                ;; Say goodbye.
-                (write-line "QUIT" smtp)
-                (read-reply-code smtp)             ;221
-                (close smtp)
-                #t))
-
-            (test-assert "mail arrived"
-              (marionette-eval
-               '(begin
-                  (use-modules (ice-9 popen)
-                               (ice-9 rdelim))
-
-                  (define (queue-empty?)
-                    (eof-object?
-                     (read-line
-                      (open-input-pipe "smtpctl show queue"))))
-
-                  (let wait ()
-                    (if (queue-empty?)
-                        (file-exists? "/var/mail/root")
-                        (begin (sleep 1) (wait)))))
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "opensmtpd-test" test)))
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %opensmtpd-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1025 . 25)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (rnrs base)
+                       (srfi srfi-64)
+                       (ice-9 rdelim)
+                       (ice-9 regex)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define (read-reply-code port)
+            "Read a SMTP reply from PORT and return its reply code."
+            (let* ((line      (read-line port))
+                   (mo        (string-match "([0-9]+)([ -]).*" line))
+                   (code      (string->number (match:substring mo 1)))
+                   (finished? (string= " " (match:substring mo 2))))
+              (if finished?
+                  code
+                  (read-reply-code port))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "opensmptd")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'smtpd)
+                #t)
+             marionette))
+
+          (test-assert "mbox is empty"
+            (marionette-eval
+             '(and (file-exists? "/var/mail")
+                   (not (file-exists? "/var/mail/root")))
+             marionette))
+
+          (test-eq "accept an email"
+            #t
+            (let* ((smtp (socket AF_INET SOCK_STREAM 0))
+                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
+              (connect smtp addr)
+              ;; Be greeted.
+              (read-reply-code smtp)              ;220
+              ;; Greet the server.
+              (write-line "EHLO somehost" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Set sender email.
+              (write-line "MAIL FROM: <someone>" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Set recipient email.
+              (write-line "RCPT TO: <root>" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Send message.
+              (write-line "DATA" smtp)
+              (read-reply-code smtp)              ;354
+              (write-line "Subject: Hello" smtp)
+              (newline smtp)
+              (write-line "Nice to meet you!" smtp)
+              (write-line "." smtp)
+              (read-reply-code smtp)              ;250
+              ;; Say goodbye.
+              (write-line "QUIT" smtp)
+              (read-reply-code smtp)              ;221
+              (close smtp)
+              #t))
+
+          (test-assert "mail arrived"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 popen)
+                             (ice-9 rdelim))
+
+                (define (queue-empty?)
+                  (eof-object?
+                   (read-line
+                    (open-input-pipe "smtpctl show queue"))))
+
+                (let wait ()
+                  (if (queue-empty?)
+                      (file-exists? "/var/mail/root")
+                      (begin (sleep 1) (wait)))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "opensmtpd-test" test))
 
 (define %test-opensmtpd
   (system-test
@@ -179,100 +179,100 @@ acl_check_data:
 
 (define (run-exim-test)
   "Return a test of an OS running an Exim service."
-  (mlet* %store-monad ((command (system-qemu-image/shared-store-script
-                                 (marionette-operating-system
-                                  %exim-os
-                                  #:imported-modules '((gnu services herd)))
-                                 #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette)
-                               (ice-9 ftw))
-        #~(begin
-            (use-modules (rnrs base)
-                         (srfi srfi-64)
-                         (ice-9 ftw)
-                         (ice-9 rdelim)
-                         (ice-9 regex)
-                         (gnu build marionette))
-
-            (define marionette
-              (make-marionette
-               ;; Enable TCP forwarding of the guest's port 25.
-               '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
-
-            (define (read-reply-code port)
-              "Read a SMTP reply from PORT and return its reply code."
-              (let* ((line      (read-line port))
-                     (mo        (string-match "([0-9]+)([ -]).*" line))
-                     (code      (string->number (match:substring mo 1)))
-                     (finished? (string= " " (match:substring mo 2))))
-                (if finished?
-                    code
-                    (read-reply-code port))))
-
-            (define smtp (socket AF_INET SOCK_STREAM 0))
-            (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "exim")
-
-            (test-assert "service is running"
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'exim)
-                  #t)
-               marionette))
-
-            (sleep 1) ;; give the service time to start talking
-
-            (connect smtp addr)
-            ;; Be greeted.
-            (test-eq "greeting received"
-              220 (read-reply-code smtp))
-            ;; Greet the server.
-            (write-line "EHLO somehost" smtp)
-            (test-eq "greeting successful"
-              250 (read-reply-code smtp))
-            ;; Set sender email.
-            (write-line "MAIL FROM: test@example.com" smtp)
-            (test-eq "sender set"
-              250 (read-reply-code smtp)) ;250
-            ;; Set recipient email.
-            (write-line "RCPT TO: root@komputilo" smtp)
-            (test-eq "recipient set"
-              250 (read-reply-code smtp)) ;250
-            ;; Send message.
-            (write-line "DATA" smtp)
-            (test-eq "data begun"
-              354 (read-reply-code smtp)) ;354
-            (write-line "Subject: Hello" smtp)
-            (newline smtp)
-            (write-line "Nice to meet you!" smtp)
-            (write-line "." smtp)
-            (test-eq "message sent"
-              250 (read-reply-code smtp)) ;250
-            ;; Say goodbye.
-            (write-line "QUIT" smtp)
-            (test-eq "quit successful"
-              221 (read-reply-code smtp)) ;221
-            (close smtp)
-
-            (test-eq "the email is received"
-              1
-              (marionette-eval
-               '(begin
-                  (use-modules (ice-9 ftw))
-                  (length (scandir "/var/spool/exim/msglog"
-                                   (lambda (x) (not (string-prefix? "." x))))))
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "exim-test" test)))
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %exim-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1025 . 25)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (ice-9 ftw))
+      #~(begin
+          (use-modules (rnrs base)
+                       (srfi srfi-64)
+                       (ice-9 ftw)
+                       (ice-9 rdelim)
+                       (ice-9 regex)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define (read-reply-code port)
+            "Read a SMTP reply from PORT and return its reply code."
+            (let* ((line      (read-line port))
+                   (mo        (string-match "([0-9]+)([ -]).*" line))
+                   (code      (string->number (match:substring mo 1)))
+                   (finished? (string= " " (match:substring mo 2))))
+              (if finished?
+                  code
+                  (read-reply-code port))))
+
+          (define smtp (socket AF_INET SOCK_STREAM 0))
+          (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "exim")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'exim)
+                #t)
+             marionette))
+
+          (sleep 1) ;; give the service time to start talking
+
+          (connect smtp addr)
+          ;; Be greeted.
+          (test-eq "greeting received"
+            220 (read-reply-code smtp))
+          ;; Greet the server.
+          (write-line "EHLO somehost" smtp)
+          (test-eq "greeting successful"
+            250 (read-reply-code smtp))
+          ;; Set sender email.
+          (write-line "MAIL FROM: test@example.com" smtp)
+          (test-eq "sender set"
+            250 (read-reply-code smtp))           ;250
+          ;; Set recipient email.
+          (write-line "RCPT TO: root@komputilo" smtp)
+          (test-eq "recipient set"
+            250 (read-reply-code smtp))           ;250
+          ;; Send message.
+          (write-line "DATA" smtp)
+          (test-eq "data begun"
+            354 (read-reply-code smtp))           ;354
+          (write-line "Subject: Hello" smtp)
+          (newline smtp)
+          (write-line "Nice to meet you!" smtp)
+          (write-line "." smtp)
+          (test-eq "message sent"
+            250 (read-reply-code smtp))           ;250
+          ;; Say goodbye.
+          (write-line "QUIT" smtp)
+          (test-eq "quit successful"
+            221 (read-reply-code smtp))           ;221
+          (close smtp)
+
+          (test-eq "the email is received"
+            1
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 ftw))
+                (length (scandir "/var/spool/exim/msglog"
+                                 (lambda (x) (not (string-prefix? "." x))))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "exim-test" test))
 
 (define %test-exim
   (system-test
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index b76b8e8434..0ba0c839de 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,108 +27,109 @@
   #:use-module (gnu packages messaging)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:export (%test-prosody))
 
 (define (run-xmpp-test name xmpp-service pid-file create-account)
   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
-  (mlet* %store-monad ((os -> (marionette-operating-system
-                               (simple-operating-system (dhcp-client-service)
-                                                        xmpp-service)
-                               #:imported-modules '((gnu services herd))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f))
-                       (username -> "alice")
-                       (server -> "localhost")
-                       (jid -> (string-append username "@" server))
-                       (password -> "correct horse battery staple")
-                       (port -> 15222)
-                       (message -> "hello world")
-                       (witness -> "/tmp/freetalk-witness"))
-
-    (define script.ft
-      (scheme-file
-       "script.ft"
-       #~(begin
-           (define (handle-received-message time from nickname message)
-             (define (touch file-name)
-               (call-with-output-file file-name (const #t)))
-             (when (equal? message #$message)
-               (touch #$witness)))
-           (add-hook! ft-message-receive-hook handle-received-message)
-
-           (ft-set-jid! #$jid)
-           (ft-set-password! #$password)
-           (ft-set-server! #$server)
-           (ft-set-port! #$port)
-           (ft-set-sslconn! #f)
-           (ft-connect-blocking)
-           (ft-send-message #$jid #$message)
-
-           (ft-set-daemon)
-           (ft-main-loop))))
-
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (gnu build marionette)
-                         (srfi srfi-64))
-
-            (define marionette
-              ;; Enable TCP forwarding of the guest's port 5222.
-              (make-marionette (list #$command "-net"
-                                     (string-append "user,hostfwd=tcp::"
-                                                    (number->string #$port)
-                                                    "-:5222"))))
-
-            (define (host-wait-for-file file)
-              ;; Wait until FILE exists in the host.
-              (let loop ((i 60))
-                (cond ((file-exists? file)
-                       #t)
-                      ((> i 0)
-                       (begin
-                         (sleep 1))
-                       (loop (- i 1)))
-                      (else
-                       (error "file didn't show up" file)))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "xmpp")
-
-            ;; Wait for XMPP service to be up and running.
-            (test-eq "service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'xmpp-daemon)
-                  'running!)
-               marionette))
-
-            ;; Check XMPP service's PID.
-            (test-assert "service process id"
-              (let ((pid (number->string (wait-for-file #$pid-file
-                                                        marionette))))
-                (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
-                                 marionette)))
-
-            ;; Alice sends an XMPP message to herself, with Freetalk.
-            (test-assert "client-to-server communication"
-              (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
-                (marionette-eval '(system* #$create-account #$jid #$password)
-                                 marionette)
-                ;; Freetalk requires write access to $HOME.
-                (setenv "HOME" "/tmp")
-                (system* freetalk-bin "-s" #$script.ft)
-                (host-wait-for-file #$witness)))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation name test)))
+  (define os
+    (marionette-operating-system
+     (simple-operating-system (dhcp-client-service)
+                              xmpp-service)
+     #:imported-modules '((gnu services herd))))
+
+  (define port 15222)
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((,port . 5222)))))
+
+  (define username "alice")
+  (define server "localhost")
+  (define jid (string-append username "@" server))
+  (define password "correct horse battery staple")
+  (define message "hello world")
+  (define witness "/tmp/freetalk-witness")
+
+  (define script.ft
+    (scheme-file
+     "script.ft"
+     #~(begin
+         (define (handle-received-message time from nickname message)
+           (define (touch file-name)
+             (call-with-output-file file-name (const #t)))
+           (when (equal? message #$message)
+             (touch #$witness)))
+         (add-hook! ft-message-receive-hook handle-received-message)
+
+         (ft-set-jid! #$jid)
+         (ft-set-password! #$password)
+         (ft-set-server! #$server)
+         (ft-set-port! #$port)
+         (ft-set-sslconn! #f)
+         (ft-connect-blocking)
+         (ft-send-message #$jid #$message)
+
+         (ft-set-daemon)
+         (ft-main-loop))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (define (host-wait-for-file file)
+            ;; Wait until FILE exists in the host.
+            (let loop ((i 60))
+              (cond ((file-exists? file)
+                     #t)
+                    ((> i 0)
+                     (begin
+                       (sleep 1))
+                     (loop (- i 1)))
+                    (else
+                     (error "file didn't show up" file)))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "xmpp")
+
+          ;; Wait for XMPP service to be up and running.
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'xmpp-daemon)
+                'running!)
+             marionette))
+
+          ;; Check XMPP service's PID.
+          (test-assert "service process id"
+            (let ((pid (number->string (wait-for-file #$pid-file
+                                                      marionette))))
+              (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
+                               marionette)))
+
+          ;; Alice sends an XMPP message to herself, with Freetalk.
+          (test-assert "client-to-server communication"
+            (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
+              (marionette-eval '(system* #$create-account #$jid #$password)
+                               marionette)
+              ;; Freetalk requires write access to $HOME.
+              (setenv "HOME" "/tmp")
+              (system* freetalk-bin "-s" #$script.ft)
+              (host-wait-for-file #$witness)))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %create-prosody-account
   (program-file
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index cfcb490874..aeee105a1c 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -74,60 +74,61 @@ done" ))))))))))
 (define* (run-inetd-test)
   "Run tests in %INETD-OS, where the inetd service provides an echo service on
 port 7, and a dict service on port 2628."
-  (mlet* %store-monad ((os -> (marionette-operating-system %inetd-os))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (ice-9 rdelim)
-                         (srfi srfi-64)
-                         (gnu build marionette))
-            (define marionette
-              ;; Forward guest ports 7 and 2628 to host ports 8007 and 8628.
-              (make-marionette (list #$command "-net"
-                                     (string-append
-                                      "user"
-                                      ",hostfwd=tcp::8007-:7"
-                                      ",hostfwd=tcp::8628-:2628"))))
+  (define os
+    (marionette-operating-system %inetd-os))
 
-            (mkdir #$output)
-            (chdir #$output)
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((8007 . 7)
+                         (8628 . 2628)))))
 
-            (test-begin "inetd")
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (ice-9 rdelim)
+                       (srfi srfi-64)
+                       (gnu build marionette))
+          (define marionette
+            (make-marionette (list #$vm)))
 
-            ;; Make sure the PID file is created.
-            (test-assert "PID file"
-              (marionette-eval
-               '(file-exists? "/var/run/inetd.pid")
-              marionette))
+          (mkdir #$output)
+          (chdir #$output)
 
-            ;; Test the echo service.
-            (test-equal "echo response"
-              "Hello, Guix!"
-              (let ((echo (socket PF_INET SOCK_STREAM 0))
-                    (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
-                (connect echo addr)
-                (display "Hello, Guix!\n" echo)
-                (let ((response (read-line echo)))
-                  (close echo)
-                  response)))
+          (test-begin "inetd")
 
-            ;; Test the dict service
-            (test-equal "dict response"
-              "GNU Guix is a package management tool for the GNU system."
-              (let ((dict (socket PF_INET SOCK_STREAM 0))
-                    (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
-                (connect dict addr)
-                (display "DEFINE Guix\n" dict)
-                (let ((response (read-line dict)))
-                  (close dict)
-                  response)))
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/inetd.pid")
+             marionette))
 
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+          ;; Test the echo service.
+          (test-equal "echo response"
+            "Hello, Guix!"
+            (let ((echo (socket PF_INET SOCK_STREAM 0))
+                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
+              (connect echo addr)
+              (display "Hello, Guix!\n" echo)
+              (let ((response (read-line echo)))
+                (close echo)
+                response)))
 
-    (gexp->derivation "inetd-test" test)))
+          ;; Test the dict service
+          (test-equal "dict response"
+            "GNU Guix is a package management tool for the GNU system."
+            (let ((dict (socket PF_INET SOCK_STREAM 0))
+                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
+              (connect dict addr)
+              (display "DEFINE Guix\n" dict)
+              (let ((response (read-line dict)))
+                (close dict)
+                response)))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "inetd-test" test))
 
 (define %test-inetd
   (system-test
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 9e1ac1d55a..889f578d01 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
@@ -41,7 +41,7 @@
     (timezone "Europe/Berlin")
     (locale "en_US.UTF-8")
 
-    (bootloader (grub-configuration (device "/dev/sdX")))
+    (bootloader (grub-configuration (target "/dev/sdX")))
     (file-systems %base-file-systems)
     (users %base-user-accounts)
     (packages (cons*
@@ -55,75 +55,75 @@
 
 (define (run-nfs-test name socket)
   "Run a test of an OS running RPC-SERVICE, which should create SOCKET."
-  (mlet* %store-monad ((os ->   (marionette-operating-system
-                                 %base-os
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (gnu build marionette)
-                         (srfi srfi-64))
-
-            (define marionette
-              (make-marionette (list #$command)))
-
-            (define (wait-for-socket file)
-              ;; Wait until SOCKET  exists in the guest
-              (marionette-eval
-               `(let loop ((i 10))
-                  (cond ((and (file-exists? ,file)
-                              (eq? 'socket (stat:type (stat ,file))))
-                         #t)
-                        ((> i 0)
-                         (sleep 1)
-                         (loop (- i 1)))
-                        (else
-                         (error "Socket didn't show up: " ,file))))
-               marionette))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "rpc-daemon")
-
-            ;; Wait for the rpcbind daemon to be up and running.
-            (test-eq "RPC service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'rpcbind-daemon)
-                  'running!)
-               marionette))
-
-            ;; Check the socket file and that the service is still running.
-            (test-assert "RPC socket exists"
-              (and
-                (wait-for-socket #$socket)
-                (marionette-eval
-                 '(begin
-                    (use-modules (gnu services herd)
-                                 (srfi srfi-1))
-
-                    (live-service-running
-                     (find (lambda (live)
-                             (memq 'rpcbind-daemon
-                                   (live-service-provision live)))
-                           (current-services))))
-                 marionette)))
-
-            (test-assert "Probe RPC daemon"
-              (marionette-eval
-               '(zero? (system* "rpcinfo" "-p"))
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation name test)))
+  (define os
+    (marionette-operating-system
+     %base-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (define (wait-for-socket file)
+            ;; Wait until SOCKET  exists in the guest
+            (marionette-eval
+             `(let loop ((i 10))
+                (cond ((and (file-exists? ,file)
+                            (eq? 'socket (stat:type (stat ,file))))
+                       #t)
+                      ((> i 0)
+                       (sleep 1)
+                       (loop (- i 1)))
+                      (else
+                       (error "Socket didn't show up: " ,file))))
+             marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "rpc-daemon")
+
+          ;; Wait for the rpcbind daemon to be up and running.
+          (test-eq "RPC service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'rpcbind-daemon)
+                'running!)
+             marionette))
+
+          ;; Check the socket file and that the service is still running.
+          (test-assert "RPC socket exists"
+            (and
+             (wait-for-socket #$socket)
+             (marionette-eval
+              '(begin
+                 (use-modules (gnu services herd)
+                              (srfi srfi-1))
+
+                 (live-service-running
+                  (find (lambda (live)
+                          (memq 'rpcbind-daemon
+                                (live-service-provision live)))
+                        (current-services))))
+              marionette)))
+
+          (test-assert "Probe RPC daemon"
+            (marionette-eval
+             '(zero? (system* "rpcinfo" "-p"))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %test-nfs
   (system-test
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 9c83a9cd48..41be360355 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -27,7 +27,6 @@
   #:use-module (gnu packages ssh)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:export (%test-openssh
             %test-dropbear))
 
@@ -37,142 +36,143 @@ SSH-SERVICE must be configured to listen on port 22 and to allow for root and
 empty-password logins.
 
 When SFTP? is true, run an SFTP server test."
-  (mlet* %store-monad ((os ->   (marionette-operating-system
-                                 (simple-operating-system
-                                  (dhcp-client-service)
-                                  ssh-service)
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (eval-when (expand load eval)
-              ;; Prepare to use Guile-SSH.
-              (set! %load-path
-                (cons (string-append #+guile2.0-ssh "/share/guile/site/"
-                                     (effective-version))
-                      %load-path)))
-
-            (use-modules (gnu build marionette)
-                         (srfi srfi-26)
-                         (srfi srfi-64)
-                         (ice-9 match)
-                         (ssh session)
-                         (ssh auth)
-                         (ssh channel)
-                         (ssh sftp))
-
-            (define marionette
-              ;; Enable TCP forwarding of the guest's port 22.
-              (make-marionette (list #$command "-net"
-                                     "user,hostfwd=tcp::2222-:22")))
-
-            (define (make-session-for-test)
-              "Make a session with predefined parameters for a test."
-              (make-session #:user "root"
-                            #:port 2222
-                            #:host "localhost"
-                            #:log-verbosity 'protocol))
-
-            (define (call-with-connected-session proc)
-              "Call the one-argument procedure PROC with a freshly created and
+  (define os
+    (marionette-operating-system
+     (simple-operating-system (dhcp-client-service) ssh-service)
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((2222 . 22)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (eval-when (expand load eval)
+            ;; Prepare to use Guile-SSH.
+            (set! %load-path
+              (cons (string-append #+guile-ssh "/share/guile/site/"
+                                   (effective-version))
+                    %load-path)))
+
+          (use-modules (gnu build marionette)
+                       (srfi srfi-26)
+                       (srfi srfi-64)
+                       (ice-9 match)
+                       (ssh session)
+                       (ssh auth)
+                       (ssh channel)
+                       (ssh sftp))
+
+          (define marionette
+            ;; Enable TCP forwarding of the guest's port 22.
+            (make-marionette (list #$vm)))
+
+          (define (make-session-for-test)
+            "Make a session with predefined parameters for a test."
+            (make-session #:user "root"
+                          #:port 2222
+                          #:host "localhost"
+                          #:log-verbosity 'protocol))
+
+          (define (call-with-connected-session proc)
+            "Call the one-argument procedure PROC with a freshly created and
 connected SSH session object, return the result of the procedure call.  The
 session is disconnected when the PROC is finished."
-              (let ((session (make-session-for-test)))
-                (dynamic-wind
-                  (lambda ()
-                    (let ((result (connect! session)))
-                      (unless (equal? result 'ok)
-                        (error "Could not connect to a server"
-                               session result))))
-                  (lambda () (proc session))
-                  (lambda () (disconnect! session)))))
-
-            (define (call-with-connected-session/auth proc)
-              "Make an authenticated session.  We should be able to connect as
+            (let ((session (make-session-for-test)))
+              (dynamic-wind
+                (lambda ()
+                  (let ((result (connect! session)))
+                    (unless (equal? result 'ok)
+                      (error "Could not connect to a server"
+                             session result))))
+                (lambda () (proc session))
+                (lambda () (disconnect! session)))))
+
+          (define (call-with-connected-session/auth proc)
+            "Make an authenticated session.  We should be able to connect as
 root with an empty password."
-              (call-with-connected-session
-               (lambda (session)
-                 ;; Try the simple authentication methods.  Dropbear requires
-                 ;; 'none' when there are no passwords, whereas OpenSSH accepts
-                 ;; 'password' with an empty password.
-                 (let loop ((methods (list (cut userauth-password! <> "")
-                                           (cut userauth-none! <>))))
-                   (match methods
-                     (()
-                      (error "all the authentication methods failed"))
-                     ((auth rest ...)
-                      (match (pk 'auth (auth session))
-                        ('success
-                         (proc session))
-                        ('denied
-                         (loop rest)))))))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "ssh-daemon")
-
-            ;; Wait for sshd to be up and running.
-            (test-eq "service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'ssh-daemon)
-                  'running!)
-               marionette))
-
-            ;; Check sshd's PID file.
-            (test-equal "sshd PID"
-              (wait-for-file #$pid-file marionette)
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd)
-                               (srfi srfi-1))
-
-                  (live-service-running
-                   (find (lambda (live)
-                           (memq 'ssh-daemon
-                                 (live-service-provision live)))
-                         (current-services))))
-               marionette))
-
-            ;; Connect to the guest over SSH.  Make sure we can run a shell
-            ;; command there.
-            (test-equal "shell command"
-              'hello
-              (call-with-connected-session/auth
-               (lambda (session)
-                 ;; FIXME: 'get-server-public-key' segfaults.
-                 ;; (get-server-public-key session)
-                 (let ((channel (make-channel session)))
-                   (channel-open-session channel)
-                   (channel-request-exec channel "echo hello > /root/witness")
-                   (and (zero? (channel-get-exit-status channel))
-                        (wait-for-file "/root/witness" marionette))))))
-
-            ;; Connect to the guest over SFTP.  Make sure we can write and
-            ;; read a file there.
-            (unless #$sftp?
-              (test-skip 1))
-            (test-equal "SFTP file writing and reading"
-              'hello
-              (call-with-connected-session/auth
-               (lambda (session)
-                 (let ((sftp-session (make-sftp-session session))
-                       (witness "/root/sftp-witness"))
-                   (call-with-remote-output-file sftp-session witness
-                                                 (cut display "hello" <>))
-                   (call-with-remote-input-file sftp-session witness
-                                                read)))))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation name test)))
+            (call-with-connected-session
+             (lambda (session)
+               ;; Try the simple authentication methods.  Dropbear requires
+               ;; 'none' when there are no passwords, whereas OpenSSH accepts
+               ;; 'password' with an empty password.
+               (let loop ((methods (list (cut userauth-password! <> "")
+                                         (cut userauth-none! <>))))
+                 (match methods
+                   (()
+                    (error "all the authentication methods failed"))
+                   ((auth rest ...)
+                    (match (pk 'auth (auth session))
+                      ('success
+                       (proc session))
+                      ('denied
+                       (loop rest)))))))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "ssh-daemon")
+
+          ;; Wait for sshd to be up and running.
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'ssh-daemon)
+                'running!)
+             marionette))
+
+          ;; Check sshd's PID file.
+          (test-equal "sshd PID"
+            (wait-for-file #$pid-file marionette)
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd)
+                             (srfi srfi-1))
+
+                (live-service-running
+                 (find (lambda (live)
+                         (memq 'ssh-daemon
+                               (live-service-provision live)))
+                       (current-services))))
+             marionette))
+
+          ;; Connect to the guest over SSH.  Make sure we can run a shell
+          ;; command there.
+          (test-equal "shell command"
+            'hello
+            (call-with-connected-session/auth
+             (lambda (session)
+               ;; FIXME: 'get-server-public-key' segfaults.
+               ;; (get-server-public-key session)
+               (let ((channel (make-channel session)))
+                 (channel-open-session channel)
+                 (channel-request-exec channel "echo hello > /root/witness")
+                 (and (zero? (channel-get-exit-status channel))
+                      (wait-for-file "/root/witness" marionette))))))
+
+          ;; Connect to the guest over SFTP.  Make sure we can write and
+          ;; read a file there.
+          (unless #$sftp?
+            (test-skip 1))
+          (test-equal "SFTP file writing and reading"
+            'hello
+            (call-with-connected-session/auth
+             (lambda (session)
+               (let ((sftp-session (make-sftp-session session))
+                     (witness "/root/sftp-witness"))
+                 (call-with-remote-output-file sftp-session witness
+                                               (cut display "hello" <>))
+                 (call-with-remote-input-file sftp-session witness
+                                              read)))))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %test-openssh
   (system-test
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
new file mode 100644
index 0000000000..c2939355b2
--- /dev/null
+++ b/gnu/tests/virtualization.scm
@@ -0,0 +1,95 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests virtualization)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services virtualization)
+  #:use-module (gnu packages virtualization)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:export (%test-libvirt))
+
+(define %libvirt-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (dbus-service)
+   (polkit-service)
+   (service libvirt-service-type)))
+
+(define (run-libvirt-test)
+  "Run tests in %LIBVIRT-OS."
+  (define os
+    (marionette-operating-system
+     %libvirt-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "libvirt")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'libvirtd)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (test-eq "fetch version"
+            0
+            (marionette-eval
+             `(begin
+                (system* ,(string-append #$libvirt "/bin/virsh")
+                         "-c" "qemu:///system" "version"))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "libvirt-test" test))
+
+(define %test-libvirt
+  (system-test
+   (name "libvirt")
+   (description "Connect to the running LIBVIRT service.")
+   (value (run-libvirt-test))))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index bc7e3b89a9..3fa272c676 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -27,7 +27,6 @@
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:export (%test-nginx))
 
 (define %index.html-contents
@@ -65,68 +64,68 @@
 (define* (run-nginx-test #:optional (http-port 8042))
   "Run tests in %NGINX-OS, which has nginx running and listening on
 HTTP-PORT."
-  (mlet* %store-monad ((os ->   (marionette-operating-system
-                                 %nginx-os
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (srfi srfi-11) (srfi srfi-64)
-                         (gnu build marionette)
-                         (web uri)
-                         (web client)
-                         (web response))
-
-            (define marionette
-              ;; Forward the guest's HTTP-PORT, where nginx is listening, to
-              ;; port 8080 in the host.
-              (make-marionette (list #$command "-net"
-                                     (string-append
-                                      "user,hostfwd=tcp::8080-:"
-                                      #$(number->string http-port)))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "nginx")
-
-            ;; Wait for nginx to be up and running.
-            (test-eq "service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'nginx)
-                  'running!)
-               marionette))
-
-            ;; Make sure the PID file is created.
-            (test-assert "PID file"
-              (marionette-eval
-               '(file-exists? "/var/run/nginx/pid")
-               marionette))
-
-            ;; Retrieve the index.html file we put in /srv.
-            (test-equal "http-get"
-              '(200 #$%index.html-contents)
-              (let-values (((response text)
-                            (http-get "http://localhost:8080/index.html"
-                                      #:decode-body? #t)))
-                (list (response-code response) text)))
-
-            ;; There should be a log file in here.
-            (test-assert "log file"
-              (marionette-eval
-               '(file-exists? "/var/log/nginx/access.log")
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "nginx-test" test)))
+  (define os
+    (marionette-operating-system
+     %nginx-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((8080 . ,http-port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette)
+                       (web uri)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "nginx")
+
+          ;; Wait for nginx to be up and running.
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'nginx)
+                'running!)
+             marionette))
+
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/nginx/pid")
+             marionette))
+
+          ;; Retrieve the index.html file we put in /srv.
+          (test-equal "http-get"
+            '(200 #$%index.html-contents)
+            (let-values (((response text)
+                          (http-get "http://localhost:8080/index.html"
+                                    #:decode-body? #t)))
+              (list (response-code response) text)))
+
+          ;; There should be a log file in here.
+          (test-assert "log file"
+            (marionette-eval
+             '(file-exists? "/var/log/nginx/access.log")
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "nginx-test" test))
 
 (define %test-nginx
   (system-test