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