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