gnu/tests/install.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
   4 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
   5 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
   6 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu tests install)
  24   #:use-module (gnu)
  25   #:use-module (gnu bootloader extlinux)
  26   #:use-module (gnu image)
  27   #:use-module (gnu tests)
  28   #:use-module (gnu tests base)
  29   #:use-module (gnu system)
  30   #:use-module (gnu system image)
  31   #:use-module (gnu system install)
  32   #:use-module (gnu system vm)
  33   #:use-module ((gnu build vm) #:select (qemu-command))
  34   #:use-module (gnu packages admin)
  35   #:use-module (gnu packages bootloaders)
  36   #:use-module (gnu packages commencement)       ;for 'guile-final'
  37   #:use-module (gnu packages cryptsetup)
  38   #:use-module (gnu packages linux)
  39   #:use-module (gnu packages ocr)
  40   #:use-module (gnu packages openbox)
  41   #:use-module (gnu packages package-management)
  42   #:use-module (gnu packages ratpoison)
  43   #:use-module (gnu packages suckless)
  44   #:use-module (gnu packages virtualization)
  45   #:use-module (gnu packages wm)
  46   #:use-module (gnu packages xorg)
  47   #:use-module (gnu services desktop)
  48   #:use-module (gnu services networking)
  49   #:use-module (gnu services xorg)
  50   #:use-module (guix store)
  51   #:use-module (guix monads)
  52   #:use-module (guix packages)
  53   #:use-module (guix grafts)
  54   #:use-module (guix gexp)
  55   #:use-module (guix utils)
  56   #:use-module (srfi srfi-1)
  57   #:export (%test-installed-os
  58             %test-installed-extlinux-os
  59             %test-iso-image-installer
  60             %test-separate-store-os
  61             %test-separate-home-os
  62             %test-raid-root-os
  63             %test-encrypted-root-os
  64             %test-btrfs-root-os
  65             %test-btrfs-root-on-subvolume-os
  66             %test-jfs-root-os
  67             %test-f2fs-root-os
  68
  69             %test-gui-installed-os
  70             %test-gui-installed-os-encrypted
  71             %test-gui-installed-desktop-os-encrypted))
  72
  73 ;;; Commentary:
  74 ;;;
  75 ;;; Test the installation of Guix using the documented approach at the
  76 ;;; command line.
  77 ;;;
  78 ;;; Code:
  79
  80 (define-os-with-source (%minimal-os %minimal-os-source)
  81   ;; The OS we want to install.
  82   (use-modules (gnu) (gnu tests) (srfi srfi-1))
  83
  84   (operating-system
  85     (host-name "liberigilo")
  86     (timezone "Europe/Paris")
  87     (locale "en_US.UTF-8")
  88
  89     (bootloader (bootloader-configuration
  90                  (bootloader grub-bootloader)
  91                  (target "/dev/vdb")))
  92     (kernel-arguments '("console=ttyS0"))
  93     (file-systems (cons (file-system
  94                           (device (file-system-label "my-root"))
  95                           (mount-point "/")
  96                           (type "ext4"))
  97                         %base-file-systems))
  98     (users (cons (user-account
  99                   (name "alice")
 100                   (comment "Bob's sister")
 101                   (group "users")
 102                   (supplementary-groups '("wheel" "audio" "video")))
 103                  %base-user-accounts))
 104     (services (cons (service marionette-service-type
 105                              (marionette-configuration
 106                               (imported-modules '((gnu services herd)
 107                                                   (guix build utils)
 108                                                   (guix combinators)))))
 109                     %base-services))))
 110
 111 (define (operating-system-add-packages os packages)
 112   "Append PACKAGES to OS packages list."
 113   (operating-system
 114     (inherit os)
 115     (packages (append packages (operating-system-packages os)))))
 116
 117 (define-os-with-source (%minimal-extlinux-os
 118                         %minimal-extlinux-os-source)
 119   (use-modules (gnu) (gnu tests) (gnu bootloader extlinux)
 120                (srfi srfi-1))
 121
 122   (operating-system
 123     (host-name "liberigilo")
 124     (timezone "Europe/Paris")
 125     (locale "en_US.UTF-8")
 126
 127     (bootloader (bootloader-configuration
 128                  (bootloader extlinux-bootloader-gpt)
 129                  (target "/dev/vdb")))
 130     (kernel-arguments '("console=ttyS0"))
 131     (file-systems (cons (file-system
 132                           (device (file-system-label "my-root"))
 133                           (mount-point "/")
 134                           (type "ext4"))
 135                         %base-file-systems))
 136     (services (cons (service marionette-service-type
 137                              (marionette-configuration
 138                               (imported-modules '((gnu services herd)
 139                                                   (guix combinators)))))
 140                     %base-services))))
 141
 142 (define (operating-system-with-current-guix os)
 143   "Return a variant of OS that uses the current Guix."
 144   (operating-system
 145     (inherit os)
 146     (services (modify-services (operating-system-user-services os)
 147                 (guix-service-type config =>
 148                                    (guix-configuration
 149                                     (inherit config)
 150                                     (guix (current-guix))))))))
 151
 152 \f
 153 (define MiB (expt 2 20))
 154
 155 (define %simple-installation-script
 156   ;; Shell script of a simple installation.
 157   "\
 158 . /etc/profile
 159 set -e -x
 160 guix --version
 161
 162 export GUIX_BUILD_OPTIONS=--no-grafts
 163 guix build isc-dhcp
 164 parted --script /dev/vdb mklabel gpt \\
 165   mkpart primary ext2 1M 3M \\
 166   mkpart primary ext2 3M 1.6G \\
 167   set 1 boot on \\
 168   set 1 bios_grub on
 169 mkfs.ext4 -L my-root /dev/vdb2
 170 mount /dev/vdb2 /mnt
 171 df -h /mnt
 172 herd start cow-store /mnt
 173 mkdir /mnt/etc
 174 cp /etc/target-config.scm /mnt/etc/config.scm
 175 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 176 sync
 177 reboot\n")
 178
 179 (define %extlinux-gpt-installation-script
 180   ;; Shell script of a simple installation.
 181   ;; As syslinux 6.0.3 does not handle 64bits ext4 partitions,
 182   ;; we make sure to pass -O '^64bit' to mkfs.
 183   "\
 184 . /etc/profile
 185 set -e -x
 186 guix --version
 187
 188 export GUIX_BUILD_OPTIONS=--no-grafts
 189 guix build isc-dhcp
 190 parted --script /dev/vdb mklabel gpt \\
 191   mkpart ext2 1M 1.6G \\
 192   set 1 legacy_boot on
 193 mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1
 194 mount /dev/vdb1 /mnt
 195 df -h /mnt
 196 herd start cow-store /mnt
 197 mkdir /mnt/etc
 198 cp /etc/target-config.scm /mnt/etc/config.scm
 199 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 200 sync
 201 reboot\n")
 202
 203 (define* (run-install target-os target-os-source
 204                       #:key
 205                       (script %simple-installation-script)
 206                       (gui-test #f)
 207                       (packages '())
 208                       (os (marionette-operating-system
 209                            (operating-system
 210                              ;; Since the image has no network access, use the
 211                              ;; current Guix so the store items we need are in
 212                              ;; the image and add packages provided.
 213                              (inherit (operating-system-add-packages
 214                                        (operating-system-with-current-guix
 215                                         installation-os)
 216                                        packages))
 217                              (kernel-arguments '("console=ttyS0")))
 218                            #:imported-modules '((gnu services herd)
 219                                                 (gnu installer tests)
 220                                                 (guix combinators))))
 221                       (installation-disk-image-file-system-type "ext4")
 222                       (install-size 'guess)
 223                       (target-size (* 2200 MiB)))
 224   "Run SCRIPT (a shell script following the system installation procedure) in
 225 OS to install TARGET-OS.  Return a VM image of TARGET-SIZE bytes containing
 226 the installed system.  The packages specified in PACKAGES will be appended to
 227 packages defined in installation-os."
 228
 229   (mlet* %store-monad ((_      (set-grafting #f))
 230                        (system (current-system))
 231                        (target (current-target-system))
 232                        (base-image -> (find-image
 233                                        installation-disk-image-file-system-type
 234                                        target))
 235
 236                        ;; Since the installation system has no network access,
 237                        ;; we cheat a little bit by adding TARGET to its GC
 238                        ;; roots.  This way, we know 'guix system init' will
 239                        ;; succeed.  Also add guile-final, which is pulled in
 240                        ;; through provenance.drv and may not always be present.
 241                        (target (operating-system-derivation target-os))
 242                        (image ->
 243                         (system-image
 244                          (image
 245                           (inherit base-image)
 246                           (size install-size)
 247                           (operating-system
 248                             (operating-system-with-gc-roots
 249                              os (list target guile-final)))
 250                           ;; Do not compress to speed-up the tests.
 251                           (compression? #f)
 252                           ;; Don't provide substitutes; too big.
 253                           (substitutable? #f)))))
 254     (define install
 255       (with-imported-modules '((guix build utils)
 256                                (gnu build marionette))
 257         #~(begin
 258             (use-modules (guix build utils)
 259                          (gnu build marionette))
 260
 261             (set-path-environment-variable "PATH" '("bin")
 262                                            (list #$qemu-minimal))
 263
 264             (system* "qemu-img" "create" "-f" "qcow2"
 265                      #$output #$(number->string target-size))
 266
 267             (define marionette
 268               (make-marionette
 269                `(,(which #$(qemu-command system))
 270                  "-no-reboot"
 271                  "-m" "1200"
 272                  #$@(cond
 273                      ((string=? "ext4" installation-disk-image-file-system-type)
 274                       #~("-drive"
 275                          ,(string-append "file=" #$image
 276                                          ",if=virtio,readonly")))
 277                      ((string=? "iso9660" installation-disk-image-file-system-type)
 278                       #~("-cdrom" #$image))
 279                      (else
 280                       (error
 281                        "unsupported installation-disk-image-file-system-type:"
 282                        installation-disk-image-file-system-type)))
 283                  "-drive"
 284                  ,(string-append "file=" #$output ",if=virtio")
 285                  ,@(if (file-exists? "/dev/kvm")
 286                        '("-enable-kvm")
 287                        '()))))
 288
 289             (pk 'uname (marionette-eval '(uname) marionette))
 290
 291             ;; Wait for tty1.
 292             (marionette-eval '(begin
 293                                 (use-modules (gnu services herd))
 294                                 (start 'term-tty1))
 295                              marionette)
 296
 297             (when #$(->bool script)
 298               (marionette-eval '(call-with-output-file "/etc/target-config.scm"
 299                                   (lambda (port)
 300                                     (write '#$target-os-source port)))
 301                                marionette)
 302
 303               ;; Run SCRIPT.  It typically invokes 'reboot' as a last step and
 304               ;; thus normally gets killed with SIGTERM by PID 1.
 305               (let ((status (marionette-eval '(system #$script) marionette)))
 306                 (exit (or (eof-object? status)
 307                           (equal? (status:term-sig status) SIGTERM)
 308                           (equal? (status:exit-val status) 0)))))
 309
 310             (when #$(->bool gui-test)
 311               (wait-for-unix-socket "/var/guix/installer-socket"
 312                                     marionette)
 313               (format #t "installer socket ready~%")
 314               (force-output)
 315               (exit #$(and gui-test
 316                            (gui-test #~marionette)))))))
 317
 318     (gexp->derivation "installation" install
 319                       #:substitutable? #f)))      ;too big
 320
 321 (define* (qemu-command/writable-image image #:key (memory-size 256))
 322   "Return as a monadic value the command to run QEMU on a writable copy of
 323 IMAGE, a disk image.  The QEMU VM has access to MEMORY-SIZE MiB of RAM."
 324   (mlet %store-monad ((system (current-system)))
 325     (return #~(let ((image #$image))
 326                 ;; First we need a writable copy of the image.
 327                 (format #t "creating writable image from '~a'...~%" image)
 328                 (unless (zero? (system* #+(file-append qemu-minimal
 329                                                        "/bin/qemu-img")
 330                                         "create" "-f" "qcow2"
 331                                         "-o"
 332                                         (string-append "backing_file=" image)
 333                                         "disk.img"))
 334                   (error "failed to create writable QEMU image" image))
 335
 336                 (chmod "disk.img" #o644)
 337                 `(,(string-append #$qemu-minimal "/bin/"
 338                                   #$(qemu-command system))
 339                   ,@(if (file-exists? "/dev/kvm")
 340                         '("-enable-kvm")
 341                         '())
 342                   "-no-reboot" "-m" #$(number->string memory-size)
 343                   "-drive" "file=disk.img,if=virtio")))))
 344
 345 (define %test-installed-os
 346   (system-test
 347    (name "installed-os")
 348    (description
 349     "Test basic functionality of an OS installed like one would do by hand.
 350 This test is expensive in terms of CPU and storage usage since we need to
 351 build (current-guix) and then store a couple of full system images.")
 352    (value
 353     (mlet* %store-monad ((image   (run-install %minimal-os %minimal-os-source))
 354                          (command (qemu-command/writable-image image)))
 355       (run-basic-test %minimal-os command
 356                       "installed-os")))))
 357
 358 (define %test-installed-extlinux-os
 359   (system-test
 360    (name "installed-extlinux-os")
 361    (description
 362     "Test basic functionality of an OS booted with an extlinux bootloader.  As
 363 per %test-installed-os, this test is expensive in terms of CPU and storage.")
 364    (value
 365     (mlet* %store-monad ((image (run-install %minimal-extlinux-os
 366                                              %minimal-extlinux-os-source
 367                                              #:packages
 368                                              (list syslinux)
 369                                              #:script
 370                                              %extlinux-gpt-installation-script))
 371                          (command (qemu-command/writable-image image)))
 372       (run-basic-test %minimal-extlinux-os command
 373                       "installed-extlinux-os")))))
 374
 375 \f
 376 ;;;
 377 ;;; Installation through an ISO image.
 378 ;;;
 379
 380 (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
 381   ;; The OS we want to install.
 382   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 383
 384   (operating-system
 385     (host-name "liberigilo")
 386     (timezone "Europe/Paris")
 387     (locale "en_US.UTF-8")
 388
 389     (bootloader (bootloader-configuration
 390                  (bootloader grub-bootloader)
 391                  (target "/dev/vda")))
 392     (kernel-arguments '("console=ttyS0"))
 393     (file-systems (cons (file-system
 394                           (device (file-system-label "my-root"))
 395                           (mount-point "/")
 396                           (type "ext4"))
 397                         %base-file-systems))
 398     (users (cons (user-account
 399                   (name "alice")
 400                   (comment "Bob's sister")
 401                   (group "users")
 402                   (supplementary-groups '("wheel" "audio" "video")))
 403                  %base-user-accounts))
 404     (services (cons (service marionette-service-type
 405                              (marionette-configuration
 406                               (imported-modules '((gnu services herd)
 407                                                   (guix build utils)
 408                                                   (guix combinators)))))
 409                     %base-services))))
 410
 411 (define %simple-installation-script-for-/dev/vda
 412   ;; Shell script of a simple installation.
 413   "\
 414 . /etc/profile
 415 set -e -x
 416 guix --version
 417
 418 export GUIX_BUILD_OPTIONS=--no-grafts
 419 guix build isc-dhcp
 420 parted --script /dev/vda mklabel gpt \\
 421   mkpart primary ext2 1M 3M \\
 422   mkpart primary ext2 3M 1.6G \\
 423   set 1 boot on \\
 424   set 1 bios_grub on
 425 mkfs.ext4 -L my-root /dev/vda2
 426 mount /dev/vda2 /mnt
 427 df -h /mnt
 428 herd start cow-store /mnt
 429 mkdir /mnt/etc
 430 cp /etc/target-config.scm /mnt/etc/config.scm
 431 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 432 sync
 433 reboot\n")
 434
 435 (define %test-iso-image-installer
 436   (system-test
 437    (name "iso-image-installer")
 438    (description
 439     "")
 440    (value
 441     (mlet* %store-monad ((image   (run-install
 442                                    %minimal-os-on-vda
 443                                    %minimal-os-on-vda-source
 444                                    #:script
 445                                    %simple-installation-script-for-/dev/vda
 446                                    #:installation-disk-image-file-system-type
 447                                    "iso9660"))
 448                          (command (qemu-command/writable-image image)))
 449       (run-basic-test %minimal-os-on-vda command name)))))
 450
 451 \f
 452 ;;;
 453 ;;; Separate /home.
 454 ;;;
 455
 456 (define-os-with-source (%separate-home-os %separate-home-os-source)
 457   ;; The OS we want to install.
 458   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 459
 460   (operating-system
 461     (host-name "liberigilo")
 462     (timezone "Europe/Paris")
 463     (locale "en_US.utf8")
 464
 465     (bootloader (bootloader-configuration
 466                  (bootloader grub-bootloader)
 467                  (target "/dev/vdb")))
 468     (kernel-arguments '("console=ttyS0"))
 469     (file-systems (cons* (file-system
 470                            (device (file-system-label "my-root"))
 471                            (mount-point "/")
 472                            (type "ext4"))
 473                          (file-system
 474                            (device "none")
 475                            (mount-point "/home")
 476                            (type "tmpfs"))
 477                          %base-file-systems))
 478     (users (cons* (user-account
 479                    (name "alice")
 480                    (group "users"))
 481                   (user-account
 482                    (name "charlie")
 483                    (group "users"))
 484                   %base-user-accounts))
 485     (services (cons (service marionette-service-type
 486                              (marionette-configuration
 487                               (imported-modules '((gnu services herd)
 488                                                   (guix combinators)))))
 489                     %base-services))))
 490
 491 (define %test-separate-home-os
 492   (system-test
 493    (name "separate-home-os")
 494    (description
 495     "Test basic functionality of an installed OS with a separate /home
 496 partition.  In particular, home directories must be correctly created (see
 497 <https://bugs.gnu.org/21108>).")
 498    (value
 499     (mlet* %store-monad ((image   (run-install %separate-home-os
 500                                                %separate-home-os-source
 501                                                #:script
 502                                                %simple-installation-script))
 503                          (command (qemu-command/writable-image image)))
 504       (run-basic-test %separate-home-os command "separate-home-os")))))
 505
 506 \f
 507 ;;;
 508 ;;; Separate /gnu/store partition.
 509 ;;;
 510
 511 (define-os-with-source (%separate-store-os %separate-store-os-source)
 512   ;; The OS we want to install.
 513   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 514
 515   (operating-system
 516     (host-name "liberigilo")
 517     (timezone "Europe/Paris")
 518     (locale "en_US.UTF-8")
 519
 520     (bootloader (bootloader-configuration
 521                  (bootloader grub-bootloader)
 522                  (target "/dev/vdb")))
 523     (kernel-arguments '("console=ttyS0"))
 524     (file-systems (cons* (file-system
 525                            (device (file-system-label "root-fs"))
 526                            (mount-point "/")
 527                            (type "ext4"))
 528                          (file-system
 529                            (device (file-system-label "store-fs"))
 530                            (mount-point "/gnu")
 531                            (type "ext4"))
 532                          %base-file-systems))
 533     (users %base-user-accounts)
 534     (services (cons (service marionette-service-type
 535                              (marionette-configuration
 536                               (imported-modules '((gnu services herd)
 537                                                   (guix combinators)))))
 538                     %base-services))))
 539
 540 (define %separate-store-installation-script
 541   ;; Installation with a separate /gnu partition.
 542   "\
 543 . /etc/profile
 544 set -e -x
 545 guix --version
 546
 547 export GUIX_BUILD_OPTIONS=--no-grafts
 548 guix build isc-dhcp
 549 parted --script /dev/vdb mklabel gpt \\
 550   mkpart primary ext2 1M 3M \\
 551   mkpart primary ext2 3M 400M \\
 552   mkpart primary ext2 400M 2.1G \\
 553   set 1 boot on \\
 554   set 1 bios_grub on
 555 mkfs.ext4 -L root-fs /dev/vdb2
 556 mkfs.ext4 -L store-fs /dev/vdb3
 557 mount /dev/vdb2 /mnt
 558 mkdir /mnt/gnu
 559 mount /dev/vdb3 /mnt/gnu
 560 df -h /mnt
 561 df -h /mnt/gnu
 562 herd start cow-store /mnt
 563 mkdir /mnt/etc
 564 cp /etc/target-config.scm /mnt/etc/config.scm
 565 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 566 sync
 567 reboot\n")
 568
 569 (define %test-separate-store-os
 570   (system-test
 571    (name "separate-store-os")
 572    (description
 573     "Test basic functionality of an OS installed like one would do by hand,
 574 where /gnu lives on a separate partition.")
 575    (value
 576     (mlet* %store-monad ((image   (run-install %separate-store-os
 577                                                %separate-store-os-source
 578                                                #:script
 579                                                %separate-store-installation-script))
 580                          (command (qemu-command/writable-image image)))
 581       (run-basic-test %separate-store-os command "separate-store-os")))))
 582
 583 \f
 584 ;;;
 585 ;;; RAID root device.
 586 ;;;
 587
 588 (define-os-with-source (%raid-root-os %raid-root-os-source)
 589   ;; An OS whose root partition is a RAID partition.
 590   (use-modules (gnu) (gnu tests))
 591
 592   (operating-system
 593     (host-name "raidified")
 594     (timezone "Europe/Paris")
 595     (locale "en_US.utf8")
 596
 597     (bootloader (bootloader-configuration
 598                  (bootloader grub-bootloader)
 599                  (target "/dev/vdb")))
 600     (kernel-arguments '("console=ttyS0"))
 601
 602     ;; Add a kernel module for RAID-1 (aka. "mirror").
 603     (initrd-modules (cons "raid1" %base-initrd-modules))
 604
 605     (mapped-devices (list (mapped-device
 606                            (source (list "/dev/vda2" "/dev/vda3"))
 607                            (target "/dev/md0")
 608                            (type raid-device-mapping))))
 609     (file-systems (cons (file-system
 610                           (device (file-system-label "root-fs"))
 611                           (mount-point "/")
 612                           (type "ext4")
 613                           (dependencies mapped-devices))
 614                         %base-file-systems))
 615     (users %base-user-accounts)
 616     (services (cons (service marionette-service-type
 617                              (marionette-configuration
 618                               (imported-modules '((gnu services herd)
 619                                                   (guix combinators)))))
 620                     %base-services))))
 621
 622 (define %raid-root-installation-script
 623   ;; Installation with a separate /gnu partition.  See
 624   ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and
 625   ;; mdadm.
 626   "\
 627 . /etc/profile
 628 set -e -x
 629 guix --version
 630
 631 export GUIX_BUILD_OPTIONS=--no-grafts
 632 parted --script /dev/vdb mklabel gpt \\
 633   mkpart primary ext2 1M 3M \\
 634   mkpart primary ext2 3M 1.6G \\
 635   mkpart primary ext2 1.6G 3.2G \\
 636   set 1 boot on \\
 637   set 1 bios_grub on
 638 yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\
 639   /dev/vdb2 /dev/vdb3
 640 mkfs.ext4 -L root-fs /dev/md0
 641 mount /dev/md0 /mnt
 642 df -h /mnt
 643 herd start cow-store /mnt
 644 mkdir /mnt/etc
 645 cp /etc/target-config.scm /mnt/etc/config.scm
 646 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 647 sync
 648 reboot\n")
 649
 650 (define %test-raid-root-os
 651   (system-test
 652    (name "raid-root-os")
 653    (description
 654     "Test functionality of an OS installed with a RAID root partition managed
 655 by 'mdadm'.")
 656    (value
 657     (mlet* %store-monad ((image   (run-install %raid-root-os
 658                                                %raid-root-os-source
 659                                                #:script
 660                                                %raid-root-installation-script
 661                                                #:target-size (* 3200 MiB)))
 662                          (command (qemu-command/writable-image image)))
 663       (run-basic-test %raid-root-os
 664                       `(,@command) "raid-root-os")))))
 665
 666 \f
 667 ;;;
 668 ;;; LUKS-encrypted root file system.
 669 ;;;
 670
 671 (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
 672   ;; The OS we want to install.
 673   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 674
 675   (operating-system
 676     (host-name "liberigilo")
 677     (timezone "Europe/Paris")
 678     (locale "en_US.UTF-8")
 679
 680     (bootloader (bootloader-configuration
 681                  (bootloader grub-bootloader)
 682                  (target "/dev/vdb")))
 683
 684     ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
 685     ;; detection logic in 'enter-luks-passphrase'.
 686
 687     (mapped-devices (list (mapped-device
 688                            (source (uuid "12345678-1234-1234-1234-123456789abc"))
 689                            (target "the-root-device")
 690                            (type luks-device-mapping))))
 691     (file-systems (cons (file-system
 692                           (device "/dev/mapper/the-root-device")
 693                           (mount-point "/")
 694                           (type "ext4"))
 695                         %base-file-systems))
 696     (users (cons (user-account
 697                   (name "charlie")
 698                   (group "users")
 699                   (supplementary-groups '("wheel" "audio" "video")))
 700                  %base-user-accounts))
 701     (services (cons (service marionette-service-type
 702                              (marionette-configuration
 703                               (imported-modules '((gnu services herd)
 704                                                   (guix combinators)))))
 705                     %base-services))))
 706
 707 (define %luks-passphrase
 708   ;; LUKS encryption passphrase used in tests.
 709   "thepassphrase")
 710
 711 (define %encrypted-root-installation-script
 712   ;; Shell script of a simple installation.
 713   (string-append "\
 714 . /etc/profile
 715 set -e -x
 716 guix --version
 717
 718 export GUIX_BUILD_OPTIONS=--no-grafts
 719 ls -l /run/current-system/gc-roots
 720 parted --script /dev/vdb mklabel gpt \\
 721   mkpart primary ext2 1M 3M \\
 722   mkpart primary ext2 3M 1.6G \\
 723   set 1 boot on \\
 724   set 1 bios_grub on
 725 echo -n " %luks-passphrase " | \\
 726   cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 -
 727 echo -n " %luks-passphrase " | \\
 728   cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
 729 mkfs.ext4 -L my-root /dev/mapper/the-root-device
 730 mount LABEL=my-root /mnt
 731 herd start cow-store /mnt
 732 mkdir /mnt/etc
 733 cp /etc/target-config.scm /mnt/etc/config.scm
 734 guix system build /mnt/etc/config.scm
 735 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 736 sync
 737 reboot\n"))
 738
 739 (define (enter-luks-passphrase marionette)
 740   "Return a gexp to be inserted in the basic system test running on MARIONETTE
 741 to enter the LUKS passphrase."
 742   (let ((ocrad (file-append ocrad "/bin/ocrad")))
 743     #~(begin
 744         (define (passphrase-prompt? text)
 745           (string-contains (pk 'screen-text text) "Enter pass"))
 746
 747         (define (bios-boot-screen? text)
 748           ;; Return true if TEXT corresponds to the boot screen, before GRUB's
 749           ;; menu.
 750           (string-prefix? "SeaBIOS" text))
 751
 752         (test-assert "enter LUKS passphrase for GRUB"
 753           (begin
 754             ;; At this point we have no choice but to use OCR to determine
 755             ;; when the passphrase should be entered.
 756             (wait-for-screen-text #$marionette passphrase-prompt?
 757                                   #:ocrad #$ocrad)
 758             (marionette-type #$(string-append %luks-passphrase "\n")
 759                              #$marionette)
 760
 761             ;; Now wait until we leave the boot screen.  This is necessary so
 762             ;; we can then be sure we match the "Enter passphrase" prompt from
 763             ;; 'cryptsetup', in the initrd.
 764             (wait-for-screen-text #$marionette (negate bios-boot-screen?)
 765                                   #:ocrad #$ocrad
 766                                   #:timeout 20)))
 767
 768         (test-assert "enter LUKS passphrase for the initrd"
 769           (begin
 770             ;; XXX: Here we use OCR as well but we could instead use QEMU
 771             ;; '-serial stdio' and run it in an input pipe,
 772             (wait-for-screen-text #$marionette passphrase-prompt?
 773                                   #:ocrad #$ocrad
 774                                   #:timeout 60)
 775             (marionette-type #$(string-append %luks-passphrase "\n")
 776                              #$marionette)
 777
 778             ;; Take a screenshot for debugging purposes.
 779             (marionette-control (string-append "screendump " #$output
 780                                                "/post-initrd-passphrase.ppm")
 781                                 #$marionette))))))
 782
 783 (define %test-encrypted-root-os
 784   (system-test
 785    (name "encrypted-root-os")
 786    (description
 787     "Test basic functionality of an OS installed like one would do by hand.
 788 This test is expensive in terms of CPU and storage usage since we need to
 789 build (current-guix) and then store a couple of full system images.")
 790    (value
 791     (mlet* %store-monad ((image   (run-install %encrypted-root-os
 792                                                %encrypted-root-os-source
 793                                                #:script
 794                                                %encrypted-root-installation-script))
 795                          (command (qemu-command/writable-image image)))
 796       (run-basic-test %encrypted-root-os command "encrypted-root-os"
 797                       #:initialization enter-luks-passphrase)))))
 798
 799 \f
 800 ;;;
 801 ;;; Btrfs root file system.
 802 ;;;
 803
 804 (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
 805   ;; The OS we want to install.
 806   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 807
 808   (operating-system
 809     (host-name "liberigilo")
 810     (timezone "Europe/Paris")
 811     (locale "en_US.UTF-8")
 812
 813     (bootloader (bootloader-configuration
 814                  (bootloader grub-bootloader)
 815                  (target "/dev/vdb")))
 816     (kernel-arguments '("console=ttyS0"))
 817     (file-systems (cons (file-system
 818                           (device (file-system-label "my-root"))
 819                           (mount-point "/")
 820                           (type "btrfs"))
 821                         %base-file-systems))
 822     (users (cons (user-account
 823                   (name "charlie")
 824                   (group "users")
 825                   (supplementary-groups '("wheel" "audio" "video")))
 826                  %base-user-accounts))
 827     (services (cons (service marionette-service-type
 828                              (marionette-configuration
 829                               (imported-modules '((gnu services herd)
 830                                                   (guix combinators)))))
 831                     %base-services))))
 832
 833 (define %btrfs-root-installation-script
 834   ;; Shell script of a simple installation.
 835   "\
 836 . /etc/profile
 837 set -e -x
 838 guix --version
 839
 840 export GUIX_BUILD_OPTIONS=--no-grafts
 841 ls -l /run/current-system/gc-roots
 842 parted --script /dev/vdb mklabel gpt \\
 843   mkpart primary ext2 1M 3M \\
 844   mkpart primary ext2 3M 2G \\
 845   set 1 boot on \\
 846   set 1 bios_grub on
 847 mkfs.btrfs -L my-root /dev/vdb2
 848 mount /dev/vdb2 /mnt
 849 btrfs subvolume create /mnt/home
 850 herd start cow-store /mnt
 851 mkdir /mnt/etc
 852 cp /etc/target-config.scm /mnt/etc/config.scm
 853 guix system build /mnt/etc/config.scm
 854 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 855 sync
 856 reboot\n")
 857
 858 (define %test-btrfs-root-os
 859   (system-test
 860    (name "btrfs-root-os")
 861    (description
 862     "Test basic functionality of an OS installed like one would do by hand.
 863 This test is expensive in terms of CPU and storage usage since we need to
 864 build (current-guix) and then store a couple of full system images.")
 865    (value
 866     (mlet* %store-monad ((image   (run-install %btrfs-root-os
 867                                                %btrfs-root-os-source
 868                                                #:script
 869                                                %btrfs-root-installation-script))
 870                          (command (qemu-command/writable-image image)))
 871       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 872
 873 \f
 874 ;;;
 875 ;;; Btrfs root file system on a subvolume.
 876 ;;;
 877
 878 (define-os-with-source (%btrfs-root-on-subvolume-os
 879                         %btrfs-root-on-subvolume-os-source)
 880   ;; The OS we want to install.
 881   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 882
 883   (operating-system
 884     (host-name "hurd")
 885     (timezone "America/Montreal")
 886     (locale "en_US.UTF-8")
 887     (bootloader (bootloader-configuration
 888                  (bootloader grub-bootloader)
 889                  (target "/dev/vdb")))
 890     (kernel-arguments '("console=ttyS0"))
 891     (file-systems (cons* (file-system
 892                            (device (file-system-label "btrfs-pool"))
 893                            (mount-point "/")
 894                            (options "subvol=rootfs,compress=zstd")
 895                            (type "btrfs"))
 896                          (file-system
 897                            (device (file-system-label "btrfs-pool"))
 898                            (mount-point "/home")
 899                            (options "subvol=homefs,compress=lzo")
 900                            (type "btrfs"))
 901                          %base-file-systems))
 902     (users (cons (user-account
 903                   (name "charlie")
 904                   (group "users")
 905                   (supplementary-groups '("wheel" "audio" "video")))
 906                  %base-user-accounts))
 907     (services (cons (service marionette-service-type
 908                              (marionette-configuration
 909                               (imported-modules '((gnu services herd)
 910                                                   (guix combinators)))))
 911                     %base-services))))
 912
 913 (define %btrfs-root-on-subvolume-installation-script
 914   ;; Shell script of a simple installation.
 915   "\
 916 . /etc/profile
 917 set -e -x
 918 guix --version
 919
 920 export GUIX_BUILD_OPTIONS=--no-grafts
 921 ls -l /run/current-system/gc-roots
 922 parted --script /dev/vdb mklabel gpt \\
 923   mkpart primary ext2 1M 3M \\
 924   mkpart primary ext2 3M 2G \\
 925   set 1 boot on \\
 926   set 1 bios_grub on
 927
 928 # Setup the top level Btrfs file system with its subvolume.
 929 mkfs.btrfs -L btrfs-pool /dev/vdb2
 930 mount /dev/vdb2 /mnt
 931 btrfs subvolume create /mnt/rootfs
 932 btrfs subvolume create /mnt/homefs
 933 umount /dev/vdb2
 934
 935 # Mount the subvolumes, ready for installation.
 936 mount LABEL=btrfs-pool -o 'subvol=rootfs,compress=zstd' /mnt
 937 mkdir /mnt/home
 938 mount LABEL=btrfs-pool -o 'subvol=homefs,compress=zstd' /mnt/home
 939
 940 herd start cow-store /mnt
 941 mkdir /mnt/etc
 942 cp /etc/target-config.scm /mnt/etc/config.scm
 943 guix system build /mnt/etc/config.scm
 944 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 945 sync
 946 reboot\n")
 947
 948 (define %test-btrfs-root-on-subvolume-os
 949   (system-test
 950    (name "btrfs-root-on-subvolume-os")
 951    (description
 952     "Test basic functionality of an OS installed like one would do by hand.
 953 This test is expensive in terms of CPU and storage usage since we need to
 954 build (current-guix) and then store a couple of full system images.")
 955    (value
 956     (mlet* %store-monad
 957         ((image
 958           (run-install %btrfs-root-on-subvolume-os
 959                        %btrfs-root-on-subvolume-os-source
 960                        #:script
 961                        %btrfs-root-on-subvolume-installation-script))
 962          (command (qemu-command/writable-image image)))
 963       (run-basic-test %btrfs-root-on-subvolume-os command
 964                       "btrfs-root-on-subvolume-os")))))
 965
 966 \f
 967 ;;;
 968 ;;; JFS root file system.
 969 ;;;
 970
 971 (define-os-with-source (%jfs-root-os %jfs-root-os-source)
 972   ;; The OS we want to install.
 973   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 974
 975   (operating-system
 976     (host-name "liberigilo")
 977     (timezone "Europe/Paris")
 978     (locale "en_US.UTF-8")
 979
 980     (bootloader (bootloader-configuration
 981                  (bootloader grub-bootloader)
 982                  (target "/dev/vdb")))
 983     (kernel-arguments '("console=ttyS0"))
 984     (file-systems (cons (file-system
 985                           (device (file-system-label "my-root"))
 986                           (mount-point "/")
 987                           (type "jfs"))
 988                         %base-file-systems))
 989     (users (cons (user-account
 990                   (name "charlie")
 991                   (group "users")
 992                   (supplementary-groups '("wheel" "audio" "video")))
 993                  %base-user-accounts))
 994     (services (cons (service marionette-service-type
 995                              (marionette-configuration
 996                               (imported-modules '((gnu services herd)
 997                                                   (guix combinators)))))
 998                     %base-services))))
 999
1000 (define %jfs-root-installation-script
1001   ;; Shell script of a simple installation.
1002   "\
1003 . /etc/profile
1004 set -e -x
1005 guix --version
1006
1007 export GUIX_BUILD_OPTIONS=--no-grafts
1008 ls -l /run/current-system/gc-roots
1009 parted --script /dev/vdb mklabel gpt \\
1010   mkpart primary ext2 1M 3M \\
1011   mkpart primary ext2 3M 2G \\
1012   set 1 boot on \\
1013   set 1 bios_grub on
1014 jfs_mkfs -L my-root -q /dev/vdb2
1015 mount /dev/vdb2 /mnt
1016 herd start cow-store /mnt
1017 mkdir /mnt/etc
1018 cp /etc/target-config.scm /mnt/etc/config.scm
1019 guix system build /mnt/etc/config.scm
1020 guix system init /mnt/etc/config.scm /mnt --no-substitutes
1021 sync
1022 reboot\n")
1023
1024 (define %test-jfs-root-os
1025   (system-test
1026    (name "jfs-root-os")
1027    (description
1028     "Test basic functionality of an OS installed like one would do by hand.
1029 This test is expensive in terms of CPU and storage usage since we need to
1030 build (current-guix) and then store a couple of full system images.")
1031    (value
1032     (mlet* %store-monad ((image   (run-install %jfs-root-os
1033                                                %jfs-root-os-source
1034                                                #:script
1035                                                %jfs-root-installation-script))
1036                          (command (qemu-command/writable-image image)))
1037       (run-basic-test %jfs-root-os command "jfs-root-os")))))
1038
1039 \f
1040 ;;;
1041 ;;; F2FS root file system.
1042 ;;;
1043
1044 (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
1045   ;; The OS we want to install.
1046   (use-modules (gnu) (gnu tests) (srfi srfi-1))
1047
1048   (operating-system
1049     (host-name "liberigilo")
1050     (timezone "Europe/Paris")
1051     (locale "en_US.UTF-8")
1052
1053     (bootloader (bootloader-configuration
1054                  (bootloader grub-bootloader)
1055                  (target "/dev/vdb")))
1056     (kernel-arguments '("console=ttyS0"))
1057     (file-systems (cons (file-system
1058                           (device (file-system-label "my-root"))
1059                           (mount-point "/")
1060                           (type "f2fs"))
1061                         %base-file-systems))
1062     (users (cons (user-account
1063                   (name "charlie")
1064                   (group "users")
1065                   (supplementary-groups '("wheel" "audio" "video")))
1066                  %base-user-accounts))
1067     (services (cons (service marionette-service-type
1068                              (marionette-configuration
1069                               (imported-modules '((gnu services herd)
1070                                                   (guix combinators)))))
1071                     %base-services))))
1072
1073 (define %f2fs-root-installation-script
1074   ;; Shell script of a simple installation.
1075   "\
1076 . /etc/profile
1077 set -e -x
1078 guix --version
1079
1080 export GUIX_BUILD_OPTIONS=--no-grafts
1081 ls -l /run/current-system/gc-roots
1082 parted --script /dev/vdb mklabel gpt \\
1083   mkpart primary ext2 1M 3M \\
1084   mkpart primary ext2 3M 2G \\
1085   set 1 boot on \\
1086   set 1 bios_grub on
1087 mkfs.f2fs -l my-root -q /dev/vdb2
1088 mount /dev/vdb2 /mnt
1089 herd start cow-store /mnt
1090 mkdir /mnt/etc
1091 cp /etc/target-config.scm /mnt/etc/config.scm
1092 guix system build /mnt/etc/config.scm
1093 guix system init /mnt/etc/config.scm /mnt --no-substitutes
1094 sync
1095 reboot\n")
1096
1097 (define %test-f2fs-root-os
1098   (system-test
1099    (name "f2fs-root-os")
1100    (description
1101     "Test basic functionality of an OS installed like one would do by hand.
1102 This test is expensive in terms of CPU and storage usage since we need to
1103 build (current-guix) and then store a couple of full system images.")
1104    (value
1105     (mlet* %store-monad ((image   (run-install %f2fs-root-os
1106                                                %f2fs-root-os-source
1107                                                #:script
1108                                                %f2fs-root-installation-script))
1109                          (command (qemu-command/writable-image image)))
1110       (run-basic-test %f2fs-root-os command "f2fs-root-os")))))
1111
1112 \f
1113 ;;;
1114 ;;; Installation through the graphical interface.
1115 ;;;
1116
1117 (define %syslog-conf
1118   ;; Syslog configuration that dumps to /dev/console, so we can see the
1119   ;; installer's messages during the test.
1120   (computed-file "syslog.conf"
1121                  #~(begin
1122                      (copy-file #$%default-syslog.conf #$output)
1123                      (chmod #$output #o644)
1124                      (let ((port (open-file #$output "a")))
1125                        (display "\n*.info /dev/console\n" port)
1126                        #t))))
1127
1128 (define (operating-system-with-console-syslog os)
1129   "Return OS with a syslog service that writes to /dev/console."
1130   (operating-system
1131     (inherit os)
1132     (services (modify-services (operating-system-user-services os)
1133                 (syslog-service-type config
1134                                      =>
1135                                      (syslog-configuration
1136                                       (inherit config)
1137                                       (config-file %syslog-conf)))))))
1138
1139 (define %root-password "foo")
1140
1141 (define* (gui-test-program marionette
1142                            #:key
1143                            (desktop? #f)
1144                            (encrypted? #f))
1145   #~(let ()
1146       (define (screenshot file)
1147         (marionette-control (string-append "screendump " file)
1148                             #$marionette))
1149
1150       (define-syntax-rule (marionette-eval* exp marionette)
1151         (or (marionette-eval exp marionette)
1152             (throw 'marionette-eval-failure 'exp)))
1153
1154       (setvbuf (current-output-port) 'none)
1155       (setvbuf (current-error-port) 'none)
1156
1157       (marionette-eval* '(use-modules (gnu installer tests))
1158                         #$marionette)
1159
1160       ;; Arrange so that 'converse' prints debugging output to the console.
1161       (marionette-eval* '(let ((console (open-output-file "/dev/console")))
1162                            (setvbuf console 'none)
1163                            (conversation-log-port console))
1164                         #$marionette)
1165
1166       ;; Tell the installer to not wait for the Connman "online" status.
1167       (marionette-eval* '(call-with-output-file "/tmp/installer-assume-online"
1168                            (const #t))
1169                         #$marionette)
1170
1171       ;; Run 'guix system init' with '--no-grafts', to cope with the lack of
1172       ;; network access.
1173       (marionette-eval* '(call-with-output-file
1174                              "/tmp/installer-system-init-options"
1175                            (lambda (port)
1176                              (write '("--no-grafts" "--no-substitutes")
1177                                     port)))
1178                         #$marionette)
1179
1180       (marionette-eval* '(define installer-socket
1181                            (open-installer-socket))
1182                         #$marionette)
1183       (screenshot "installer-start.ppm")
1184
1185       (marionette-eval* '(choose-locale+keyboard installer-socket)
1186                         #$marionette)
1187       (screenshot "installer-locale.ppm")
1188
1189       ;; Choose the host name that the "basic" test expects.
1190       (marionette-eval* '(enter-host-name+passwords installer-socket
1191                                                     #:host-name "liberigilo"
1192                                                     #:root-password
1193                                                     #$%root-password
1194                                                     #:users
1195                                                     '(("alice" "pass1")
1196                                                       ("bob" "pass2")))
1197                         #$marionette)
1198       (screenshot "installer-services.ppm")
1199
1200       (marionette-eval* '(choose-services installer-socket
1201                                           #:choose-desktop-environment?
1202                                           (const #$desktop?)
1203                                           #:choose-network-service?
1204                                           (const #f))
1205                         #$marionette)
1206       (screenshot "installer-partitioning.ppm")
1207
1208       (marionette-eval* '(choose-partitioning installer-socket
1209                                               #:encrypted? #$encrypted?
1210                                               #:passphrase #$%luks-passphrase)
1211                         #$marionette)
1212       (screenshot "installer-run.ppm")
1213
1214       (marionette-eval* '(conclude-installation installer-socket)
1215                         #$marionette)
1216
1217       (sync)
1218       #t))
1219
1220 (define %extra-packages
1221   ;; Packages needed when installing with an encrypted root.
1222   (list isc-dhcp
1223         lvm2-static cryptsetup-static e2fsck/static
1224         loadkeys-static))
1225
1226 (define installation-os-for-gui-tests
1227   ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the
1228   ;; target OS, as well as syslog output redirected to the console so we can
1229   ;; see what the installer is up to.
1230   (marionette-operating-system
1231    (operating-system
1232      (inherit (operating-system-with-console-syslog
1233                (operating-system-add-packages
1234                 (operating-system-with-current-guix
1235                  installation-os)
1236                 %extra-packages)))
1237      (kernel-arguments '("console=ttyS0")))
1238    #:imported-modules '((gnu services herd)
1239                         (gnu installer tests)
1240                         (guix combinators))))
1241
1242 (define* (installation-target-os-for-gui-tests
1243           #:key (encrypted? #f))
1244   (operating-system
1245     (inherit %minimal-os-on-vda)
1246     (users (append (list (user-account
1247                           (name "alice")
1248                           (comment "Bob's sister")
1249                           (group "users")
1250                           (supplementary-groups
1251                            '("wheel" "audio" "video")))
1252                          (user-account
1253                           (name "bob")
1254                           (comment "Alice's brother")
1255                           (group "users")
1256                           (supplementary-groups
1257                            '("wheel" "audio" "video"))))
1258                    %base-user-accounts))
1259     ;; The installer does not create a swap device in guided mode with
1260     ;; encryption support.
1261     (swap-devices (if encrypted? '() '("/dev/vda2")))
1262     (services (cons (service dhcp-client-service-type)
1263                     (operating-system-user-services %minimal-os-on-vda)))))
1264
1265 (define* (installation-target-desktop-os-for-gui-tests
1266           #:key (encrypted? #f))
1267   (operating-system
1268     (inherit (installation-target-os-for-gui-tests
1269               #:encrypted? encrypted?))
1270     (keyboard-layout (keyboard-layout "us" "altgr-intl"))
1271
1272     ;; Make sure that all the packages and services that may be used by the
1273     ;; graphical installer are available.
1274     (packages (append
1275                (list openbox awesome i3-wm i3status
1276                      dmenu st ratpoison xterm)
1277                %base-packages))
1278     (services
1279      (append
1280       (list (service gnome-desktop-service-type)
1281             (service xfce-desktop-service-type)
1282             (service mate-desktop-service-type)
1283             (service enlightenment-desktop-service-type)
1284             (set-xorg-configuration
1285              (xorg-configuration
1286               (keyboard-layout keyboard-layout)))
1287             (service marionette-service-type
1288                      (marionette-configuration
1289                       (imported-modules '((gnu services herd)
1290                                           (guix build utils)
1291                                           (guix combinators))))))
1292       %desktop-services))))
1293
1294 (define* (guided-installation-test name
1295                                    #:key
1296                                    (desktop? #f)
1297                                    (encrypted? #f)
1298                                    target-os
1299                                    (install-size 'guess)
1300                                    (target-size (* 2200 MiB)))
1301   (system-test
1302    (name name)
1303    (description
1304     "Install an OS using the graphical installer and test it.")
1305    (value
1306     (mlet* %store-monad
1307         ((image   (run-install target-os '(this is unused)
1308                                #:script #f
1309                                #:os installation-os-for-gui-tests
1310                                #:install-size install-size
1311                                #:target-size target-size
1312                                #:installation-disk-image-file-system-type
1313                                "iso9660"
1314                                #:gui-test
1315                                (lambda (marionette)
1316                                  (gui-test-program
1317                                   marionette
1318                                   #:desktop? desktop?
1319                                   #:encrypted? encrypted?))))
1320          (command (qemu-command/writable-image image #:memory-size 512)))
1321       (run-basic-test target-os command name
1322                       #:initialization (and encrypted? enter-luks-passphrase)
1323                       #:root-password %root-password
1324                       #:desktop? desktop?)))))
1325
1326 (define %test-gui-installed-os
1327   (guided-installation-test
1328    "gui-installed-os"
1329    #:target-os (installation-target-os-for-gui-tests)))
1330
1331 (define %test-gui-installed-os-encrypted
1332   (guided-installation-test
1333    "gui-installed-os-encrypted"
1334    #:encrypted? #t
1335    #:target-os (installation-target-os-for-gui-tests
1336                 #:encrypted? #t)))
1337
1338 ;; Building a desktop image is very time and space consuming. Install all
1339 ;; desktop environments in a single test to reduce the overhead.
1340 (define %test-gui-installed-desktop-os-encrypted
1341   (guided-installation-test "gui-installed-desktop-os-encrypted"
1342                             #:desktop? #t
1343                             #:encrypted? #t
1344                             #:target-os
1345                             (installation-target-desktop-os-for-gui-tests
1346                              #:encrypted? #t)
1347                             ;; XXX: The disk-image size guess is too low. Use
1348                             ;; a constant value until this is fixed.
1349                             #:install-size (* 8000 MiB)
1350                             #:target-size (* 9000 MiB)))
1351
1352 ;;; install.scm ends here