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