gnu/tests/install.scm

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