services: hurd-vm: Resurrect system-test by using raw disk-image.
[jackhill/guix/guix.git] / gnu / tests / install.scm
index 6bd8c7d..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.
 ;;;
@@ -162,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
@@ -187,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
@@ -217,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
@@ -227,25 +228,27 @@ packages defined in installation-os."
 
   (mlet* %store-monad ((_      (set-grafting #f))
                        (system (current-system))
-                       (target (operating-system-derivation target-os))
-                       (base-image (find-image
-                                    installation-disk-image-file-system-type))
 
                        ;; 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.
+                       (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)
-                          (operating-system
-                            (operating-system-with-gc-roots
-                             os (list target guile-final)))
-                          ;; Don't provide substitutes; too big.
-                          (substitutable? #f)))))
+                              (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))
@@ -265,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")
@@ -298,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)
@@ -413,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
@@ -437,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)))))
 
@@ -625,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 \\
@@ -652,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")))))
@@ -713,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 " | \\
@@ -1303,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