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