gnu/tests/install.scm

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