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