Merge branch 'master' into core-updates

2 files changed, 484 insertions, 230 deletions

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 4fe779802b..479403e5c1 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -22,10 +22,15 @@
   #:use-module (gnu system grub)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
+  #:use-module (gnu system nss)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services avahi)
   #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -33,7 +38,8 @@
   #:use-module (srfi srfi-1)
   #:export (run-basic-test
             %test-basic-os
-            %test-mcron))
+            %test-mcron
+            %test-nss-mdns))
 
 (define %simple-os
   (operating-system
@@ -64,104 +70,123 @@
 using COMMAND, a gexp that evaluates to a list of strings.  Compare some
 properties of running system to what's declared in OS, an <operating-system>."
   (define test
-    #~(begin
-        (use-modules (gnu build marionette)
-                     (srfi srfi-1)
-                     (srfi srfi-26)
-                     (srfi srfi-64)
-                     (ice-9 match))
-
-        (define marionette
-          (make-marionette #$command))
-
-        (mkdir #$output)
-        (chdir #$output)
-
-        (test-begin "basic")
-
-        (test-assert "uname"
-          (match (marionette-eval '(uname) marionette)
-            (#("Linux" host-name version _ architecture)
-             (and (string=? host-name
-                            #$(operating-system-host-name os))
-                  (string-prefix? #$(package-version
-                                     (operating-system-kernel os))
-                                  version)
-                  (string-prefix? architecture %host-type)))))
-
-        (test-assert "shell and user commands"
-          ;; Is everything in $PATH?
-          (zero? (marionette-eval '(system "
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette #$command))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "mcron")
+
+          (test-assert "uname"
+            (match (marionette-eval '(uname) marionette)
+              (#("Linux" host-name version _ architecture)
+               (and (string=? host-name
+                              #$(operating-system-host-name os))
+                    (string-prefix? #$(package-version
+                                       (operating-system-kernel os))
+                                    version)
+                    (string-prefix? architecture %host-type)))))
+
+          (test-assert "shell and user commands"
+            ;; Is everything in $PATH?
+            (zero? (marionette-eval '(system "
 . /etc/profile
 set -e -x
 guix --version
 ls --version
 grep --version
 info --version")
-                                  marionette)))
-
-        (test-assert "accounts"
-          (let ((users (marionette-eval '(begin
-                                           (use-modules (ice-9 match))
-                                           (let loop ((result '()))
-                                             (match (getpw)
-                                               (#f (reverse result))
-                                               (x  (loop (cons x result))))))
-                                        marionette)))
-            (lset= string=?
-                   (map passwd:name users)
-                   (list
-                    #$@(map user-account-name
-                            (operating-system-user-accounts os))))))
-
-        (test-assert "shepherd services"
-          (let ((services (marionette-eval '(begin
-                                              (use-modules (gnu services herd))
-                                              (call-with-values current-services
-                                                append))
-                                           marionette)))
-            (lset= eq?
-                   (pk 'services services)
-                   '(root #$@(operating-system-shepherd-service-names os)))))
-
-        (test-equal "login on tty1"
-          "root\n"
-          (begin
-            (marionette-control "sendkey ctrl-alt-f1" marionette)
-            ;; Wait for the 'term-tty1' service to be running (using
-            ;; 'start-service' is the simplest and most reliable way to do
-            ;; that.)
+                                    marionette)))
+
+          (test-assert "accounts"
+            (let ((users (marionette-eval '(begin
+                                             (use-modules (ice-9 match))
+                                             (let loop ((result '()))
+                                               (match (getpw)
+                                                 (#f (reverse result))
+                                                 (x  (loop (cons x result))))))
+                                          marionette)))
+              (lset= string=?
+                     (map passwd:name users)
+                     (list
+                      #$@(map user-account-name
+                              (operating-system-user-accounts os))))))
+
+          (test-assert "shepherd services"
+            (let ((services (marionette-eval '(begin
+                                                (use-modules (gnu services herd))
+                                                (call-with-values current-services
+                                                  append))
+                                             marionette)))
+              (lset= eq?
+                     (pk 'services services)
+                     '(root #$@(operating-system-shepherd-service-names os)))))
+
+          (test-equal "login on tty1"
+            "root\n"
+            (begin
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+              ;; Wait for the 'term-tty1' service to be running (using
+              ;; 'start-service' is the simplest and most reliable way to do
+              ;; that.)
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+
+              ;; Now we can type.
+              (marionette-type "root\n\nid -un > logged-in\n" marionette)
+
+              ;; It can take a while before the shell commands are executed.
+              (let loop ((i 0))
+                (unless (or (file-exists? "/root/logged-in") (> i 15))
+                  (sleep 1)
+                  (loop (+ i 1))))
+              (marionette-eval '(use-modules (rnrs io ports)) marionette)
+              (marionette-eval '(call-with-input-file "/root/logged-in"
+                                  get-string-all)
+                               marionette)))
+
+          (test-assert "host name resolution"
+            (match (marionette-eval
+                    '(begin
+                       ;; Wait for nscd or our requests go through it.
+                       (use-modules (gnu services herd))
+                       (start-service 'nscd)
+
+                       (list (getaddrinfo "localhost")
+                             (getaddrinfo #$(operating-system-host-name os))))
+                    marionette)
+              ((((? vector?) ..1) ((? vector?) ..1))
+               #t)
+              (x
+               (pk 'failure x #f))))
+
+          (test-equal "host not found"
+            #f
             (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'term-tty1))
-             marionette)
-
-            ;; Now we can type.
-            (marionette-type "root\n\nid -un > logged-in\n" marionette)
-
-            ;; It can take a while before the shell commands are executed.
-            (let loop ((i 0))
-              (unless (or (file-exists? "/root/logged-in") (> i 15))
-                (sleep 1)
-                (loop (+ i 1))))
-            (marionette-eval '(use-modules (rnrs io ports)) marionette)
-            (marionette-eval '(call-with-input-file "/root/logged-in"
-                                get-string-all)
-                             marionette)))
-
-        (test-assert "screendump"
-          (begin
-            (marionette-control (string-append "screendump " #$output
-                                               "/tty1.ppm")
-                                marionette)
-            (file-exists? "tty1.ppm")))
-
-        (test-end)
-        (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
-  (gexp->derivation name test
-                    #:modules '((gnu build marionette))))
+             '(false-if-exception (getaddrinfo "does-not-exist"))
+             marionette))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %test-basic-os
   (system-test
@@ -216,70 +241,207 @@ functionality tests.")
                        (command (system-qemu-image/shared-store-script
                                  os #:graphic? #f)))
     (define test
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$command)))
-
-          (define (wait-for-file file)
-            ;; Wait until FILE exists in the guest; 'read' its content and
-            ;; return it.
-            (marionette-eval
-             `(let loop ((i 10))
-                (cond ((file-exists? ,file)
-                       (call-with-input-file ,file read))
-                      ((> i 0)
-                       (sleep 1)
-                       (loop (- i 1)))
-                      (else
-                       (error "file didn't show up" ,file))))
-             marionette))
-
-          (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"))
-
-          ;; 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")
-              ((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"))
-
-          (test-end)
-          (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
-    (gexp->derivation name test
-                      #:modules '((gnu build marionette)))))
+      (with-imported-modules '((gnu build marionette))
+        #~(begin
+            (use-modules (gnu build marionette)
+                         (srfi srfi-64)
+                         (ice-9 match))
+
+            (define marionette
+              (make-marionette (list #$command)))
+
+            (define (wait-for-file file)
+              ;; Wait until FILE exists in the guest; 'read' its content and
+              ;; return it.
+              (marionette-eval
+               `(let loop ((i 10))
+                  (cond ((file-exists? ,file)
+                         (call-with-input-file ,file read))
+                        ((> i 0)
+                         (sleep 1)
+                         (loop (- i 1)))
+                        (else
+                         (error "file didn't show up" ,file))))
+               marionette))
+
+            (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"))
+
+            ;; 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")
+                ((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"))
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+    (gexp->derivation name test)))
 
 (define %test-mcron
   (system-test
    (name "mcron")
    (description "Make sure the mcron service works as advertised.")
    (value (run-mcron-test name))))
+
+
+;;;
+;;; Avahi and NSS-mDNS.
+;;;
+
+(define %avahi-os
+  (operating-system
+    (inherit %simple-os)
+    (name-service-switch %mdns-host-lookup-nss)
+    (services (cons* (avahi-service #:debug? #t)
+                     (dbus-service)
+                     (dhcp-client-service)        ;needed for multicast
+
+                     ;; Enable heavyweight debugging output.
+                     (modify-services (operating-system-user-services
+                                       %simple-os)
+                       (nscd-service-type config
+                                          => (nscd-configuration
+                                              (inherit config)
+                                              (debug-level 3)
+                                              (log-file "/dev/console")))
+                       (syslog-service-type config
+                                            =>
+                                            (plain-file
+                                             "syslog.conf"
+                                             "*.* /dev/console\n")))))))
+
+(define (run-nss-mdns-test)
+  ;; Test resolution of '.local' names via libc.  Start the marionette service
+  ;; *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))
+
+                  (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
+   (name "nss-mdns")
+   (description
+    "Test Avahi's multicast-DNS implementation, and in particular, test its
+glibc name service switch (NSS) module.")
+   (value (run-nss-mdns-test))))
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 5d893deb4c..4e79fdb294 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -32,7 +32,8 @@
   #:use-module (guix grafts)
   #:use-module (guix gexp)
   #:use-module (guix utils)
-  #:export (%test-installed-os))
+  #:export (%test-installed-os
+            %test-encrypted-os))
 
 ;;; Commentary:
 ;;;
@@ -66,8 +67,9 @@
                   (home-directory "/home/alice"))
                  %base-user-accounts))
     (services (cons (service marionette-service-type
-                             '((gnu services herd)
-                               (guix combinators)))
+                             (marionette-configuration
+                              (imported-modules '((gnu services herd)
+                                                  (guix combinators)))))
                     %base-services))))
 
 (define (operating-system-with-current-guix os)
@@ -90,7 +92,33 @@
 
 (define MiB (expt 2 20))
 
-(define* (run-install #:key
+(define %simple-installation-script
+  ;; Shell script of a simple installation.
+  "\
+. /etc/profile
+set -e -x
+guix --version
+
+export GUIX_BUILD_OPTIONS=--no-grafts
+guix build isc-dhcp
+parted --script /dev/vdb mklabel gpt \\
+  mkpart primary ext2 1M 3M \\
+  mkpart primary ext2 3M 1G \\
+  set 1 boot on \\
+  set 1 bios_grub on
+mkfs.ext4 -L my-root /dev/vdb2
+mount /dev/vdb2 /mnt
+df -h /mnt
+herd start cow-store /mnt
+mkdir /mnt/etc
+cp /etc/target-config.scm /mnt/etc/config.scm
+guix system init /mnt/etc/config.scm /mnt --no-substitutes
+sync
+reboot\n")
+
+(define* (run-install target-os target-os-source
+                      #:key
+                      (script %simple-installation-script)
                       (os (marionette-operating-system
                            ;; Since the image has no network access, use the
                            ;; current Guix so the store items we need are in
@@ -102,12 +130,13 @@
                            #:imported-modules '((gnu services herd)
                                                 (guix combinators))))
                       (target-size (* 1200 MiB)))
-  "Run the GuixSD installation procedure from OS and return a VM image of
-TARGET-SIZE bytes containing the installed system."
+  "Run SCRIPT (a shell script following the GuixSD installation procedure) in
+OS to install TARGET-OS.  Return a VM image of TARGET-SIZE bytes containing
+the installed system."
 
   (mlet* %store-monad ((_      (set-grafting #f))
                        (system (current-system))
-                       (target (operating-system-derivation %minimal-os))
+                       (target (operating-system-derivation target-os))
 
                        ;; Since the installation system has no network access,
                        ;; we cheat a little bit by adding TARGET to its GC
@@ -118,95 +147,158 @@ TARGET-SIZE bytes containing the installed system."
                                  os (list target))
                                 #:disk-image-size (* 1500 MiB))))
     (define install
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build marionette))
-
-          (set-path-environment-variable "PATH" '("bin")
-                                         (list #$qemu-minimal))
-
-          (system* "qemu-img" "create" "-f" "qcow2"
-                   #$output #$(number->string target-size))
-
-          (define marionette
-            (make-marionette
-             (cons (which #$(qemu-command system))
-                   (cons* "-no-reboot" "-m" "800"
-                          "-drive"
-                          (string-append "file=" #$image
-                                         ",if=virtio,readonly")
-                          "-drive"
-                          (string-append "file=" #$output ",if=virtio")
-                          (if (file-exists? "/dev/kvm")
-                              '("-enable-kvm")
-                              '())))))
-
-          (pk 'uname (marionette-eval '(uname) marionette))
-
-          ;; Wait for tty1.
-          (marionette-eval '(begin
-                              (use-modules (gnu services herd))
-                              (start 'term-tty1))
-                           marionette)
-
-          (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
-                              (lambda (port)
-                                (write '#$%minimal-os-source port)))
-                           marionette)
-
-          (exit (marionette-eval '(zero? (system "
+      (with-imported-modules '((guix build utils)
+                               (gnu build marionette))
+        #~(begin
+            (use-modules (guix build utils)
+                         (gnu build marionette))
+
+            (set-path-environment-variable "PATH" '("bin")
+                                           (list #$qemu-minimal))
+
+            (system* "qemu-img" "create" "-f" "qcow2"
+                     #$output #$(number->string target-size))
+
+            (define marionette
+              (make-marionette
+               (cons (which #$(qemu-command system))
+                     (cons* "-no-reboot" "-m" "800"
+                            "-drive"
+                            (string-append "file=" #$image
+                                           ",if=virtio,readonly")
+                            "-drive"
+                            (string-append "file=" #$output ",if=virtio")
+                            (if (file-exists? "/dev/kvm")
+                                '("-enable-kvm")
+                                '())))))
+
+            (pk 'uname (marionette-eval '(uname) marionette))
+
+            ;; Wait for tty1.
+            (marionette-eval '(begin
+                                (use-modules (gnu services herd))
+                                (start 'term-tty1))
+                             marionette)
+
+            (marionette-eval '(call-with-output-file "/etc/target-config.scm"
+                                (lambda (port)
+                                  (write '#$target-os-source port)))
+                             marionette)
+
+            (exit (marionette-eval '(zero? (system #$script))
+                                   marionette)))))
+
+    (gexp->derivation "installation" install)))
+
+(define (qemu-command/writable-image image)
+  "Return as a monadic value the command to run QEMU on a writable copy of
+IMAGE, a disk image."
+  (mlet %store-monad ((system (current-system)))
+    (return #~(let ((image #$image))
+                ;; First we need a writable copy of the image.
+                (format #t "copying image '~a'...~%" image)
+                (copy-file image "disk.img")
+                (chmod "disk.img" #o644)
+                `(,(string-append #$qemu-minimal "/bin/"
+                                  #$(qemu-command system))
+                  ,@(if (file-exists? "/dev/kvm")
+                        '("-enable-kvm")
+                        '())
+                  "-no-reboot" "-m" "256"
+                  "-drive" "file=disk.img,if=virtio")))))
+
+
+(define %test-installed-os
+  (system-test
+   (name "installed-os")
+   (description
+    "Test basic functionality of an OS installed like one would do by hand.
+This test is expensive in terms of CPU and storage usage since we need to
+build (current-guix) and then store a couple of full system images.")
+   (value
+    (mlet* %store-monad ((image   (run-install %minimal-os %minimal-os-source))
+                         (command (qemu-command/writable-image image)))
+      (run-basic-test %minimal-os command
+                      "installed-os")))))
+
+
+(define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
+  ;; The OS we want to install.
+  (use-modules (gnu) (gnu tests) (srfi srfi-1))
+
+  (operating-system
+    (host-name "liberigilo")
+    (timezone "Europe/Paris")
+    (locale "en_US.UTF-8")
+
+    (bootloader (grub-configuration (device "/dev/vdb")))
+    (kernel-arguments '("console=ttyS0"))
+    (file-systems (cons (file-system
+                          (device "/dev/mapper/the-root-device")
+                          (title 'device)
+                          (mount-point "/")
+                          (type "ext4"))
+                        %base-file-systems))
+    (mapped-devices (list (mapped-device
+                           (source "REPLACE-WITH-LUKS-UUID")
+                           (target "the-root-device")
+                           (type luks-device-mapping))))
+    (users (cons (user-account
+                  (name "charlie")
+                  (group "users")
+                  (home-directory "/home/charlie")
+                  (supplementary-groups '("wheel" "audio" "video")))
+                 %base-user-accounts))
+    (services (cons (service marionette-service-type
+                             (marionette-configuration
+                              (imported-modules '((gnu services herd)
+                                                  (guix combinators)))))
+                    %base-services))))
+
+(define %encrypted-root-installation-script
+  ;; Shell script of a simple installation.
+  "\
 . /etc/profile
-set -e -x;
+set -e -x
 guix --version
-guix gc --list-live | grep isc-dhcp
 
 export GUIX_BUILD_OPTIONS=--no-grafts
-guix build isc-dhcp
+ls -l /run/current-system/gc-roots
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
   mkpart primary ext2 3M 1G \\
   set 1 boot on \\
   set 1 bios_grub on
-mkfs.ext4 -L my-root /dev/vdb2
-ls -l /dev/vdb
-mount /dev/vdb2 /mnt
-df -h /mnt
+echo -n thepassphrase | cryptsetup luksFormat -q /dev/vdb2 -
+echo -n thepassphrase | \\
+  cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
+mkfs.ext4 -L my-root /dev/mapper/the-root-device
+mount LABEL=my-root /mnt
 herd start cow-store /mnt
 mkdir /mnt/etc
-cp /etc/litl-config.scm /mnt/etc/config.scm
+cp /etc/target-config.scm /mnt/etc/config.scm
+cat /mnt/etc/config
+luks_uuid=`cryptsetup luksUUID /dev/vdb2`
+sed -i /mnt/etc/config.scm \\
+    -e \"s/\\\"REPLACE-WITH-LUKS-UUID\\\"/(uuid \\\"$luks_uuid\\\")/g\"
+guix system build /mnt/etc/config.scm
 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 sync
-reboot\n"))
-                                 marionette))))
-
-    (gexp->derivation "installation" install
-                      #:modules '((guix build utils)
-                                  (gnu build marionette)))))
+reboot\n")
 
-
-(define %test-installed-os
+(define %test-encrypted-os
   (system-test
-   (name "installed-os")
+   (name "encrypted-root-os")
    (description
     "Test basic functionality of an OS installed like one would do by hand.
 This test is expensive in terms of CPU and storage usage since we need to
 build (current-guix) and then store a couple of full system images.")
    (value
-    (mlet %store-monad ((image  (run-install))
-                        (system (current-system)))
-      (run-basic-test %minimal-os
-                      #~(let ((image #$image))
-                          ;; First we need a writable copy of the image.
-                          (format #t "copying image '~a'...~%" image)
-                          (copy-file image "disk.img")
-                          (chmod "disk.img" #o644)
-                          `(,(string-append #$qemu-minimal "/bin/"
-                                            #$(qemu-command system))
-                            ,@(if (file-exists? "/dev/kvm")
-                                  '("-enable-kvm")
-                                  '())
-                            "-no-reboot" "-m" "256"
-                            "-drive" "file=disk.img,if=virtio"))
-                      "installed-os")))))
+    (mlet* %store-monad ((image   (run-install %encrypted-root-os
+                                               %encrypted-root-os-source
+                                               #:script
+                                               %encrypted-root-installation-script))
+                         (command (qemu-command/writable-image image)))
+      (run-basic-test %encrypted-root-os command "encrypted-root-os")))))
 
 ;;; install.scm ends here