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