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