gnu/tests/install.scm

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