services: hurd-vm: Resurrect system-test by using raw disk-image.
[jackhill/guix/guix.git] / gnu / tests / install.scm
index 94d970e..dee2b87 100644 (file)
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,6 +62,7 @@
             %test-raid-root-os
             %test-encrypted-root-os
             %test-btrfs-root-os
+            %test-btrfs-root-on-subvolume-os
             %test-jfs-root-os
             %test-f2fs-root-os
 
@@ -161,7 +163,7 @@ 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 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 mkfs.ext4 -L my-root /dev/vdb2
@@ -186,7 +188,7 @@ guix --version
 export GUIX_BUILD_OPTIONS=--no-grafts
 guix build isc-dhcp
 parted --script /dev/vdb mklabel gpt \\
-  mkpart ext2 1M 1.4G \\
+  mkpart ext2 1M 1.6G \\
   set 1 legacy_boot on
 mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1
 mount /dev/vdb1 /mnt
@@ -216,7 +218,7 @@ reboot\n")
                            #:imported-modules '((gnu services herd)
                                                 (gnu installer tests)
                                                 (guix combinators))))
-                      (installation-disk-image-file-system-type "ext4")
+                      (installation-image-type 'raw)
                       (install-size 'guess)
                       (target-size (* 2200 MiB)))
   "Run SCRIPT (a shell script following the system installation procedure) in
@@ -226,25 +228,27 @@ packages defined in installation-os."
 
   (mlet* %store-monad ((_      (set-grafting #f))
                        (system (current-system))
-                       (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
                        ;; roots.  This way, we know 'guix system init' will
                        ;; succeed.  Also add guile-final, which is pulled in
                        ;; through provenance.drv and may not always be present.
-                       (image
-                        (system-image
-                         (image
-                          (inherit
-                           (find-image
-                            installation-disk-image-file-system-type))
-                          (size install-size)
-                          (operating-system
-                            (operating-system-with-gc-roots
-                             os (list target guile-final)))
-                          ;; Don't provide substitutes; too big.
-                          (substitutable? #f)))))
+                       (target (operating-system-derivation target-os))
+                       (base-image ->
+                                   (os->image
+                                    (operating-system-with-gc-roots
+                                     os (list target guile-final))
+                                    #:type (lookup-image-type-by-name
+                                            installation-image-type)))
+                       (image ->
+                              (system-image
+                               (image
+                                (inherit base-image)
+                                (size install-size)
+
+                                ;; Don't provide substitutes; too big.
+                                (substitutable? #f)))))
     (define install
       (with-imported-modules '((guix build utils)
                                (gnu build marionette))
@@ -264,16 +268,16 @@ packages defined in installation-os."
                  "-no-reboot"
                  "-m" "1200"
                  #$@(cond
-                     ((string=? "ext4" installation-disk-image-file-system-type)
+                     ((eq? 'raw installation-image-type)
                       #~("-drive"
                          ,(string-append "file=" #$image
                                          ",if=virtio,readonly")))
-                     ((string=? "iso9660" installation-disk-image-file-system-type)
+                     ((eq? 'uncompressed-iso9660 installation-image-type)
                       #~("-cdrom" #$image))
                      (else
                       (error
-                       "unsupported installation-disk-image-file-system-type:"
-                       installation-disk-image-file-system-type)))
+                       "unsupported installation-image-type:"
+                       installation-image-type)))
                  "-drive"
                  ,(string-append "file=" #$output ",if=virtio")
                  ,@(if (file-exists? "/dev/kvm")
@@ -297,7 +301,8 @@ packages defined in installation-os."
               ;; Run SCRIPT.  It typically invokes 'reboot' as a last step and
               ;; thus normally gets killed with SIGTERM by PID 1.
               (let ((status (marionette-eval '(system #$script) marionette)))
-                (exit (or (equal? (status:term-sig status) SIGTERM)
+                (exit (or (eof-object? status)
+                          (equal? (status:term-sig status) SIGTERM)
                           (equal? (status:exit-val status) 0)))))
 
             (when #$(->bool gui-test)
@@ -412,7 +417,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
 guix build isc-dhcp
 parted --script /dev/vda mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 mkfs.ext4 -L my-root /dev/vda2
@@ -436,8 +441,8 @@ reboot\n")
                                    %minimal-os-on-vda-source
                                    #:script
                                    %simple-installation-script-for-/dev/vda
-                                   #:installation-disk-image-file-system-type
-                                   "iso9660"))
+                                   #:installation-image-type
+                                   'uncompressed-iso9660))
                          (command (qemu-command/writable-image image)))
       (run-basic-test %minimal-os-on-vda command name)))))
 
@@ -624,8 +629,8 @@ guix --version
 export GUIX_BUILD_OPTIONS=--no-grafts
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
-  mkpart primary ext2 1.4G 2.8G \\
+  mkpart primary ext2 3M 1.6G \\
+  mkpart primary ext2 1.6G 3.2G \\
   set 1 boot on \\
   set 1 bios_grub on
 yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\
@@ -651,7 +656,7 @@ by 'mdadm'.")
                                                %raid-root-os-source
                                                #:script
                                                %raid-root-installation-script
-                                               #:target-size (* 2800 MiB)))
+                                               #:target-size (* 3200 MiB)))
                          (command (qemu-command/writable-image image)))
       (run-basic-test %raid-root-os
                       `(,@command) "raid-root-os")))))
@@ -712,7 +717,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
 ls -l /run/current-system/gc-roots
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 echo -n " %luks-passphrase " | \\
@@ -864,6 +869,99 @@ build (current-guix) and then store a couple of full system images.")
       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 
 \f
+;;;
+;;; Btrfs root file system on a subvolume.
+;;;
+
+(define-os-with-source (%btrfs-root-on-subvolume-os
+                        %btrfs-root-on-subvolume-os-source)
+  ;; The OS we want to install.
+  (use-modules (gnu) (gnu tests) (srfi srfi-1))
+
+  (operating-system
+    (host-name "hurd")
+    (timezone "America/Montreal")
+    (locale "en_US.UTF-8")
+    (bootloader (bootloader-configuration
+                 (bootloader grub-bootloader)
+                 (target "/dev/vdb")))
+    (kernel-arguments '("console=ttyS0"))
+    (file-systems (cons* (file-system
+                           (device (file-system-label "btrfs-pool"))
+                           (mount-point "/")
+                           (options "subvol=rootfs,compress=zstd")
+                           (type "btrfs"))
+                         (file-system
+                           (device (file-system-label "btrfs-pool"))
+                           (mount-point "/home")
+                           (options "subvol=homefs,compress=lzo")
+                           (type "btrfs"))
+                         %base-file-systems))
+    (users (cons (user-account
+                  (name "charlie")
+                  (group "users")
+                  (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 %btrfs-root-on-subvolume-installation-script
+  ;; Shell script of a simple installation.
+  "\
+. /etc/profile
+set -e -x
+guix --version
+
+export GUIX_BUILD_OPTIONS=--no-grafts
+ls -l /run/current-system/gc-roots
+parted --script /dev/vdb mklabel gpt \\
+  mkpart primary ext2 1M 3M \\
+  mkpart primary ext2 3M 2G \\
+  set 1 boot on \\
+  set 1 bios_grub on
+
+# Setup the top level Btrfs file system with its subvolume.
+mkfs.btrfs -L btrfs-pool /dev/vdb2
+mount /dev/vdb2 /mnt
+btrfs subvolume create /mnt/rootfs
+btrfs subvolume create /mnt/homefs
+umount /dev/vdb2
+
+# Mount the subvolumes, ready for installation.
+mount LABEL=btrfs-pool -o 'subvol=rootfs,compress=zstd' /mnt
+mkdir /mnt/home
+mount LABEL=btrfs-pool -o 'subvol=homefs,compress=zstd' /mnt/home
+
+herd start cow-store /mnt
+mkdir /mnt/etc
+cp /etc/target-config.scm /mnt/etc/config.scm
+guix system build /mnt/etc/config.scm
+guix system init /mnt/etc/config.scm /mnt --no-substitutes
+sync
+reboot\n")
+
+(define %test-btrfs-root-on-subvolume-os
+  (system-test
+   (name "btrfs-root-on-subvolume-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 %btrfs-root-on-subvolume-os
+                       %btrfs-root-on-subvolume-os-source
+                       #:script
+                       %btrfs-root-on-subvolume-installation-script))
+         (command (qemu-command/writable-image image)))
+      (run-basic-test %btrfs-root-on-subvolume-os command
+                      "btrfs-root-on-subvolume-os")))))
+
+\f
 ;;;
 ;;; JFS root file system.
 ;;;
@@ -1209,18 +1307,19 @@ build (current-guix) and then store a couple of full system images.")
                                #:os installation-os-for-gui-tests
                                #:install-size install-size
                                #:target-size target-size
-                               #:installation-disk-image-file-system-type
-                               "iso9660"
+                               #:installation-image-type
+                               'uncompressed-iso9660
                                #:gui-test
                                (lambda (marionette)
                                  (gui-test-program
                                   marionette
                                   #:desktop? desktop?
                                   #:encrypted? encrypted?))))
-         (command (qemu-command/writable-image image)))
+         (command (qemu-command/writable-image image #:memory-size 512)))
       (run-basic-test target-os command name
                       #:initialization (and encrypted? enter-luks-passphrase)
-                      #:root-password %root-password)))))
+                      #:root-password %root-password
+                      #:desktop? desktop?)))))
 
 (define %test-gui-installed-os
   (guided-installation-test