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