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