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