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