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 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
5 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
6 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
8 ;;; This file is part of GNU Guix.
10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
11 ;;; under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or (at
13 ;;; your option) any later version.
15 ;;; GNU Guix is distributed in the hope that it will be useful, but
16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23 (define-module (gnu tests install)
25 #:use-module (gnu bootloader extlinux)
26 #:use-module (gnu image)
27 #:use-module (gnu tests)
28 #:use-module (gnu tests base)
29 #:use-module (gnu system)
30 #:use-module (gnu system image)
31 #:use-module (gnu system install)
32 #:use-module (gnu system vm)
33 #:use-module ((gnu build vm) #:select (qemu-command))
34 #:use-module (gnu packages admin)
35 #:use-module (gnu packages bootloaders)
36 #:use-module (gnu packages commencement) ;for 'guile-final'
37 #:use-module (gnu packages cryptsetup)
38 #:use-module (gnu packages emacs)
39 #:use-module (gnu packages emacs-xyz)
40 #:use-module (gnu packages linux)
41 #:use-module (gnu packages ocr)
42 #:use-module (gnu packages openbox)
43 #:use-module (gnu packages package-management)
44 #:use-module (gnu packages ratpoison)
45 #:use-module (gnu packages suckless)
46 #:use-module (gnu packages virtualization)
47 #:use-module (gnu packages wm)
48 #:use-module (gnu packages xorg)
49 #:use-module (gnu services desktop)
50 #:use-module (gnu services networking)
51 #:use-module (gnu services xorg)
52 #:use-module (guix store)
53 #:use-module (guix monads)
54 #:use-module (guix packages)
55 #:use-module (guix grafts)
56 #:use-module (guix gexp)
57 #:use-module (guix utils)
58 #:use-module (srfi srfi-1)
59 #:export (%test-installed-os
60 %test-installed-extlinux-os
61 %test-iso-image-installer
62 %test-separate-store-os
63 %test-separate-home-os
65 %test-encrypted-root-os
67 %test-btrfs-root-on-subvolume-os
71 %test-gui-installed-os
72 %test-gui-installed-os-encrypted
73 %test-gui-installed-desktop-os-encrypted))
77 ;;; Test the installation of Guix using the documented approach at the
82 (define-os-with-source (%minimal-os %minimal-os-source)
83 ;; The OS we want to install.
84 (use-modules (gnu) (gnu tests) (srfi srfi-1))
87 (host-name "liberigilo")
88 (timezone "Europe/Paris")
89 (locale "en_US.UTF-8")
91 (bootloader (bootloader-configuration
92 (bootloader grub-bootloader)
94 (kernel-arguments '("console=ttyS0"))
95 (file-systems (cons (file-system
96 (device (file-system-label "my-root"))
100 (users (cons (user-account
102 (comment "Bob's sister")
104 (supplementary-groups '("wheel" "audio" "video")))
105 %base-user-accounts))
106 (services (cons (service marionette-service-type
107 (marionette-configuration
108 (imported-modules '((gnu services herd)
110 (guix combinators)))))
113 (define (operating-system-add-packages os packages)
114 "Append PACKAGES to OS packages list."
117 (packages (append packages (operating-system-packages os)))))
119 (define-os-with-source (%minimal-extlinux-os
120 %minimal-extlinux-os-source)
121 (use-modules (gnu) (gnu tests) (gnu bootloader extlinux)
125 (host-name "liberigilo")
126 (timezone "Europe/Paris")
127 (locale "en_US.UTF-8")
129 (bootloader (bootloader-configuration
130 (bootloader extlinux-bootloader-gpt)
131 (target "/dev/vdb")))
132 (kernel-arguments '("console=ttyS0"))
133 (file-systems (cons (file-system
134 (device (file-system-label "my-root"))
138 (services (cons (service marionette-service-type
139 (marionette-configuration
140 (imported-modules '((gnu services herd)
141 (guix combinators)))))
144 (define (operating-system-with-current-guix os)
145 "Return a variant of OS that uses the current Guix."
148 (services (modify-services (operating-system-user-services os)
149 (guix-service-type config =>
152 (guix (current-guix))))))))
155 (define MiB (expt 2 20))
157 (define %simple-installation-script
158 ;; Shell script of a simple installation.
164 export GUIX_BUILD_OPTIONS=--no-grafts
166 parted --script /dev/vdb mklabel gpt \\
167 mkpart primary ext2 1M 3M \\
168 mkpart primary ext2 3M 1.6G \\
171 mkfs.ext4 -L my-root /dev/vdb2
174 herd start cow-store /mnt
176 cp /etc/target-config.scm /mnt/etc/config.scm
177 guix system init /mnt/etc/config.scm /mnt --no-substitutes
181 (define %extlinux-gpt-installation-script
182 ;; Shell script of a simple installation.
183 ;; As syslinux 6.0.3 does not handle 64bits ext4 partitions,
184 ;; we make sure to pass -O '^64bit' to mkfs.
190 export GUIX_BUILD_OPTIONS=--no-grafts
192 parted --script /dev/vdb mklabel gpt \\
193 mkpart ext2 1M 1.6G \\
195 mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1
198 herd start cow-store /mnt
200 cp /etc/target-config.scm /mnt/etc/config.scm
201 guix system init /mnt/etc/config.scm /mnt --no-substitutes
205 (define* (run-install target-os target-os-source
207 (script %simple-installation-script)
210 (os (marionette-operating-system
212 ;; Since the image has no network access, use the
213 ;; current Guix so the store items we need are in
214 ;; the image and add packages provided.
215 (inherit (operating-system-add-packages
216 (operating-system-with-current-guix
219 (kernel-arguments '("console=ttyS0")))
220 #:imported-modules '((gnu services herd)
221 (gnu installer tests)
222 (guix combinators))))
223 (installation-image-type 'raw)
224 (install-size 'guess)
225 (target-size (* 2200 MiB)))
226 "Run SCRIPT (a shell script following the system installation procedure) in
227 OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing
228 the installed system. The packages specified in PACKAGES will be appended to
229 packages defined in installation-os."
231 (mlet* %store-monad ((_ (set-grafting #f))
232 (system (current-system))
234 ;; Since the installation system has no network access,
235 ;; we cheat a little bit by adding TARGET to its GC
236 ;; roots. This way, we know 'guix system init' will
237 ;; succeed. Also add guile-final, which is pulled in
238 ;; through provenance.drv and may not always be present.
239 (target (operating-system-derivation target-os))
242 (operating-system-with-gc-roots
243 os (list target guile-final))
244 #:type (lookup-image-type-by-name
245 installation-image-type)))
252 ;; Don't provide substitutes; too big.
253 (substitutable? #f)))))
255 (with-imported-modules '((guix build utils)
256 (gnu build marionette))
258 (use-modules (guix build utils)
259 (gnu build marionette))
261 (set-path-environment-variable "PATH" '("bin")
262 (list #$qemu-minimal))
264 (system* "qemu-img" "create" "-f" "qcow2"
265 #$output #$(number->string target-size))
269 `(,(which #$(qemu-command system))
273 ((eq? 'raw installation-image-type)
275 ,(string-append "file=" #$image
276 ",if=virtio,readonly")))
277 ((eq? 'uncompressed-iso9660 installation-image-type)
278 #~("-cdrom" #$image))
281 "unsupported installation-image-type:"
282 installation-image-type)))
284 ,(string-append "file=" #$output ",if=virtio")
285 ,@(if (file-exists? "/dev/kvm")
289 (pk 'uname (marionette-eval '(uname) marionette))
292 (marionette-eval '(begin
293 (use-modules (gnu services herd))
297 (when #$(->bool script)
298 (marionette-eval '(call-with-output-file "/etc/target-config.scm"
300 (write '#$target-os-source port)))
303 ;; Run SCRIPT. It typically invokes 'reboot' as a last step and
304 ;; thus normally gets killed with SIGTERM by PID 1.
305 (let ((status (marionette-eval '(system #$script) marionette)))
306 (exit (or (eof-object? status)
307 (equal? (status:term-sig status) SIGTERM)
308 (equal? (status:exit-val status) 0)))))
310 (when #$(->bool gui-test)
311 (wait-for-unix-socket "/var/guix/installer-socket"
313 (format #t "installer socket ready~%")
315 (exit #$(and gui-test
316 (gui-test #~marionette)))))))
318 (gexp->derivation "installation" install
319 #:substitutable? #f))) ;too big
321 (define* (qemu-command/writable-image image #:key (memory-size 256))
322 "Return as a monadic value the command to run QEMU on a writable copy of
323 IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM."
324 (mlet %store-monad ((system (current-system)))
325 (return #~(let ((image #$image))
326 ;; First we need a writable copy of the image.
327 (format #t "creating writable image from '~a'...~%" image)
328 (unless (zero? (system* #+(file-append qemu-minimal
330 "create" "-f" "qcow2"
332 (string-append "backing_file=" image)
334 (error "failed to create writable QEMU image" image))
336 (chmod "disk.img" #o644)
337 `(,(string-append #$qemu-minimal "/bin/"
338 #$(qemu-command system))
339 ,@(if (file-exists? "/dev/kvm")
342 "-no-reboot" "-m" #$(number->string memory-size)
343 "-drive" "file=disk.img,if=virtio")))))
345 (define %test-installed-os
347 (name "installed-os")
349 "Test basic functionality of an OS installed like one would do by hand.
350 This test is expensive in terms of CPU and storage usage since we need to
351 build (current-guix) and then store a couple of full system images.")
353 (mlet* %store-monad ((image (run-install %minimal-os %minimal-os-source))
354 (command (qemu-command/writable-image image)))
355 (run-basic-test %minimal-os command
358 (define %test-installed-extlinux-os
360 (name "installed-extlinux-os")
362 "Test basic functionality of an OS booted with an extlinux bootloader. As
363 per %test-installed-os, this test is expensive in terms of CPU and storage.")
365 (mlet* %store-monad ((image (run-install %minimal-extlinux-os
366 %minimal-extlinux-os-source
370 %extlinux-gpt-installation-script))
371 (command (qemu-command/writable-image image)))
372 (run-basic-test %minimal-extlinux-os command
373 "installed-extlinux-os")))))
377 ;;; Installation through an ISO image.
380 (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
381 ;; The OS we want to install.
382 (use-modules (gnu) (gnu tests) (srfi srfi-1))
385 (host-name "liberigilo")
386 (timezone "Europe/Paris")
387 (locale "en_US.UTF-8")
389 (bootloader (bootloader-configuration
390 (bootloader grub-bootloader)
391 (target "/dev/vda")))
392 (kernel-arguments '("console=ttyS0"))
393 (file-systems (cons (file-system
394 (device (file-system-label "my-root"))
398 (users (cons (user-account
400 (comment "Bob's sister")
402 (supplementary-groups '("wheel" "audio" "video")))
403 %base-user-accounts))
404 (services (cons (service marionette-service-type
405 (marionette-configuration
406 (imported-modules '((gnu services herd)
408 (guix combinators)))))
411 (define %simple-installation-script-for-/dev/vda
412 ;; Shell script of a simple installation.
418 export GUIX_BUILD_OPTIONS=--no-grafts
420 parted --script /dev/vda mklabel gpt \\
421 mkpart primary ext2 1M 3M \\
422 mkpart primary ext2 3M 1.6G \\
425 mkfs.ext4 -L my-root /dev/vda2
428 herd start cow-store /mnt
430 cp /etc/target-config.scm /mnt/etc/config.scm
431 guix system init /mnt/etc/config.scm /mnt --no-substitutes
435 (define %test-iso-image-installer
437 (name "iso-image-installer")
441 (mlet* %store-monad ((image (run-install
443 %minimal-os-on-vda-source
445 %simple-installation-script-for-/dev/vda
446 #:installation-image-type
447 'uncompressed-iso9660))
448 (command (qemu-command/writable-image image)))
449 (run-basic-test %minimal-os-on-vda command name)))))
456 (define-os-with-source (%separate-home-os %separate-home-os-source)
457 ;; The OS we want to install.
458 (use-modules (gnu) (gnu tests) (srfi srfi-1))
461 (host-name "liberigilo")
462 (timezone "Europe/Paris")
463 (locale "en_US.utf8")
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 "my-root"))
475 (mount-point "/home")
478 (users (cons* (user-account
484 %base-user-accounts))
485 (services (cons (service marionette-service-type
486 (marionette-configuration
487 (imported-modules '((gnu services herd)
488 (guix combinators)))))
491 (define %test-separate-home-os
493 (name "separate-home-os")
495 "Test basic functionality of an installed OS with a separate /home
496 partition. In particular, home directories must be correctly created (see
497 <https://bugs.gnu.org/21108>).")
499 (mlet* %store-monad ((image (run-install %separate-home-os
500 %separate-home-os-source
502 %simple-installation-script))
503 (command (qemu-command/writable-image image)))
504 (run-basic-test %separate-home-os command "separate-home-os")))))
508 ;;; Separate /gnu/store partition.
511 (define-os-with-source (%separate-store-os %separate-store-os-source)
512 ;; The OS we want to install.
513 (use-modules (gnu) (gnu tests) (srfi srfi-1))
516 (host-name "liberigilo")
517 (timezone "Europe/Paris")
518 (locale "en_US.UTF-8")
520 (bootloader (bootloader-configuration
521 (bootloader grub-bootloader)
522 (target "/dev/vdb")))
523 (kernel-arguments '("console=ttyS0"))
524 (file-systems (cons* (file-system
525 (device (file-system-label "root-fs"))
529 (device (file-system-label "store-fs"))
533 (users %base-user-accounts)
534 (services (cons (service marionette-service-type
535 (marionette-configuration
536 (imported-modules '((gnu services herd)
537 (guix combinators)))))
540 (define %separate-store-installation-script
541 ;; Installation with a separate /gnu partition.
547 export GUIX_BUILD_OPTIONS=--no-grafts
549 parted --script /dev/vdb mklabel gpt \\
550 mkpart primary ext2 1M 3M \\
551 mkpart primary ext2 3M 400M \\
552 mkpart primary ext2 400M 2.1G \\
555 mkfs.ext4 -L root-fs /dev/vdb2
556 mkfs.ext4 -L store-fs /dev/vdb3
559 mount /dev/vdb3 /mnt/gnu
562 herd start cow-store /mnt
564 cp /etc/target-config.scm /mnt/etc/config.scm
565 guix system init /mnt/etc/config.scm /mnt --no-substitutes
569 (define %test-separate-store-os
571 (name "separate-store-os")
573 "Test basic functionality of an OS installed like one would do by hand,
574 where /gnu lives on a separate partition.")
576 (mlet* %store-monad ((image (run-install %separate-store-os
577 %separate-store-os-source
579 %separate-store-installation-script))
580 (command (qemu-command/writable-image image)))
581 (run-basic-test %separate-store-os command "separate-store-os")))))
585 ;;; RAID root device.
588 (define-os-with-source (%raid-root-os %raid-root-os-source)
589 ;; An OS whose root partition is a RAID partition.
590 (use-modules (gnu) (gnu tests))
593 (host-name "raidified")
594 (timezone "Europe/Paris")
595 (locale "en_US.utf8")
597 (bootloader (bootloader-configuration
598 (bootloader grub-bootloader)
599 (target "/dev/vdb")))
600 (kernel-arguments '("console=ttyS0"))
602 ;; Add a kernel module for RAID-1 (aka. "mirror").
603 (initrd-modules (cons "raid1" %base-initrd-modules))
605 (mapped-devices (list (mapped-device
606 (source (list "/dev/vda2" "/dev/vda3"))
608 (type raid-device-mapping))))
609 (file-systems (cons (file-system
610 (device (file-system-label "root-fs"))
613 (dependencies mapped-devices))
615 (users %base-user-accounts)
616 (services (cons (service marionette-service-type
617 (marionette-configuration
618 (imported-modules '((gnu services herd)
619 (guix combinators)))))
622 (define %raid-root-installation-script
623 ;; Installation with a separate /gnu partition. See
624 ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and
631 export GUIX_BUILD_OPTIONS=--no-grafts
632 parted --script /dev/vdb mklabel gpt \\
633 mkpart primary ext2 1M 3M \\
634 mkpart primary ext2 3M 1.6G \\
635 mkpart primary ext2 1.6G 3.2G \\
638 yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\
640 mkfs.ext4 -L root-fs /dev/md0
643 herd start cow-store /mnt
645 cp /etc/target-config.scm /mnt/etc/config.scm
646 guix system init /mnt/etc/config.scm /mnt --no-substitutes
650 (define %test-raid-root-os
652 (name "raid-root-os")
654 "Test functionality of an OS installed with a RAID root partition managed
657 (mlet* %store-monad ((image (run-install %raid-root-os
660 %raid-root-installation-script
661 #:target-size (* 3200 MiB)))
662 (command (qemu-command/writable-image image)))
663 (run-basic-test %raid-root-os
664 `(,@command) "raid-root-os")))))
668 ;;; LUKS-encrypted root file system.
671 (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
672 ;; The OS we want to install.
673 (use-modules (gnu) (gnu tests) (srfi srfi-1))
676 (host-name "liberigilo")
677 (timezone "Europe/Paris")
678 (locale "en_US.UTF-8")
680 (bootloader (bootloader-configuration
681 (bootloader grub-bootloader)
682 (target "/dev/vdb")))
684 ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
685 ;; detection logic in 'enter-luks-passphrase'.
687 (mapped-devices (list (mapped-device
688 (source (uuid "12345678-1234-1234-1234-123456789abc"))
689 (target "the-root-device")
690 (type luks-device-mapping))))
691 (file-systems (cons (file-system
692 (device "/dev/mapper/the-root-device")
696 (users (cons (user-account
699 (supplementary-groups '("wheel" "audio" "video")))
700 %base-user-accounts))
701 (services (cons (service marionette-service-type
702 (marionette-configuration
703 (imported-modules '((gnu services herd)
704 (guix combinators)))))
707 (define %luks-passphrase
708 ;; LUKS encryption passphrase used in tests.
711 (define %encrypted-root-installation-script
712 ;; Shell script of a simple installation.
718 export GUIX_BUILD_OPTIONS=--no-grafts
719 ls -l /run/current-system/gc-roots
720 parted --script /dev/vdb mklabel gpt \\
721 mkpart primary ext2 1M 3M \\
722 mkpart primary ext2 3M 1.6G \\
725 echo -n " %luks-passphrase " | \\
726 cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 -
727 echo -n " %luks-passphrase " | \\
728 cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
729 mkfs.ext4 -L my-root /dev/mapper/the-root-device
730 mount LABEL=my-root /mnt
731 herd start cow-store /mnt
733 cp /etc/target-config.scm /mnt/etc/config.scm
734 guix system build /mnt/etc/config.scm
735 guix system init /mnt/etc/config.scm /mnt --no-substitutes
739 (define (enter-luks-passphrase marionette)
740 "Return a gexp to be inserted in the basic system test running on MARIONETTE
741 to enter the LUKS passphrase."
742 (let ((ocrad (file-append ocrad "/bin/ocrad")))
744 (define (passphrase-prompt? text)
745 (string-contains (pk 'screen-text text) "Enter pass"))
747 (define (bios-boot-screen? text)
748 ;; Return true if TEXT corresponds to the boot screen, before GRUB's
750 (string-prefix? "SeaBIOS" text))
752 (test-assert "enter LUKS passphrase for GRUB"
754 ;; At this point we have no choice but to use OCR to determine
755 ;; when the passphrase should be entered.
756 (wait-for-screen-text #$marionette passphrase-prompt?
758 (marionette-type #$(string-append %luks-passphrase "\n")
761 ;; Now wait until we leave the boot screen. This is necessary so
762 ;; we can then be sure we match the "Enter passphrase" prompt from
763 ;; 'cryptsetup', in the initrd.
764 (wait-for-screen-text #$marionette (negate bios-boot-screen?)
768 (test-assert "enter LUKS passphrase for the initrd"
770 ;; XXX: Here we use OCR as well but we could instead use QEMU
771 ;; '-serial stdio' and run it in an input pipe,
772 (wait-for-screen-text #$marionette passphrase-prompt?
775 (marionette-type #$(string-append %luks-passphrase "\n")
778 ;; Take a screenshot for debugging purposes.
779 (marionette-control (string-append "screendump " #$output
780 "/post-initrd-passphrase.ppm")
783 (define %test-encrypted-root-os
785 (name "encrypted-root-os")
787 "Test basic functionality of an OS installed like one would do by hand.
788 This test is expensive in terms of CPU and storage usage since we need to
789 build (current-guix) and then store a couple of full system images.")
791 (mlet* %store-monad ((image (run-install %encrypted-root-os
792 %encrypted-root-os-source
794 %encrypted-root-installation-script))
795 (command (qemu-command/writable-image image)))
796 (run-basic-test %encrypted-root-os command "encrypted-root-os"
797 #:initialization enter-luks-passphrase)))))
801 ;;; Btrfs root file system.
804 (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
805 ;; The OS we want to install.
806 (use-modules (gnu) (gnu tests) (srfi srfi-1))
809 (host-name "liberigilo")
810 (timezone "Europe/Paris")
811 (locale "en_US.UTF-8")
813 (bootloader (bootloader-configuration
814 (bootloader grub-bootloader)
815 (target "/dev/vdb")))
816 (kernel-arguments '("console=ttyS0"))
817 (file-systems (cons (file-system
818 (device (file-system-label "my-root"))
822 (users (cons (user-account
825 (supplementary-groups '("wheel" "audio" "video")))
826 %base-user-accounts))
827 (services (cons (service marionette-service-type
828 (marionette-configuration
829 (imported-modules '((gnu services herd)
830 (guix combinators)))))
833 (define %btrfs-root-installation-script
834 ;; Shell script of a simple installation.
840 export GUIX_BUILD_OPTIONS=--no-grafts
841 ls -l /run/current-system/gc-roots
842 parted --script /dev/vdb mklabel gpt \\
843 mkpart primary ext2 1M 3M \\
844 mkpart primary ext2 3M 2G \\
847 mkfs.btrfs -L my-root /dev/vdb2
849 btrfs subvolume create /mnt/home
850 herd start cow-store /mnt
852 cp /etc/target-config.scm /mnt/etc/config.scm
853 guix system build /mnt/etc/config.scm
854 guix system init /mnt/etc/config.scm /mnt --no-substitutes
858 (define %test-btrfs-root-os
860 (name "btrfs-root-os")
862 "Test basic functionality of an OS installed like one would do by hand.
863 This test is expensive in terms of CPU and storage usage since we need to
864 build (current-guix) and then store a couple of full system images.")
866 (mlet* %store-monad ((image (run-install %btrfs-root-os
867 %btrfs-root-os-source
869 %btrfs-root-installation-script))
870 (command (qemu-command/writable-image image)))
871 (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
875 ;;; Btrfs root file system on a subvolume.
878 (define-os-with-source (%btrfs-root-on-subvolume-os
879 %btrfs-root-on-subvolume-os-source)
880 ;; The OS we want to install.
881 (use-modules (gnu) (gnu tests) (srfi srfi-1))
885 (timezone "America/Montreal")
886 (locale "en_US.UTF-8")
887 (bootloader (bootloader-configuration
888 (bootloader grub-bootloader)
889 (target "/dev/vdb")))
890 (kernel-arguments '("console=ttyS0"))
891 (file-systems (cons* (file-system
892 (device (file-system-label "btrfs-pool"))
894 (options "subvol=rootfs,compress=zstd")
897 (device (file-system-label "btrfs-pool"))
898 (mount-point "/home")
899 (options "subvol=homefs,compress=lzo")
902 (users (cons (user-account
905 (supplementary-groups '("wheel" "audio" "video")))
906 %base-user-accounts))
907 (services (cons (service marionette-service-type
908 (marionette-configuration
909 (imported-modules '((gnu services herd)
910 (guix combinators)))))
913 (define %btrfs-root-on-subvolume-installation-script
914 ;; Shell script of a simple installation.
920 export GUIX_BUILD_OPTIONS=--no-grafts
921 ls -l /run/current-system/gc-roots
922 parted --script /dev/vdb mklabel gpt \\
923 mkpart primary ext2 1M 3M \\
924 mkpart primary ext2 3M 2G \\
928 # Setup the top level Btrfs file system with its subvolume.
929 mkfs.btrfs -L btrfs-pool /dev/vdb2
931 btrfs subvolume create /mnt/rootfs
932 btrfs subvolume create /mnt/homefs
935 # Mount the subvolumes, ready for installation.
936 mount LABEL=btrfs-pool -o 'subvol=rootfs,compress=zstd' /mnt
938 mount LABEL=btrfs-pool -o 'subvol=homefs,compress=zstd' /mnt/home
940 herd start cow-store /mnt
942 cp /etc/target-config.scm /mnt/etc/config.scm
943 guix system build /mnt/etc/config.scm
944 guix system init /mnt/etc/config.scm /mnt --no-substitutes
948 (define %test-btrfs-root-on-subvolume-os
950 (name "btrfs-root-on-subvolume-os")
952 "Test basic functionality of an OS installed like one would do by hand.
953 This test is expensive in terms of CPU and storage usage since we need to
954 build (current-guix) and then store a couple of full system images.")
958 (run-install %btrfs-root-on-subvolume-os
959 %btrfs-root-on-subvolume-os-source
961 %btrfs-root-on-subvolume-installation-script))
962 (command (qemu-command/writable-image image)))
963 (run-basic-test %btrfs-root-on-subvolume-os command
964 "btrfs-root-on-subvolume-os")))))
968 ;;; JFS root file system.
971 (define-os-with-source (%jfs-root-os %jfs-root-os-source)
972 ;; The OS we want to install.
973 (use-modules (gnu) (gnu tests) (srfi srfi-1))
976 (host-name "liberigilo")
977 (timezone "Europe/Paris")
978 (locale "en_US.UTF-8")
980 (bootloader (bootloader-configuration
981 (bootloader grub-bootloader)
982 (target "/dev/vdb")))
983 (kernel-arguments '("console=ttyS0"))
984 (file-systems (cons (file-system
985 (device (file-system-label "my-root"))
989 (users (cons (user-account
992 (supplementary-groups '("wheel" "audio" "video")))
993 %base-user-accounts))
994 (services (cons (service marionette-service-type
995 (marionette-configuration
996 (imported-modules '((gnu services herd)
997 (guix combinators)))))
1000 (define %jfs-root-installation-script
1001 ;; Shell script of a simple installation.
1007 export GUIX_BUILD_OPTIONS=--no-grafts
1008 ls -l /run/current-system/gc-roots
1009 parted --script /dev/vdb mklabel gpt \\
1010 mkpart primary ext2 1M 3M \\
1011 mkpart primary ext2 3M 2G \\
1014 jfs_mkfs -L my-root -q /dev/vdb2
1015 mount /dev/vdb2 /mnt
1016 herd start cow-store /mnt
1018 cp /etc/target-config.scm /mnt/etc/config.scm
1019 guix system build /mnt/etc/config.scm
1020 guix system init /mnt/etc/config.scm /mnt --no-substitutes
1024 (define %test-jfs-root-os
1026 (name "jfs-root-os")
1028 "Test basic functionality of an OS installed like one would do by hand.
1029 This test is expensive in terms of CPU and storage usage since we need to
1030 build (current-guix) and then store a couple of full system images.")
1032 (mlet* %store-monad ((image (run-install %jfs-root-os
1035 %jfs-root-installation-script))
1036 (command (qemu-command/writable-image image)))
1037 (run-basic-test %jfs-root-os command "jfs-root-os")))))
1041 ;;; F2FS root file system.
1044 (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
1045 ;; The OS we want to install.
1046 (use-modules (gnu) (gnu tests) (srfi srfi-1))
1049 (host-name "liberigilo")
1050 (timezone "Europe/Paris")
1051 (locale "en_US.UTF-8")
1053 (bootloader (bootloader-configuration
1054 (bootloader grub-bootloader)
1055 (target "/dev/vdb")))
1056 (kernel-arguments '("console=ttyS0"))
1057 (file-systems (cons (file-system
1058 (device (file-system-label "my-root"))
1061 %base-file-systems))
1062 (users (cons (user-account
1065 (supplementary-groups '("wheel" "audio" "video")))
1066 %base-user-accounts))
1067 (services (cons (service marionette-service-type
1068 (marionette-configuration
1069 (imported-modules '((gnu services herd)
1070 (guix combinators)))))
1073 (define %f2fs-root-installation-script
1074 ;; Shell script of a simple installation.
1080 export GUIX_BUILD_OPTIONS=--no-grafts
1081 ls -l /run/current-system/gc-roots
1082 parted --script /dev/vdb mklabel gpt \\
1083 mkpart primary ext2 1M 3M \\
1084 mkpart primary ext2 3M 2G \\
1087 mkfs.f2fs -l my-root -q /dev/vdb2
1088 mount /dev/vdb2 /mnt
1089 herd start cow-store /mnt
1091 cp /etc/target-config.scm /mnt/etc/config.scm
1092 guix system build /mnt/etc/config.scm
1093 guix system init /mnt/etc/config.scm /mnt --no-substitutes
1097 (define %test-f2fs-root-os
1099 (name "f2fs-root-os")
1101 "Test basic functionality of an OS installed like one would do by hand.
1102 This test is expensive in terms of CPU and storage usage since we need to
1103 build (current-guix) and then store a couple of full system images.")
1105 (mlet* %store-monad ((image (run-install %f2fs-root-os
1106 %f2fs-root-os-source
1108 %f2fs-root-installation-script))
1109 (command (qemu-command/writable-image image)))
1110 (run-basic-test %f2fs-root-os command "f2fs-root-os")))))
1114 ;;; Installation through the graphical interface.
1117 (define %syslog-conf
1118 ;; Syslog configuration that dumps to /dev/console, so we can see the
1119 ;; installer's messages during the test.
1120 (computed-file "syslog.conf"
1122 (copy-file #$%default-syslog.conf #$output)
1123 (chmod #$output #o644)
1124 (let ((port (open-file #$output "a")))
1125 (display "\n*.info /dev/console\n" port)
1128 (define (operating-system-with-console-syslog os)
1129 "Return OS with a syslog service that writes to /dev/console."
1132 (services (modify-services (operating-system-user-services os)
1133 (syslog-service-type config
1135 (syslog-configuration
1137 (config-file %syslog-conf)))))))
1139 (define %root-password "foo")
1141 (define* (gui-test-program marionette
1146 (define (screenshot file)
1147 (marionette-control (string-append "screendump " file)
1150 (define-syntax-rule (marionette-eval* exp marionette)
1151 (or (marionette-eval exp marionette)
1152 (throw 'marionette-eval-failure 'exp)))
1154 (setvbuf (current-output-port) 'none)
1155 (setvbuf (current-error-port) 'none)
1157 (marionette-eval* '(use-modules (gnu installer tests))
1160 ;; Arrange so that 'converse' prints debugging output to the console.
1161 (marionette-eval* '(let ((console (open-output-file "/dev/console")))
1162 (setvbuf console 'none)
1163 (conversation-log-port console))
1166 ;; Tell the installer to not wait for the Connman "online" status.
1167 (marionette-eval* '(call-with-output-file "/tmp/installer-assume-online"
1171 ;; Run 'guix system init' with '--no-grafts', to cope with the lack of
1173 (marionette-eval* '(call-with-output-file
1174 "/tmp/installer-system-init-options"
1176 (write '("--no-grafts" "--no-substitutes")
1180 (marionette-eval* '(define installer-socket
1181 (open-installer-socket))
1183 (screenshot "installer-start.ppm")
1185 (marionette-eval* '(choose-locale+keyboard installer-socket)
1187 (screenshot "installer-locale.ppm")
1189 ;; Choose the host name that the "basic" test expects.
1190 (marionette-eval* '(enter-host-name+passwords installer-socket
1191 #:host-name "liberigilo"
1198 (screenshot "installer-services.ppm")
1200 (marionette-eval* '(choose-services installer-socket
1201 #:choose-desktop-environment?
1203 #:choose-network-service?
1206 (screenshot "installer-partitioning.ppm")
1208 (marionette-eval* '(choose-partitioning installer-socket
1209 #:encrypted? #$encrypted?
1210 #:passphrase #$%luks-passphrase)
1212 (screenshot "installer-run.ppm")
1214 (unless #$encrypted?
1215 ;; At this point, user partitions are formatted and the installer is
1216 ;; waiting for us to start the final step: generating the
1217 ;; configuration file, etc. Set a fixed UUID on the swap partition
1218 ;; that matches what 'installation-target-os-for-gui-tests' expects.
1219 (marionette-eval* '(invoke #$(file-append util-linux "/sbin/swaplabel")
1220 "-U" "11111111-2222-3333-4444-123456789abc"
1224 (marionette-eval* '(conclude-installation installer-socket)
1230 (define %extra-packages
1231 ;; Packages needed when installing with an encrypted root.
1233 lvm2-static cryptsetup-static e2fsck/static
1236 (define installation-os-for-gui-tests
1237 ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the
1238 ;; target OS, as well as syslog output redirected to the console so we can
1239 ;; see what the installer is up to.
1240 (marionette-operating-system
1242 (inherit (operating-system-with-console-syslog
1243 (operating-system-add-packages
1244 (operating-system-with-current-guix
1247 (kernel-arguments '("console=ttyS0")))
1248 #:imported-modules '((gnu services herd)
1249 (gnu installer tests)
1250 (guix combinators))))
1252 (define* (installation-target-os-for-gui-tests
1253 #:key (encrypted? #f))
1255 (inherit %minimal-os-on-vda)
1256 (users (append (list (user-account
1258 (comment "Bob's sister")
1260 (supplementary-groups
1261 '("wheel" "audio" "video")))
1264 (comment "Alice's brother")
1266 (supplementary-groups
1267 '("wheel" "audio" "video"))))
1268 %base-user-accounts))
1269 ;; The installer does not create a swap device in guided mode with
1270 ;; encryption support. The installer produces a UUID for the partition;
1271 ;; this "UUID" is explicitly set in 'gui-test-program' to the value shown
1273 (swap-devices (if encrypted?
1275 (list (uuid "11111111-2222-3333-4444-123456789abc"))))
1276 (services (cons (service dhcp-client-service-type)
1277 (operating-system-user-services %minimal-os-on-vda)))))
1279 (define* (installation-target-desktop-os-for-gui-tests
1280 #:key (encrypted? #f))
1282 (inherit (installation-target-os-for-gui-tests
1283 #:encrypted? encrypted?))
1284 (keyboard-layout (keyboard-layout "us" "altgr-intl"))
1286 ;; Make sure that all the packages and services that may be used by the
1287 ;; graphical installer are available.
1289 (list openbox awesome i3-wm i3status
1290 dmenu st ratpoison xterm
1291 emacs emacs-exwm emacs-desktop-environment)
1295 (list (service gnome-desktop-service-type)
1296 (service xfce-desktop-service-type)
1297 (service mate-desktop-service-type)
1298 (service enlightenment-desktop-service-type)
1299 (set-xorg-configuration
1301 (keyboard-layout keyboard-layout)))
1302 (service marionette-service-type
1303 (marionette-configuration
1304 (imported-modules '((gnu services herd)
1306 (guix combinators))))))
1307 %desktop-services))))
1309 (define* (guided-installation-test name
1314 (install-size 'guess)
1315 (target-size (* 2200 MiB)))
1319 "Install an OS using the graphical installer and test it.")
1322 ((image (run-install target-os '(this is unused)
1324 #:os installation-os-for-gui-tests
1325 #:install-size install-size
1326 #:target-size target-size
1327 #:installation-image-type
1328 'uncompressed-iso9660
1330 (lambda (marionette)
1334 #:encrypted? encrypted?))))
1335 (command (qemu-command/writable-image image #:memory-size 512)))
1336 (run-basic-test target-os command name
1337 #:initialization (and encrypted? enter-luks-passphrase)
1338 #:root-password %root-password
1339 #:desktop? desktop?)))))
1341 (define %test-gui-installed-os
1342 (guided-installation-test
1344 #:target-os (installation-target-os-for-gui-tests)))
1346 (define %test-gui-installed-os-encrypted
1347 (guided-installation-test
1348 "gui-installed-os-encrypted"
1350 #:target-os (installation-target-os-for-gui-tests
1353 ;; Building a desktop image is very time and space consuming. Install all
1354 ;; desktop environments in a single test to reduce the overhead.
1355 (define %test-gui-installed-desktop-os-encrypted
1356 (guided-installation-test "gui-installed-desktop-os-encrypted"
1360 (installation-target-desktop-os-for-gui-tests
1362 ;; XXX: The disk-image size guess is too low. Use
1363 ;; a constant value until this is fixed.
1364 #:install-size (* 8000 MiB)
1365 #:target-size (* 9000 MiB)))
1367 ;;; install.scm ends here