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