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 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 1.2G \\
 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 1.2G \\
 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 1.2G \\
 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                            (mount-point "/home")
 434                            (type "tmpfs"))
 435                          %base-file-systems))
 436     (users (cons* (user-account
 437                    (name "alice")
 438                    (group "users")
 439                    (home-directory "/home/alice"))
 440                   (user-account
 441                    (name "charlie")
 442                    (group "users")
 443                    (home-directory "/home/charlie"))
 444                   %base-user-accounts))
 445     (services (cons (service marionette-service-type
 446                              (marionette-configuration
 447                               (imported-modules '((gnu services herd)
 448                                                   (guix combinators)))))
 449                     %base-services))))
 450
 451 (define %test-separate-home-os
 452   (system-test
 453    (name "separate-home-os")
 454    (description
 455     "Test basic functionality of an installed OS with a separate /home
 456 partition.  In particular, home directories must be correctly created (see
 457 <https://bugs.gnu.org/21108>).")
 458    (value
 459     (mlet* %store-monad ((image   (run-install %separate-home-os
 460                                                %separate-home-os-source
 461                                                #:script
 462                                                %simple-installation-script))
 463                          (command (qemu-command/writable-image image)))
 464       (run-basic-test %separate-home-os command "separate-home-os")))))
 465
 466 \f
 467 ;;;
 468 ;;; Separate /gnu/store partition.
 469 ;;;
 470
 471 (define-os-with-source (%separate-store-os %separate-store-os-source)
 472   ;; The OS we want to install.
 473   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 474
 475   (operating-system
 476     (host-name "liberigilo")
 477     (timezone "Europe/Paris")
 478     (locale "en_US.UTF-8")
 479
 480     (bootloader (bootloader-configuration
 481                  (bootloader grub-bootloader)
 482                  (target "/dev/vdb")))
 483     (kernel-arguments '("console=ttyS0"))
 484     (file-systems (cons* (file-system
 485                            (device (file-system-label "root-fs"))
 486                            (mount-point "/")
 487                            (type "ext4"))
 488                          (file-system
 489                            (device (file-system-label "store-fs"))
 490                            (mount-point "/gnu")
 491                            (type "ext4"))
 492                          %base-file-systems))
 493     (users %base-user-accounts)
 494     (services (cons (service marionette-service-type
 495                              (marionette-configuration
 496                               (imported-modules '((gnu services herd)
 497                                                   (guix combinators)))))
 498                     %base-services))))
 499
 500 (define %separate-store-installation-script
 501   ;; Installation with a separate /gnu partition.
 502   "\
 503 . /etc/profile
 504 set -e -x
 505 guix --version
 506
 507 export GUIX_BUILD_OPTIONS=--no-grafts
 508 guix build isc-dhcp
 509 parted --script /dev/vdb mklabel gpt \\
 510   mkpart primary ext2 1M 3M \\
 511   mkpart primary ext2 3M 100M \\
 512   mkpart primary ext2 100M 1.2G \\
 513   set 1 boot on \\
 514   set 1 bios_grub on
 515 mkfs.ext4 -L root-fs /dev/vdb2
 516 mkfs.ext4 -L store-fs /dev/vdb3
 517 mount /dev/vdb2 /mnt
 518 mkdir /mnt/gnu
 519 mount /dev/vdb3 /mnt/gnu
 520 df -h /mnt
 521 herd start cow-store /mnt
 522 mkdir /mnt/etc
 523 cp /etc/target-config.scm /mnt/etc/config.scm
 524 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 525 sync
 526 reboot\n")
 527
 528 (define %test-separate-store-os
 529   (system-test
 530    (name "separate-store-os")
 531    (description
 532     "Test basic functionality of an OS installed like one would do by hand,
 533 where /gnu lives on a separate partition.")
 534    (value
 535     (mlet* %store-monad ((image   (run-install %separate-store-os
 536                                                %separate-store-os-source
 537                                                #:script
 538                                                %separate-store-installation-script))
 539                          (command (qemu-command/writable-image image)))
 540       (run-basic-test %separate-store-os command "separate-store-os")))))
 541
 542 \f
 543 ;;;
 544 ;;; RAID root device.
 545 ;;;
 546
 547 (define-os-with-source (%raid-root-os %raid-root-os-source)
 548   ;; An OS whose root partition is a RAID partition.
 549   (use-modules (gnu) (gnu tests))
 550
 551   (operating-system
 552     (host-name "raidified")
 553     (timezone "Europe/Paris")
 554     (locale "en_US.utf8")
 555
 556     (bootloader (bootloader-configuration
 557                  (bootloader grub-bootloader)
 558                  (target "/dev/vdb")))
 559     (kernel-arguments '("console=ttyS0"))
 560
 561     ;; Add a kernel module for RAID-0 (aka. "stripe").
 562     (initrd-modules (cons "raid0" %base-initrd-modules))
 563
 564     (mapped-devices (list (mapped-device
 565                            (source (list "/dev/vda2" "/dev/vda3"))
 566                            (target "/dev/md0")
 567                            (type raid-device-mapping))))
 568     (file-systems (cons (file-system
 569                           (device (file-system-label "root-fs"))
 570                           (mount-point "/")
 571                           (type "ext4")
 572                           (dependencies mapped-devices))
 573                         %base-file-systems))
 574     (users %base-user-accounts)
 575     (services (cons (service marionette-service-type
 576                              (marionette-configuration
 577                               (imported-modules '((gnu services herd)
 578                                                   (guix combinators)))))
 579                     %base-services))))
 580
 581 (define %raid-root-installation-script
 582   ;; Installation with a separate /gnu partition.  See
 583   ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and
 584   ;; mdadm.
 585   "\
 586 . /etc/profile
 587 set -e -x
 588 guix --version
 589
 590 export GUIX_BUILD_OPTIONS=--no-grafts
 591 parted --script /dev/vdb mklabel gpt \\
 592   mkpart primary ext2 1M 3M \\
 593   mkpart primary ext2 3M 600M \\
 594   mkpart primary ext2 600M 1200M \\
 595   set 1 boot on \\
 596   set 1 bios_grub on
 597 mdadm --create /dev/md0 --verbose --level=stripe --raid-devices=2 \\
 598   /dev/vdb2 /dev/vdb3
 599 mkfs.ext4 -L root-fs /dev/md0
 600 mount /dev/md0 /mnt
 601 df -h /mnt
 602 herd start cow-store /mnt
 603 mkdir /mnt/etc
 604 cp /etc/target-config.scm /mnt/etc/config.scm
 605 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 606 sync
 607 reboot\n")
 608
 609 (define %test-raid-root-os
 610   (system-test
 611    (name "raid-root-os")
 612    (description
 613     "Test functionality of an OS installed with a RAID root partition managed
 614 by 'mdadm'.")
 615    (value
 616     (mlet* %store-monad ((image   (run-install %raid-root-os
 617                                                %raid-root-os-source
 618                                                #:script
 619                                                %raid-root-installation-script
 620                                                #:target-size (* 1300 MiB)))
 621                          (command (qemu-command/writable-image image)))
 622       (run-basic-test %raid-root-os
 623                       `(,@command) "raid-root-os")))))
 624
 625 \f
 626 ;;;
 627 ;;; LUKS-encrypted root file system.
 628 ;;;
 629
 630 (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
 631   ;; The OS we want to install.
 632   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 633
 634   (operating-system
 635     (host-name "liberigilo")
 636     (timezone "Europe/Paris")
 637     (locale "en_US.UTF-8")
 638
 639     (bootloader (bootloader-configuration
 640                  (bootloader grub-bootloader)
 641                  (target "/dev/vdb")))
 642
 643     ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
 644     ;; detection logic in 'enter-luks-passphrase'.
 645
 646     (mapped-devices (list (mapped-device
 647                            (source (uuid "12345678-1234-1234-1234-123456789abc"))
 648                            (target "the-root-device")
 649                            (type luks-device-mapping))))
 650     (file-systems (cons (file-system
 651                           (device "/dev/mapper/the-root-device")
 652                           (mount-point "/")
 653                           (type "ext4"))
 654                         %base-file-systems))
 655     (users (cons (user-account
 656                   (name "charlie")
 657                   (group "users")
 658                   (home-directory "/home/charlie")
 659                   (supplementary-groups '("wheel" "audio" "video")))
 660                  %base-user-accounts))
 661     (services (cons (service marionette-service-type
 662                              (marionette-configuration
 663                               (imported-modules '((gnu services herd)
 664                                                   (guix combinators)))))
 665                     %base-services))))
 666
 667 (define %encrypted-root-installation-script
 668   ;; Shell script of a simple installation.
 669   "\
 670 . /etc/profile
 671 set -e -x
 672 guix --version
 673
 674 export GUIX_BUILD_OPTIONS=--no-grafts
 675 ls -l /run/current-system/gc-roots
 676 parted --script /dev/vdb mklabel gpt \\
 677   mkpart primary ext2 1M 3M \\
 678   mkpart primary ext2 3M 1.2G \\
 679   set 1 boot on \\
 680   set 1 bios_grub on
 681 echo -n thepassphrase | \\
 682   cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 -
 683 echo -n thepassphrase | \\
 684   cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
 685 mkfs.ext4 -L my-root /dev/mapper/the-root-device
 686 mount LABEL=my-root /mnt
 687 herd start cow-store /mnt
 688 mkdir /mnt/etc
 689 cp /etc/target-config.scm /mnt/etc/config.scm
 690 guix system build /mnt/etc/config.scm
 691 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 692 sync
 693 reboot\n")
 694
 695 (define (enter-luks-passphrase marionette)
 696   "Return a gexp to be inserted in the basic system test running on MARIONETTE
 697 to enter the LUKS passphrase."
 698   (let ((ocrad (file-append ocrad "/bin/ocrad")))
 699     #~(begin
 700         (define (passphrase-prompt? text)
 701           (string-contains (pk 'screen-text text) "Enter pass"))
 702
 703         (define (bios-boot-screen? text)
 704           ;; Return true if TEXT corresponds to the boot screen, before GRUB's
 705           ;; menu.
 706           (string-prefix? "SeaBIOS" text))
 707
 708         (test-assert "enter LUKS passphrase for GRUB"
 709           (begin
 710             ;; At this point we have no choice but to use OCR to determine
 711             ;; when the passphrase should be entered.
 712             (wait-for-screen-text #$marionette passphrase-prompt?
 713                                   #:ocrad #$ocrad)
 714             (marionette-type "thepassphrase\n" #$marionette)
 715
 716             ;; Now wait until we leave the boot screen.  This is necessary so
 717             ;; we can then be sure we match the "Enter passphrase" prompt from
 718             ;; 'cryptsetup', in the initrd.
 719             (wait-for-screen-text #$marionette (negate bios-boot-screen?)
 720                                   #:ocrad #$ocrad
 721                                   #:timeout 20)))
 722
 723         (test-assert "enter LUKS passphrase for the initrd"
 724           (begin
 725             ;; XXX: Here we use OCR as well but we could instead use QEMU
 726             ;; '-serial stdio' and run it in an input pipe,
 727             (wait-for-screen-text #$marionette passphrase-prompt?
 728                                   #:ocrad #$ocrad
 729                                   #:timeout 60)
 730             (marionette-type "thepassphrase\n" #$marionette)
 731
 732             ;; Take a screenshot for debugging purposes.
 733             (marionette-control (string-append "screendump " #$output
 734                                                "/post-initrd-passphrase.ppm")
 735                                 #$marionette))))))
 736
 737 (define %test-encrypted-root-os
 738   (system-test
 739    (name "encrypted-root-os")
 740    (description
 741     "Test basic functionality of an OS installed like one would do by hand.
 742 This test is expensive in terms of CPU and storage usage since we need to
 743 build (current-guix) and then store a couple of full system images.")
 744    (value
 745     (mlet* %store-monad ((image   (run-install %encrypted-root-os
 746                                                %encrypted-root-os-source
 747                                                #:script
 748                                                %encrypted-root-installation-script))
 749                          (command (qemu-command/writable-image image)))
 750       (run-basic-test %encrypted-root-os command "encrypted-root-os"
 751                       #:initialization enter-luks-passphrase)))))
 752
 753 \f
 754 ;;;
 755 ;;; Btrfs root file system.
 756 ;;;
 757
 758 (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
 759   ;; The OS we want to install.
 760   (use-modules (gnu) (gnu tests) (srfi srfi-1))
 761
 762   (operating-system
 763     (host-name "liberigilo")
 764     (timezone "Europe/Paris")
 765     (locale "en_US.UTF-8")
 766
 767     (bootloader (bootloader-configuration
 768                  (bootloader grub-bootloader)
 769                  (target "/dev/vdb")))
 770     (kernel-arguments '("console=ttyS0"))
 771     (file-systems (cons (file-system
 772                           (device (file-system-label "my-root"))
 773                           (mount-point "/")
 774                           (type "btrfs"))
 775                         %base-file-systems))
 776     (users (cons (user-account
 777                   (name "charlie")
 778                   (group "users")
 779                   (home-directory "/home/charlie")
 780                   (supplementary-groups '("wheel" "audio" "video")))
 781                  %base-user-accounts))
 782     (services (cons (service marionette-service-type
 783                              (marionette-configuration
 784                               (imported-modules '((gnu services herd)
 785                                                   (guix combinators)))))
 786                     %base-services))))
 787
 788 (define %btrfs-root-installation-script
 789   ;; Shell script of a simple installation.
 790   "\
 791 . /etc/profile
 792 set -e -x
 793 guix --version
 794
 795 export GUIX_BUILD_OPTIONS=--no-grafts
 796 ls -l /run/current-system/gc-roots
 797 parted --script /dev/vdb mklabel gpt \\
 798   mkpart primary ext2 1M 3M \\
 799   mkpart primary ext2 3M 2G \\
 800   set 1 boot on \\
 801   set 1 bios_grub on
 802 mkfs.btrfs -L my-root /dev/vdb2
 803 mount /dev/vdb2 /mnt
 804 btrfs subvolume create /mnt/home
 805 herd start cow-store /mnt
 806 mkdir /mnt/etc
 807 cp /etc/target-config.scm /mnt/etc/config.scm
 808 guix system build /mnt/etc/config.scm
 809 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 810 sync
 811 reboot\n")
 812
 813 (define %test-btrfs-root-os
 814   (system-test
 815    (name "btrfs-root-os")
 816    (description
 817     "Test basic functionality of an OS installed like one would do by hand.
 818 This test is expensive in terms of CPU and storage usage since we need to
 819 build (current-guix) and then store a couple of full system images.")
 820    (value
 821     (mlet* %store-monad ((image   (run-install %btrfs-root-os
 822                                                %btrfs-root-os-source
 823                                                #:script
 824                                                %btrfs-root-installation-script))
 825                          (command (qemu-command/writable-image image)))
 826       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 827
 828 ;;; install.scm ends here