gnu/tests/install.scm

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