tests: install: Generalize 'run-install'.
* gnu/tests/install.scm (%simple-installation-script): New variable. Contains installation script formerly in 'run-install'. (run-install): Add 'target-os', 'target-os-source', and #:script parameters. Honor them. (qemu-command/writable-image): New procedure. (%test-installed-os): Use it.
This commit is contained in:
Ludovic Courtès
parent
2bdd7ac17c
commit
b1bf155ffd
|
|
@ -32,7 +32,8 @@
|
|||
#:use-module (guix grafts)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix utils)
|
||||
#:export (%test-installed-os))
|
||||
#:export (%test-installed-os
|
||||
%test-encrypted-os))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -91,7 +92,33 @@
|
|||
|
||||
(define MiB (expt 2 20))
|
||||
|
||||
(define* (run-install #:key
|
||||
(define %simple-installation-script
|
||||
;; Shell script of a simple installation.
|
||||
"\
|
||||
. /etc/profile
|
||||
set -e -x
|
||||
guix --version
|
||||
|
||||
export GUIX_BUILD_OPTIONS=--no-grafts
|
||||
guix build isc-dhcp
|
||||
parted --script /dev/vdb mklabel gpt \\
|
||||
mkpart primary ext2 1M 3M \\
|
||||
mkpart primary ext2 3M 1G \\
|
||||
set 1 boot on \\
|
||||
set 1 bios_grub on
|
||||
mkfs.ext4 -L my-root /dev/vdb2
|
||||
mount /dev/vdb2 /mnt
|
||||
df -h /mnt
|
||||
herd start cow-store /mnt
|
||||
mkdir /mnt/etc
|
||||
cp /etc/target-config.scm /mnt/etc/config.scm
|
||||
guix system init /mnt/etc/config.scm /mnt --no-substitutes
|
||||
sync
|
||||
reboot\n")
|
||||
|
||||
(define* (run-install target-os target-os-source
|
||||
#:key
|
||||
(script %simple-installation-script)
|
||||
(os (marionette-operating-system
|
||||
;; Since the image has no network access, use the
|
||||
;; current Guix so the store items we need are in
|
||||
|
|
@ -103,12 +130,13 @@
|
|||
#:imported-modules '((gnu services herd)
|
||||
(guix combinators))))
|
||||
(target-size (* 1200 MiB)))
|
||||
"Run the GuixSD installation procedure from OS and return a VM image of
|
||||
TARGET-SIZE bytes containing the installed system."
|
||||
"Run SCRIPT (a shell script following the GuixSD installation procedure) in
|
||||
OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing
|
||||
the installed system."
|
||||
|
||||
(mlet* %store-monad ((_ (set-grafting #f))
|
||||
(system (current-system))
|
||||
(target (operating-system-derivation %minimal-os))
|
||||
(target (operating-system-derivation target-os))
|
||||
|
||||
;; Since the installation system has no network access,
|
||||
;; we cheat a little bit by adding TARGET to its GC
|
||||
|
|
@ -152,51 +180,21 @@ TARGET-SIZE bytes containing the installed system."
|
|||
(start 'term-tty1))
|
||||
marionette)
|
||||
|
||||
(marionette-eval '(call-with-output-file "/etc/litl-config.scm"
|
||||
(marionette-eval '(call-with-output-file "/etc/target-config.scm"
|
||||
(lambda (port)
|
||||
(write '#$%minimal-os-source port)))
|
||||
(write '#$target-os-source port)))
|
||||
marionette)
|
||||
|
||||
(exit (marionette-eval '(zero? (system "
|
||||
. /etc/profile
|
||||
set -e -x;
|
||||
guix --version
|
||||
guix gc --list-live | grep isc-dhcp
|
||||
|
||||
export GUIX_BUILD_OPTIONS=--no-grafts
|
||||
guix build isc-dhcp
|
||||
parted --script /dev/vdb mklabel gpt \\
|
||||
mkpart primary ext2 1M 3M \\
|
||||
mkpart primary ext2 3M 1G \\
|
||||
set 1 boot on \\
|
||||
set 1 bios_grub on
|
||||
mkfs.ext4 -L my-root /dev/vdb2
|
||||
ls -l /dev/vdb
|
||||
mount /dev/vdb2 /mnt
|
||||
df -h /mnt
|
||||
herd start cow-store /mnt
|
||||
mkdir /mnt/etc
|
||||
cp /etc/litl-config.scm /mnt/etc/config.scm
|
||||
guix system init /mnt/etc/config.scm /mnt --no-substitutes
|
||||
sync
|
||||
reboot\n"))
|
||||
(exit (marionette-eval '(zero? (system #$script))
|
||||
marionette)))))
|
||||
|
||||
(gexp->derivation "installation" install)))
|
||||
|
||||
|
||||
(define %test-installed-os
|
||||
(system-test
|
||||
(name "installed-os")
|
||||
(description
|
||||
"Test basic functionality of an OS installed like one would do by hand.
|
||||
This test is expensive in terms of CPU and storage usage since we need to
|
||||
build (current-guix) and then store a couple of full system images.")
|
||||
(value
|
||||
(mlet %store-monad ((image (run-install))
|
||||
(system (current-system)))
|
||||
(run-basic-test %minimal-os
|
||||
#~(let ((image #$image))
|
||||
(define (qemu-command/writable-image image)
|
||||
"Return as a monadic value the command to run QEMU on a writable copy of
|
||||
IMAGE, a disk image."
|
||||
(mlet %store-monad ((system (current-system)))
|
||||
(return #~(let ((image #$image))
|
||||
;; First we need a writable copy of the image.
|
||||
(format #t "copying image '~a'...~%" image)
|
||||
(copy-file image "disk.img")
|
||||
|
|
@ -207,7 +205,100 @@ build (current-guix) and then store a couple of full system images.")
|
|||
'("-enable-kvm")
|
||||
'())
|
||||
"-no-reboot" "-m" "256"
|
||||
"-drive" "file=disk.img,if=virtio"))
|
||||
"-drive" "file=disk.img,if=virtio")))))
|
||||
|
||||
|
||||
(define %test-installed-os
|
||||
(system-test
|
||||
(name "installed-os")
|
||||
(description
|
||||
"Test basic functionality of an OS installed like one would do by hand.
|
||||
This test is expensive in terms of CPU and storage usage since we need to
|
||||
build (current-guix) and then store a couple of full system images.")
|
||||
(value
|
||||
(mlet* %store-monad ((image (run-install %minimal-os %minimal-os-source))
|
||||
(command (qemu-command/writable-image image)))
|
||||
(run-basic-test %minimal-os command
|
||||
"installed-os")))))
|
||||
|
||||
|
||||
(define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
|
||||
;; The OS we want to install.
|
||||
(use-modules (gnu) (gnu tests) (srfi srfi-1))
|
||||
|
||||
(operating-system
|
||||
(host-name "liberigilo")
|
||||
(timezone "Europe/Paris")
|
||||
(locale "en_US.UTF-8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/vdb")))
|
||||
(kernel-arguments '("console=ttyS0"))
|
||||
(file-systems (cons (file-system
|
||||
(device "/dev/mapper/the-root-device")
|
||||
(title 'device)
|
||||
(mount-point "/")
|
||||
(type "ext4"))
|
||||
%base-file-systems))
|
||||
(mapped-devices (list (mapped-device
|
||||
(source "REPLACE-WITH-LUKS-UUID")
|
||||
(target "the-root-device")
|
||||
(type luks-device-mapping))))
|
||||
(users (cons (user-account
|
||||
(name "charlie")
|
||||
(group "users")
|
||||
(home-directory "/home/charlie")
|
||||
(supplementary-groups '("wheel" "audio" "video")))
|
||||
%base-user-accounts))
|
||||
(services (cons (service marionette-service-type
|
||||
(marionette-configuration
|
||||
(imported-modules '((gnu services herd)
|
||||
(guix combinators)))))
|
||||
%base-services))))
|
||||
|
||||
(define %encrypted-root-installation-script
|
||||
;; Shell script of a simple installation.
|
||||
"\
|
||||
. /etc/profile
|
||||
set -e -x
|
||||
guix --version
|
||||
|
||||
export GUIX_BUILD_OPTIONS=--no-grafts
|
||||
ls -l /run/current-system/gc-roots
|
||||
parted --script /dev/vdb mklabel gpt \\
|
||||
mkpart primary ext2 1M 3M \\
|
||||
mkpart primary ext2 3M 1G \\
|
||||
set 1 boot on \\
|
||||
set 1 bios_grub on
|
||||
echo -n thepassphrase | cryptsetup luksFormat -q /dev/vdb2 -
|
||||
echo -n thepassphrase | \\
|
||||
cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device
|
||||
mkfs.ext4 -L my-root /dev/mapper/the-root-device
|
||||
mount LABEL=my-root /mnt
|
||||
herd start cow-store /mnt
|
||||
mkdir /mnt/etc
|
||||
cp /etc/target-config.scm /mnt/etc/config.scm
|
||||
cat /mnt/etc/config
|
||||
luks_uuid=`cryptsetup luksUUID /dev/vdb2`
|
||||
sed -i /mnt/etc/config.scm \\
|
||||
-e \"s/\\\"REPLACE-WITH-LUKS-UUID\\\"/(uuid \\\"$luks_uuid\\\")/g\"
|
||||
guix system build /mnt/etc/config.scm
|
||||
guix system init /mnt/etc/config.scm /mnt --no-substitutes
|
||||
sync
|
||||
reboot\n")
|
||||
|
||||
(define %test-encrypted-os
|
||||
(system-test
|
||||
(name "encrypted-root-os")
|
||||
(description
|
||||
"Test basic functionality of an OS installed like one would do by hand.
|
||||
This test is expensive in terms of CPU and storage usage since we need to
|
||||
build (current-guix) and then store a couple of full system images.")
|
||||
(value
|
||||
(mlet* %store-monad ((image (run-install %encrypted-root-os
|
||||
%encrypted-root-os-source
|
||||
#:script
|
||||
%encrypted-root-installation-script))
|
||||
(command (qemu-command/writable-image image)))
|
||||
(run-basic-test %encrypted-root-os command "encrypted-root-os")))))
|
||||
|
||||
;;; install.scm ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue