gnu/tests/install.scm

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