gnu/tests/install.scm

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