gnu/tests/install.scm

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