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