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