gnu/tests/install.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2017 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     (initrd (lambda (file-systems . rest)
 569               ;; Add a kernel module for RAID-0 (aka. "stripe").
 570               (apply base-initrd file-systems
 571                      #:extra-modules '("raid0")
 572                      rest)))
 573     (mapped-devices (list (mapped-device
 574                            (source (list "/dev/vda2" "/dev/vda3"))
 575                            (target "/dev/md0")
 576                            (type raid-device-mapping))))
 577     (file-systems (cons (file-system
 578                           (device "root-fs")
 579                           (title 'label)
 580                           (mount-point "/")
 581                           (type "ext4")
 582                           (dependencies mapped-devices))
 583                         %base-file-systems))
 584     (users %base-user-accounts)
 585     (services (cons (service marionette-service-type
 586                              (marionette-configuration
 587                               (imported-modules '((gnu services herd)
 588                                                   (guix combinators)))))
 589                     %base-services))))
 590
 591 (define %raid-root-installation-script
 592   ;; Installation with a separate /gnu partition.  See
 593   ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and
 594   ;; mdadm.
 595   "\
 596 . /etc/profile
 597 set -e -x
 598 guix --version
 599
 600 export GUIX_BUILD_OPTIONS=--no-grafts
 601 parted --script /dev/vdb mklabel gpt \\
 602   mkpart primary ext2 1M 3M \\
 603   mkpart primary ext2 3M 600M \\
 604   mkpart primary ext2 600M 1200M \\
 605   set 1 boot on \\
 606   set 1 bios_grub on
 607 mdadm --create /dev/md0 --verbose --level=stripe --raid-devices=2 \\
 608   /dev/vdb2 /dev/vdb3
 609 mkfs.ext4 -L root-fs /dev/md0
 610 mount /dev/md0 /mnt
 611 df -h /mnt
 612 herd start cow-store /mnt
 613 mkdir /mnt/etc
 614 cp /etc/target-config.scm /mnt/etc/config.scm
 615 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 616 sync
 617 reboot\n")
 618
 619 (define %test-raid-root-os
 620   (system-test
 621    (name "raid-root-os")
 622    (description
 623     "Test functionality of an OS installed with a RAID root partition managed
 624 by 'mdadm'.")
 625    (value
 626     (mlet* %store-monad ((image   (run-install %raid-root-os
 627                                                %raid-root-os-source
 628                                                #:script
 629                                                %raid-root-installation-script
 630                                                #:target-size (* 1300 MiB)))
 631                          (command (qemu-command/writable-image image)))
 632       (run-basic-test %raid-root-os
 633                       `(,@command) "raid-root-os")))))
 634
 635 \f
 636 ;;;
 637 ;;; LUKS-encrypted root file system.
 638 ;;;
 639
 640 (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
 641   ;; The OS we want to install.
 642   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 643
 644   (operating-system
 645     (host-name "liberigilo")
 646     (timezone "Europe/Paris")
 647     (locale "en_US.UTF-8")
 648
 649     (bootloader (bootloader-configuration
 650                  (bootloader grub-bootloader)
 651                  (target "/dev/vdb")))
 652
 653     ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
 654     ;; detection logic in 'enter-luks-passphrase'.
 655
 656     (mapped-devices (list (mapped-device
 657                            (source (uuid "12345678-1234-1234-1234-123456789abc"))
 658                            (target "the-root-device")
 659                            (type luks-device-mapping))))
 660     (file-systems (cons (file-system
 661                           (device "/dev/mapper/the-root-device")
 662                           (title 'device)
 663                           (mount-point "/")
 664                           (type "ext4"))
 665                         %base-file-systems))
 666     (users (cons (user-account
 667                   (name "charlie")
 668                   (group "users")
 669                   (home-directory "/home/charlie")
 670                   (supplementary-groups '("wheel" "audio" "video")))
 671                  %base-user-accounts))
 672     (services (cons (service marionette-service-type
 673                              (marionette-configuration
 674                               (imported-modules '((gnu services herd)
 675                                                   (guix combinators)))))
 676                     %base-services))))
 677
 678 (define %encrypted-root-installation-script
 679   ;; Shell script of a simple installation.
 680   "\
 681 . /etc/profile
 682 set -e -x
 683 guix --version
 684
 685 export GUIX_BUILD_OPTIONS=--no-grafts
 686 ls -l /run/current-system/gc-roots
 687 parted --script /dev/vdb mklabel gpt \\
 688   mkpart primary ext2 1M 3M \\
 689   mkpart primary ext2 3M 1G \\
 690   set 1 boot on \\
 691   set 1 bios_grub on
 692 echo -n thepassphrase | \\
 693   cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 -
 694 echo -n thepassphrase | \\
 695   cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
 696 mkfs.ext4 -L my-root /dev/mapper/the-root-device
 697 mount LABEL=my-root /mnt
 698 herd start cow-store /mnt
 699 mkdir /mnt/etc
 700 cp /etc/target-config.scm /mnt/etc/config.scm
 701 guix system build /mnt/etc/config.scm
 702 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 703 sync
 704 reboot\n")
 705
 706 (define (enter-luks-passphrase marionette)
 707   "Return a gexp to be inserted in the basic system test running on MARIONETTE
 708 to enter the LUKS passphrase."
 709   (let ((ocrad (file-append ocrad "/bin/ocrad")))
 710     #~(begin
 711         (define (passphrase-prompt? text)
 712           (string-contains (pk 'screen-text text) "Enter pass"))
 713
 714         (define (bios-boot-screen? text)
 715           ;; Return true if TEXT corresponds to the boot screen, before GRUB's
 716           ;; menu.
 717           (string-prefix? "SeaBIOS" text))
 718
 719         (test-assert "enter LUKS passphrase for GRUB"
 720           (begin
 721             ;; At this point we have no choice but to use OCR to determine
 722             ;; when the passphrase should be entered.
 723             (wait-for-screen-text #$marionette passphrase-prompt?
 724                                   #:ocrad #$ocrad)
 725             (marionette-type "thepassphrase\n" #$marionette)
 726
 727             ;; Now wait until we leave the boot screen.  This is necessary so
 728             ;; we can then be sure we match the "Enter passphrase" prompt from
 729             ;; 'cryptsetup', in the initrd.
 730             (wait-for-screen-text #$marionette (negate bios-boot-screen?)
 731                                   #:ocrad #$ocrad
 732                                   #:timeout 20)))
 733
 734         (test-assert "enter LUKS passphrase for the initrd"
 735           (begin
 736             ;; XXX: Here we use OCR as well but we could instead use QEMU
 737             ;; '-serial stdio' and run it in an input pipe,
 738             (wait-for-screen-text #$marionette passphrase-prompt?
 739                                   #:ocrad #$ocrad
 740                                   #:timeout 60)
 741             (marionette-type "thepassphrase\n" #$marionette)
 742
 743             ;; Take a screenshot for debugging purposes.
 744             (marionette-control (string-append "screendump " #$output
 745                                                "/post-initrd-passphrase.ppm")
 746                                 #$marionette))))))
 747
 748 (define %test-encrypted-os
 749   (system-test
 750    (name "encrypted-root-os")
 751    (description
 752     "Test basic functionality of an OS installed like one would do by hand.
 753 This test is expensive in terms of CPU and storage usage since we need to
 754 build (current-guix) and then store a couple of full system images.")
 755    (value
 756     (mlet* %store-monad ((image   (run-install %encrypted-root-os
 757                                                %encrypted-root-os-source
 758                                                #:script
 759                                                %encrypted-root-installation-script))
 760                          (command (qemu-command/writable-image image)))
 761       (run-basic-test %encrypted-root-os command "encrypted-root-os"
 762                       #:initialization enter-luks-passphrase)))))
 763
 764 \f
 765 ;;;
 766 ;;; Btrfs root file system.
 767 ;;;
 768
 769 (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
 770   ;; The OS we want to install.
 771   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 772
 773   (operating-system
 774     (host-name "liberigilo")
 775     (timezone "Europe/Paris")
 776     (locale "en_US.UTF-8")
 777
 778     (bootloader (bootloader-configuration
 779                  (bootloader grub-bootloader)
 780                  (target "/dev/vdb")))
 781     (kernel-arguments '("console=ttyS0"))
 782     (file-systems (cons (file-system
 783                           (device "my-root")
 784                           (title 'label)
 785                           (mount-point "/")
 786                           (type "btrfs"))
 787                         %base-file-systems))
 788     (users (cons (user-account
 789                   (name "charlie")
 790                   (group "users")
 791                   (home-directory "/home/charlie")
 792                   (supplementary-groups '("wheel" "audio" "video")))
 793                  %base-user-accounts))
 794     (services (cons (service marionette-service-type
 795                              (marionette-configuration
 796                               (imported-modules '((gnu services herd)
 797                                                   (guix combinators)))))
 798                     %base-services))))
 799
 800 (define %btrfs-root-installation-script
 801   ;; Shell script of a simple installation.
 802   "\
 803 . /etc/profile
 804 set -e -x
 805 guix --version
 806
 807 export GUIX_BUILD_OPTIONS=--no-grafts
 808 ls -l /run/current-system/gc-roots
 809 parted --script /dev/vdb mklabel gpt \\
 810   mkpart primary ext2 1M 3M \\
 811   mkpart primary ext2 3M 2G \\
 812   set 1 boot on \\
 813   set 1 bios_grub on
 814 mkfs.btrfs -L my-root /dev/vdb2
 815 mount /dev/vdb2 /mnt
 816 btrfs subvolume create /mnt/home
 817 herd start cow-store /mnt
 818 mkdir /mnt/etc
 819 cp /etc/target-config.scm /mnt/etc/config.scm
 820 guix system build /mnt/etc/config.scm
 821 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 822 sync
 823 reboot\n")
 824
 825 (define %test-btrfs-root-os
 826   (system-test
 827    (name "btrfs-root-os")
 828    (description
 829     "Test basic functionality of an OS installed like one would do by hand.
 830 This test is expensive in terms of CPU and storage usage since we need to
 831 build (current-guix) and then store a couple of full system images.")
 832    (value
 833     (mlet* %store-monad ((image   (run-install %btrfs-root-os
 834                                                %btrfs-root-os-source
 835                                                #:script
 836                                                %btrfs-root-installation-script))
 837                          (command (qemu-command/writable-image image)))
 838       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 839
 840 ;;; install.scm ends here