gnu/tests/install.scm

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