aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/idutils.scm
blob: 3dc322f568d4eef13994242c44c6aadee711fbd3 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages idutils)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (guix licenses)
  #:use-module (gnu packages emacs)
  #:use-module (gnu packages))

(define-public idutils
  (package
    (name "idutils")
    (version "4.6")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/idutils/idutils-"
                                 version ".tar.xz"))
             (sha256
              (base32
               "1hmai3422iaqnp34kkzxdnywl7n7pvlxp11vrw66ybxn9wxg90c1"))
             (patches (list
                       (search-patch "diffutils-gets-undeclared.patch")))))
    (build-system gnu-build-system)
    (native-inputs `(("emacs" ,emacs-no-x)))
    (home-page "http://www.gnu.org/software/idutils/")
    (synopsis "Identifier database utilities")
    (description
     "The GNU idutils package includes tools to create an index of textual
tokens used in a list of file names and then to query that index.  Thus, it
allows the user to, for example, find all the uses of a particular function
in a large programming project.  In addition to handling textual tokens, it
can also handle numeric constants and the contents of character strings.")
    (license gpl3+)))
ix build utils) (guix combinators))))) %base-services)))) (define (operating-system-add-packages os packages) "Append PACKAGES to OS packages list." (operating-system (inherit os) (packages (append packages (operating-system-packages os))))) (define-os-with-source (%minimal-extlinux-os %minimal-extlinux-os-source) (use-modules (gnu) (gnu tests) (gnu bootloader extlinux) (srfi srfi-1)) (operating-system (host-name "liberigilo") (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader extlinux-bootloader-gpt) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define MiB (expt 2 20)) (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 1.6G \\ 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 %extlinux-gpt-installation-script ;; Shell script of a simple installation. ;; As syslinux 6.0.3 does not handle 64bits ext4 partitions, ;; we make sure to pass -O '^64bit' to mkfs. "\ . /etc/profile set -e -x guix --version export GUIX_BUILD_OPTIONS=--no-grafts guix build isc-dhcp parted --script /dev/vdb mklabel gpt \\ mkpart ext2 1M 1.6G \\ set 1 legacy_boot on mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1 mount /dev/vdb1 /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 (uefi-firmware system) "Return the appropriate QEMU OVMF UEFI firmware for the given SYSTEM." (cond ((string-prefix? "x86_64" system) (file-append ovmf-x86-64 "/share/firmware/ovmf_x64.bin")) ((string-prefix? "i686" system) (file-append ovmf-i686 "/share/firmware/ovmf_ia32.bin")) ((string-prefix? "aarch64" system) (file-append ovmf-aarch64 "/share/firmware/ovmf_aarch64.bin")) (else #f))) (define* (run-install target-os target-os-source #:key (script %simple-installation-script) (gui-test #f) (packages '()) (os (marionette-operating-system (operating-system ;; Since the image has no network access, use the ;; current Guix so the store items we need are in ;; the image and add packages provided. (inherit installation-os) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) (gnu installer tests) (guix combinators)))) (uefi-support? #f) (installation-image-type 'mbr-raw) (install-size 'guess) (target-size (* 2200 MiB)) (number-of-disks 1)) "Run SCRIPT (a shell script following the system installation procedure) in OS to install TARGET-OS. Return the VM disk images of TARGET-SIZE bytes containing the installed system. PACKAGES is a list of packages added to OS. NUMBER-OF-DISKS can be used to specify a number of disks different than one, such as for RAID systems." (mlet* %store-monad ((_ (set-grafting #f)) (system (current-system)) (uefi-firmware -> (and uefi-support? (uefi-firmware system))) ;; Since the installation system has no network access, ;; we cheat a little bit by adding TARGET to its GC ;; roots. This way, we know 'guix system init' will ;; succeed. Also add guile-final, which is pulled in ;; through provenance.drv and may not always be present. (target (operating-system-derivation target-os)) (base-image -> (os->image (operating-system-with-gc-roots (operating-system-add-packages os packages) (list target guile-final)) #:type (lookup-image-type-by-name installation-image-type))) (image -> (system-image (image (inherit base-image) (size install-size) ;; Don't provide substitutes; too big. (substitutable? #f))))) (define install (with-imported-modules '((guix build utils) (gnu build marionette)) #~(begin (use-modules (guix build utils) (gnu build marionette) (srfi srfi-1)) (set-path-environment-variable "PATH" '("bin") (list #$qemu-minimal)) (mkdir-p #$output) (for-each (lambda (n) (system* "qemu-img" "create" "-f" "qcow2" (format #f "~a/disk~a.qcow2" #$output n) #$(number->string target-size))) (iota #$number-of-disks)) (define marionette (make-marionette `(,(which #$(qemu-command system)) ;; Neither of these architectures have a default machine. ,@(if (or (string=? "aarch64-linux" #$system) (string=? "armhf-linux" #$system)) '("-machine" "virt" "-cpu" "host") '()) "-no-reboot" "-m" "1200" ,@(if #$uefi-firmware '("-bios" #$uefi-firmware) '()) #$@(cond ((eq? 'mbr-raw installation-image-type) #~("-drive" ,(string-append "file=" #$image ",if=virtio,readonly"))) ((eq? 'uncompressed-iso9660 installation-image-type) #~("-cdrom" #$image)) (else (error "unsupported installation-image-type:" installation-image-type))) ,@(append-map (lambda (n) (list "-drive" (format #f "file=~a/disk~a.qcow2,if=virtio" #$output n))) (iota #$number-of-disks)) ,@(if (file-exists? "/dev/kvm") '("-enable-kvm") '())))) (pk 'uname (marionette-eval '(uname) marionette)) ;; Wait for tty1. (marionette-eval '(begin (use-modules (gnu services herd)) (start-service 'term-tty1)) marionette) (when #$(->bool script) (marionette-eval '(call-with-output-file "/etc/target-config.scm" (lambda (port) (write '#$target-os-source port))) marionette) ;; Run SCRIPT. It typically invokes 'reboot' as a last step and ;; thus normally gets killed with SIGTERM by PID 1. (let ((status (marionette-eval '(system #$script) marionette))) (exit (or (eof-object? status) (equal? (status:term-sig status) SIGTERM) (equal? (status:exit-val status) 0))))) (when #$(->bool gui-test) (wait-for-unix-socket "/var/guix/installer-socket" marionette) (format #t "installer socket ready~%") (force-output) (exit #$(and gui-test (gui-test #~marionette))))))) (mlet %store-monad ((images-dir (gexp->derivation "installation" install #:substitutable? #f))) ;too big (return (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (find-files #$images-dir))))))) (define* (qemu-command* images #:key (uefi-support? #f) (memory-size 256)) "Return as a monadic value the command to run QEMU with a writable overlay on top of IMAGES, a list of disk images. The QEMU VM has access to MEMORY-SIZE MiB of RAM." (mlet* %store-monad ((system (current-system)) (uefi-firmware -> (and uefi-support? (uefi-firmware system)))) (return #~(begin (use-modules (srfi srfi-1)) `(,(string-append #$qemu-minimal "/bin/" #$(qemu-command system)) ;; Neither of these architectures have a default machine. ,@(if (or (string=? "aarch64-linux" #$system) (string=? "armhf-linux" #$system)) '("-machine" "virt" "-cpu" "host") '()) "-snapshot" ;for the volatile, writable overlay ,@(if (file-exists? "/dev/kvm") '("-enable-kvm") '()) ,@(if #$uefi-firmware '("-bios" #$uefi-firmware) '()) "-no-reboot" "-m" #$(number->string memory-size) ,@(append-map (lambda (image) (list "-drive" (format #f "file=~a,if=virtio" image))) #$images)))))) (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 ((images (run-install %minimal-os %minimal-os-source)) (command (qemu-command* images))) (run-basic-test %minimal-os command "installed-os"))))) (define %test-installed-extlinux-os (system-test (name "installed-extlinux-os") (description "Test basic functionality of an OS booted with an extlinux bootloader. As per %test-installed-os, this test is expensive in terms of CPU and storage.") (value (mlet* %store-monad ((images (run-install %minimal-extlinux-os %minimal-extlinux-os-source #:packages (list syslinux) #:script %extlinux-gpt-installation-script)) (command (qemu-command* images))) (run-basic-test %minimal-extlinux-os command "installed-extlinux-os"))))) ;;; ;;; Installation through an ISO image. ;;; (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vda")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) (users (cons (user-account (name "alice") (comment "Bob's sister") (group "users") (supplementary-groups '("wheel" "audio" "video"))) %base-user-accounts)) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix build utils) (guix combinators))))) %base-services)))) (define %simple-installation-script-for-/dev/vda ;; 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/vda mklabel gpt \\ mkpart primary ext2 1M 3M \\ mkpart primary ext2 3M 1.6G \\ set 1 boot on \\ set 1 bios_grub on mkfs.ext4 -L my-root /dev/vda2 mount /dev/vda2 /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 %test-iso-image-installer (system-test (name "iso-image-installer") (description "") (value (mlet* %store-monad ((images (run-install %minimal-os-on-vda %minimal-os-on-vda-source #:script %simple-installation-script-for-/dev/vda #:installation-image-type 'uncompressed-iso9660)) (command (qemu-command* images))) (run-basic-test %minimal-os-on-vda command name))))) ;;; ;;; Separate /home. ;;; (define-os-with-source (%separate-home-os %separate-home-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.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets '("/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) (file-system (device "none") (mount-point "/home") (type "tmpfs")) %base-file-systems)) (users (cons* (user-account (name "alice") (group "users")) (user-account (name "charlie") (group "users")) %base-user-accounts)) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %test-separate-home-os (system-test (name "separate-home-os") (description "Test basic functionality of an installed OS with a separate /home partition. In particular, home directories must be correctly created (see <https://bugs.gnu.org/21108>).") (value (mlet* %store-monad ((images (run-install %separate-home-os %separate-home-os-source #:script %simple-installation-script)) (command (qemu-command* images))) (run-basic-test %separate-home-os command "separate-home-os"))))) ;;; ;;; Separate /gnu/store partition. ;;; (define-os-with-source (%separate-store-os %separate-store-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "ext4")) (file-system (device (file-system-label "store-fs")) (mount-point "/gnu") (type "ext4")) %base-file-systems)) (users %base-user-accounts) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %separate-store-installation-script ;; Installation with a separate /gnu partition. "\ . /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 400M \\ mkpart primary ext2 400M 2.1G \\ set 1 boot on \\ set 1 bios_grub on mkfs.ext4 -L root-fs /dev/vdb2 mkfs.ext4 -L store-fs /dev/vdb3 mount /dev/vdb2 /mnt mkdir /mnt/gnu mount /dev/vdb3 /mnt/gnu df -h /mnt df -h /mnt/gnu 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 %test-separate-store-os (system-test (name "separate-store-os") (description "Test basic functionality of an OS installed like one would do by hand, where /gnu lives on a separate partition.") (value (mlet* %store-monad ((images (run-install %separate-store-os %separate-store-os-source #:script %separate-store-installation-script)) (command (qemu-command* images))) (run-basic-test %separate-store-os command "separate-store-os"))))) ;;; ;;; RAID root device. ;;; (define-os-with-source (%raid-root-os %raid-root-os-source) ;; An OS whose root partition is a RAID partition. (use-modules (gnu) (gnu tests)) (operating-system (host-name "raidified") (timezone "Europe/Paris") (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) ;; Add a kernel module for RAID-1 (aka. "mirror"). (initrd-modules (cons "raid1" %base-initrd-modules)) (mapped-devices (list (mapped-device (source (list "/dev/vda2" "/dev/vda3")) (target "/dev/md0") (type raid-device-mapping)))) (file-systems (cons (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "ext4") (dependencies mapped-devices)) %base-file-systems)) (users %base-user-accounts) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %raid-root-installation-script ;; Installation with a separate /gnu partition. See ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and ;; mdadm. "\ . /etc/profile set -e -x guix --version export GUIX_BUILD_OPTIONS=--no-grafts parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ mkpart primary ext2 3M 1.6G \\ mkpart primary ext2 1.6G 3.2G \\ set 1 boot on \\ set 1 bios_grub on yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\ /dev/vdb2 /dev/vdb3 mkfs.ext4 -L root-fs /dev/md0 mount /dev/md0 /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 %test-raid-root-os (system-test (name "raid-root-os") (description "Test functionality of an OS installed with a RAID root partition managed by 'mdadm'.") (value (mlet* %store-monad ((images (run-install %raid-root-os %raid-root-os-source #:script %raid-root-installation-script #:target-size (* 3200 MiB))) (command (qemu-command* images))) (run-basic-test %raid-root-os `(,@command) "raid-root-os"))))) ;;; ;;; LUKS-encrypted root file system. ;;; (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 (bootloader-configuration (bootloader grub-bootloader) (targets '("/dev/vdb")))) ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt ;; detection logic in 'enter-luks-passphrase'. (mapped-devices (list (mapped-device (source (uuid "12345678-1234-1234-1234-123456789abc")) (target "the-root-device") (type luks-device-mapping)))) (file-systems (cons (file-system (device "/dev/mapper/the-root-device") (mount-point "/") (type "ext4")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %luks-passphrase ;; LUKS encryption passphrase used in tests. "thepassphrase") (define %encrypted-root-installation-script ;; Shell script of a simple installation. (string-append "\ . /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 2G \\ set 1 boot on \\ set 1 bios_grub on echo -n " %luks-passphrase " | \\ cryptsetup luksFormat -i 1 --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 - echo -n " %luks-passphrase " | \\ 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 guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n")) (define (enter-luks-passphrase marionette) "Return a gexp to be inserted in the basic system test running on MARIONETTE to enter the LUKS passphrase." (let ((ocrad (file-append ocrad "/bin/ocrad"))) #~(begin (define (passphrase-prompt? text) (string-contains (pk 'screen-text text) "Enter pass")) (define (bios-boot-screen? text) ;; Return true if TEXT corresponds to the boot screen, before GRUB's ;; menu. (string-prefix? "SeaBIOS" text)) (test-assert "enter LUKS passphrase for GRUB" (begin ;; At this point we have no choice but to use OCR to determine ;; when the passphrase should be entered. (wait-for-screen-text #$marionette passphrase-prompt? #:ocr #$ocrad) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) ;; Now wait until we leave the boot screen. This is necessary so ;; we can then be sure we match the "Enter passphrase" prompt from ;; 'cryptsetup', in the initrd. (wait-for-screen-text #$marionette (negate bios-boot-screen?) #:ocr #$ocrad #:timeout 20))) (test-assert "enter LUKS passphrase for the initrd" (begin ;; XXX: Here we use OCR as well but we could instead use QEMU ;; '-serial stdio' and run it in an input pipe, (wait-for-screen-text #$marionette passphrase-prompt? #:ocr #$ocrad #:timeout 60) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) ;; Take a screenshot for debugging purposes. (marionette-control (string-append "screendump " #$output "/post-initrd-passphrase.ppm") #$marionette)))))) (define %test-encrypted-root-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 ((images (run-install %encrypted-root-os %encrypted-root-os-source #:script %encrypted-root-installation-script)) (command (qemu-command* images))) (run-basic-test %encrypted-root-os command "encrypted-root-os" #:initialization enter-luks-passphrase))))) ;;; ;;; Separate /home on LVM ;;; ;; Since LVM support in guix currently doesn't allow root-on-LVM we use /home on LVM (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source) (use-modules (gnu) (gnu tests)) (operating-system (host-name "separate-home-on-lvm") (timezone "Europe/Paris") (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (mapped-devices (list (mapped-device (source "vg0") (target "vg0-home") (type lvm-device-mapping)))) (file-systems (cons* (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "ext4")) (file-system (device "/dev/mapper/vg0-home") (mount-point "/home") (type "ext4") (dependencies mapped-devices)) %base-file-systems)) (users %base-user-accounts) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %lvm-separate-home-installation-script "\ . /etc/profile set -e -x guix --version export GUIX_BUILD_OPTIONS=--no-grafts parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ mkpart primary ext2 3M 1.6G \\ mkpart primary 1.6G 3.2G \\ set 1 boot on \\ set 1 bios_grub on pvcreate /dev/vdb3 vgcreate vg0 /dev/vdb3 lvcreate -L 1.6G -n home vg0 vgchange -ay mkfs.ext4 -L root-fs /dev/vdb2 mkfs.ext4 /dev/mapper/vg0-home mount /dev/vdb2 /mnt mkdir /mnt/home mount /dev/mapper/vg0-home /mnt/home df -h /mnt /mnt/home 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 %test-lvm-separate-home-os (system-test (name "lvm-separate-home-os") (description "Test functionality of an OS installed with a LVM /home partition") (value (mlet* %store-monad ((images (run-install %lvm-separate-home-os %lvm-separate-home-os-source #:script %lvm-separate-home-installation-script #:packages (list lvm2-static) #:target-size (* 3200 MiB))) (command (qemu-command* images))) (run-basic-test %lvm-separate-home-os `(,@command) "lvm-separate-home-os"))))) ;;; ;;; LUKS-encrypted /home, unencrypted root. ;;; (define-os-with-source (%encrypted-home-os %encrypted-home-os-source) (use-modules (gnu) (gnu tests)) (operating-system (host-name "cipherhome") (timezone "Europe/Paris") (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt ;; detection logic in 'enter-luks-passphrase'. (mapped-devices (list (mapped-device (source (uuid "12345678-1234-1234-1234-123456789abc")) (target "the-home-device") (type luks-device-mapping)))) (file-systems (cons* (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "ext4")) (file-system (device (file-system-label "home-fs")) (mount-point "/home") (type "ext4") (dependencies mapped-devices)) %base-file-systems)) (users %base-user-accounts) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %encrypted-home-installation-script (string-append "\ . /etc/profile set -e -x guix --version export GUIX_BUILD_OPTIONS=--no-grafts parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ mkpart primary ext2 3M 2G \\ mkpart primary 2G 2.4G \\ set 1 boot on \\ set 1 bios_grub on echo -n " %luks-passphrase " | \\ cryptsetup luksFormat -i 1 --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb3 - echo -n " %luks-passphrase " | \\ cryptsetup open --type luks --key-file - /dev/vdb3 the-home-device mkfs.ext4 -L root-fs /dev/vdb2 mkfs.ext4 -L home-fs /dev/mapper/the-home-device mount /dev/vdb2 /mnt # This script is used for both encrypted-home-os and encrypted-home-os-key-file # tests. So we also add the keyfile here. dd if=/dev/zero of=/key-file.bin bs=4096 count=1 ( cd /mnt; echo /key-file.bin | cpio -oH newc > key-file.cpio chmod 0000 key-file.cpio mv /key-file.bin . ) echo -n " %luks-passphrase " | \\ cryptsetup luksAddKey --key-file - -i 1 /dev/vdb3 /mnt/key-file.bin mkdir /mnt/home mount /dev/mapper/the-home-device /mnt/home df -h /mnt /mnt/home 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 (enter-luks-passphrase-for-home marionette) "Return a gexp to be inserted in the basic system test running on MARIONETTE to enter the LUKS passphrase. Note that 'cryptsetup open' in this case is launched as a shepherd service." (let ((ocrad (file-append ocrad "/bin/ocrad"))) #~(begin (define (passphrase-prompt? text) (string-contains (pk 'screen-text text) "Enter pass")) (test-assert "enter LUKS passphrase for the shepherd service" (begin ;; XXX: Here we use OCR as well but we could instead use QEMU ;; '-serial stdio' and run it in an input pipe, (wait-for-screen-text #$marionette passphrase-prompt? #:ocr #$ocrad #:timeout 120) (marionette-type #$(string-append %luks-passphrase "\n") #$marionette) ;; Take a screenshot for debugging purposes. (marionette-control (string-append "screendump " #$output "/shepherd-passphrase.ppm") #$marionette)))))) (define %test-encrypted-home-os (system-test (name "encrypted-home-os") (description "Test functionality of an OS installed with a LUKS /home partition") (value (mlet* %store-monad ((images (run-install %encrypted-home-os %encrypted-home-os-source #:script %encrypted-home-installation-script #:packages (list cpio) #:target-size (* 3000 MiB))) (command (qemu-command* images))) (run-basic-test %encrypted-home-os command "encrypted-home-os" #:initialization enter-luks-passphrase-for-home))))) ;;; ;;; LUKS-encrypted /home, unencrypted root. The unlock is done using a key ;;; file. ;;; (define-os-with-source (%encrypted-home-os-key-file %encrypted-home-os-key-file-source) (use-modules (gnu) (gnu tests)) (operating-system (host-name "cipherhome") (timezone "Europe/Prague") (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")) (extra-initrd "/key-file.cpio"))) (kernel-arguments '("console=ttyS0")) (mapped-devices (list (mapped-device (source (uuid "12345678-1234-1234-1234-123456789abc")) (target "the-home-device") (type (luks-device-mapping-with-options #:key-file "/key-file.bin"))))) (file-systems (cons* (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "ext4")) (file-system (device (file-system-label "home-fs")) (mount-point "/home") (type "ext4") (dependencies mapped-devices)) %base-file-systems)) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %test-encrypted-home-os-key-file (system-test (name "encrypted-home-os-key-file") (description "Test functionality of an OS installed with a LUKS /home partition with unlock done using a key file") (value (mlet* %store-monad ((images (run-install %encrypted-home-os-key-file %encrypted-home-os-key-file-source #:script %encrypted-home-installation-script #:packages (list cpio) #:target-size (* 3000 MiB))) (command (qemu-command* images))) (run-basic-test %encrypted-home-os-key-file command "encrypted-home-os-key-file"))))) ;;; ;;; LUKS-encrypted root file system and /boot in a non-encrypted partition. ;;; (define-os-with-source (%encrypted-root-not-boot-os %encrypted-root-not-boot-os-source) ;; The OS we want to install. (use-modules (gnu) (gnu tests) (srfi srfi-1)) (operating-system (host-name "bootroot") (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (mapped-devices (list (mapped-device (source (uuid "12345678-1234-1234-1234-123456789abc")) (target "root") (type luks-device-mapping)))) (file-systems (cons* (file-system (device (file-system-label "my-boot")) (mount-point "/boot") (type "ext4")) (file-system (device "/dev/mapper/root") (mount-point "/") (type "ext4")) %base-file-systems)) (users (cons (user-account (name "alice") (group "users") (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-not-boot-installation-script ;; Shell script for an installation with boot not encrypted but root ;; encrypted. (format #f "\ . /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 50M \\ mkpart primary ext2 50M 1.6G \\ set 1 boot on \\ set 1 bios_grub on echo -n \"~a\" | cryptsetup luksFormat -i 1 --uuid=\"~a\" -q /dev/vdb3 - echo -n \"~a\" | cryptsetup open --type luks --key-file - /dev/vdb3 root mkfs.ext4 -L my-root /dev/mapper/root mkfs.ext4 -L my-boot /dev/vdb2 mount LABEL=my-root /mnt mkdir /mnt/boot mount LABEL=my-boot /mnt/boot echo \"Checking mounts\" mount herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync echo \"Debugging info\" blkid cat /mnt/boot/grub/grub.cfg reboot\n" %luks-passphrase "12345678-1234-1234-1234-123456789abc" %luks-passphrase)) (define %test-encrypted-root-not-boot-os (system-test (name "encrypted-root-not-boot-os") (description "Test the manual installation on an OS with / in an encrypted partition but /boot on a different, non-encrypted partition. 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 ((images (run-install %encrypted-root-not-boot-os %encrypted-root-not-boot-os-source #:script %encrypted-root-not-boot-installation-script #:target-size (* 1600 MiB))) (command (qemu-command* images))) (run-basic-test %encrypted-root-not-boot-os command "encrypted-root-not-boot-os" #:initialization enter-luks-passphrase))))) ;;; ;;; Btrfs root file system. ;;; (define-os-with-source (%btrfs-root-os %btrfs-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "btrfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %btrfs-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 2G \\ set 1 boot on \\ set 1 bios_grub on mkfs.btrfs -L my-root /dev/vdb2 mount /dev/vdb2 /mnt btrfs subvolume create /mnt/home herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-btrfs-root-os (system-test (name "btrfs-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 ((images (run-install %btrfs-root-os %btrfs-root-os-source #:script %btrfs-root-installation-script)) (command (qemu-command* images))) (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) ;;; ;;; Btrfs RAID-0 root file system. ;;; (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source) ;; An OS whose root partition is a RAID partition. (use-modules (gnu) (gnu tests)) (operating-system (host-name "liberigilo") (timezone "Europe/Paris") (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "root-fs")) (mount-point "/") (type "btrfs")) %base-file-systems)) (users %base-user-accounts) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix combinators))))) %base-services)))) (define %btrfs-raid-root-installation-script "\ . /etc/profile set -e -x guix --version export GUIX_BUILD_OPTIONS=--no-grafts parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ mkpart primary ext2 3M 1.4G \\ mkpart primary ext2 1.4G 2.8G \\ set 1 boot on \\ set 1 bios_grub on mkfs.btrfs -L root-fs -d raid0 -m raid0 /dev/vdb2 /dev/vdb3 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 %test-btrfs-raid-root-os (system-test (name "btrfs-raid-root-os") (description "Test functionality of an OS installed with a Btrfs RAID-0 (stripe) root partition.") (value (mlet* %store-monad ((images (run-install %btrfs-raid-root-os %btrfs-raid-root-os-source #:script %btrfs-raid-root-installation-script #:target-size (* 2800 MiB))) (command (qemu-command* images))) (run-basic-test %btrfs-raid-root-os `(,@command) "btrfs-raid-root-os"))))) ;;; ;;; Btrfs root file system on a subvolume. ;;; (define-os-with-source (%btrfs-root-on-subvolume-os %btrfs-root-on-subvolume-os-source) ;; The OS we want to install. (use-modules (gnu) (gnu tests) (srfi srfi-1)) (operating-system (host-name "hurd") (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (file-system-label "btrfs-pool")) (mount-point "/") (options "subvol=rootfs,compress=zstd") (type "btrfs")) (file-system (device (file-system-label "btrfs-pool")) (mount-point "/home") (options "subvol=homefs,compress=lzo") (type "btrfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %btrfs-root-on-subvolume-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 2G \\ set 1 boot on \\ set 1 bios_grub on # Setup the top level Btrfs file system with its subvolume. mkfs.btrfs -L btrfs-pool /dev/vdb2 mount /dev/vdb2 /mnt btrfs subvolume create /mnt/rootfs btrfs subvolume create /mnt/homefs umount /dev/vdb2 # Mount the subvolumes, ready for installation. mount LABEL=btrfs-pool -o 'subvol=rootfs,compress=zstd' /mnt mkdir /mnt/home mount LABEL=btrfs-pool -o 'subvol=homefs,compress=zstd' /mnt/home herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-btrfs-root-on-subvolume-os (system-test (name "btrfs-root-on-subvolume-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 ((images (run-install %btrfs-root-on-subvolume-os %btrfs-root-on-subvolume-os-source #:script %btrfs-root-on-subvolume-installation-script)) (command (qemu-command* images))) (run-basic-test %btrfs-root-on-subvolume-os command "btrfs-root-on-subvolume-os"))))) ;;; ;;; Btrfs RAID10 root file system. ;;; (define-os-with-source (%btrfs-raid10-root-os %btrfs-raid10-root-os-source) ;; The OS we want to install. (use-modules (gnu) (gnu tests) (srfi srfi-1)) (operating-system (host-name "hurd") (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system (device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b")) (mount-point "/") (options "compress-force=zstd,degraded") (type "btrfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %btrfs-raid10-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 for d in vdb vdc vdd vde; do parted --script /dev/$d mklabel gpt \\ mkpart primary ext2 1M 2M \\ mkpart primary ext2 2M 100% \\ set 1 boot on \\ set 1 bios_grub on done # Create the RAID10 Btrfs array. mkfs.btrfs -d raid10 -m raid1c4 /dev/{vdb2,vdc2,vdd2,vde2} \\ --uuid 16ff18e2-eb41-4324-8df5-80d3b53c411b # Mount it, ready for installation. mount UUID=16ff18e2-eb41-4324-8df5-80d3b53c411b -o compress-force=zstd /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-btrfs-raid10-root-images (mlet %store-monad ((images (run-install %btrfs-raid10-root-os %btrfs-raid10-root-os-source #:script %btrfs-raid10-root-installation-script #:number-of-disks 4 #:target-size (* 1100 MiB)))) (return images))) (define %test-btrfs-raid10-root-os (system-test (name "btrfs-raid10-root-os") (description "Test basic functionality of an OS installed on top of a Btrfs RAID10 file system spanning 4 disks. 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 ((images %test-btrfs-raid10-root-images) (command (qemu-command* images))) (run-basic-test %btrfs-raid10-root-os command "btrfs-raid10-root-os"))))) (define %test-btrfs-raid10-root-os-degraded (system-test (name "btrfs-raid10-root-os-degraded") (description "Test basic functionality of an OS installed on top of a Btrfs RAID10 file system spanning 6 disks, degraded to 5 disks. 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 ;; Drop the first image; this boots because the root file system uses ;; the Btrfs "degraded" mount option. ((images %test-btrfs-raid10-root-images) (command (qemu-command* #~(cdr #$images)))) (run-basic-test %btrfs-raid10-root-os command "btrfs-raid10-root-os"))))) ;;; ;;; JFS root file system. ;;; (define-os-with-source (%jfs-root-os %jfs-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "jfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %jfs-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 2G \\ set 1 boot on \\ set 1 bios_grub on jfs_mkfs -L my-root -q /dev/vdb2 mount /dev/vdb2 /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-jfs-root-os (system-test (name "jfs-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 ((images (run-install %jfs-root-os %jfs-root-os-source #:script %jfs-root-installation-script)) (command (qemu-command* images))) (run-basic-test %jfs-root-os command "jfs-root-os"))))) ;;; ;;; F2FS root file system. ;;; (define-os-with-source (%f2fs-root-os %f2fs-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "f2fs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %f2fs-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 2G \\ set 1 boot on \\ set 1 bios_grub on mkfs.f2fs -l my-root -q /dev/vdb2 mount /dev/vdb2 /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-f2fs-root-os (system-test (name "f2fs-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 ((images (run-install %f2fs-root-os %f2fs-root-os-source #:script %f2fs-root-installation-script)) (command (qemu-command* images))) (run-basic-test %f2fs-root-os command "f2fs-root-os"))))) ;;; ;;; XFS root file system. ;;; (define-os-with-source (%xfs-root-os %xfs-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 (bootloader-configuration (bootloader grub-bootloader) (targets (list "/dev/vdb")))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") (type "xfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") (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 %xfs-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 2G \\ set 1 boot on \\ set 1 bios_grub on mkfs.xfs -L my-root -q /dev/vdb2 mount /dev/vdb2 /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") (define %test-xfs-root-os (system-test (name "xfs-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 ((images (run-install %xfs-root-os %xfs-root-os-source #:script %xfs-root-installation-script)) (command (qemu-command* images))) (run-basic-test %xfs-root-os command "xfs-root-os"))))) ;;; ;;; Installation through the graphical interface. ;;; (define %syslog-conf ;; Syslog configuration that dumps to /dev/console, so we can see the ;; installer's messages during the test. (computed-file "syslog.conf" #~(begin (copy-file #$%default-syslog.conf #$output) (chmod #$output #o644) (let ((port (open-file #$output "a"))) (display "\n*.info /dev/console\n" port) #t)))) (define (operating-system-with-console-syslog os) "Return OS with a syslog service that writes to /dev/console." (operating-system (inherit os) (services (modify-services (operating-system-user-services os) (syslog-service-type config => (syslog-configuration (inherit config) (config-file %syslog-conf))))))) (define %root-password "foo") (define* (gui-test-program marionette #:key (desktop? #f) (encrypted? #f) (uefi-support? #f) (system (%current-system))) #~(let () (define (screenshot file) (marionette-control (string-append "screendump " file) #$marionette)) (define-syntax-rule (marionette-eval* exp marionette) (or (marionette-eval exp marionette) (throw 'marionette-eval-failure 'exp))) (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) (marionette-eval* '(use-modules (gnu installer tests) (guix build utils)) #$marionette) ;; Arrange so that 'converse' prints debugging output to the console. (marionette-eval* '(let ((console (open-output-file "/dev/console"))) (setvbuf console 'none) (conversation-log-port console)) #$marionette) ;; Tell the installer to not wait for the Connman "online" status. (marionette-eval* '(call-with-output-file "/tmp/installer-assume-online" (const #t)) #$marionette) ;; Run 'guix system init' with '--no-grafts', to cope with the lack of ;; network access. (marionette-eval* '(call-with-output-file "/tmp/installer-system-init-options" (lambda (port) (write '("--no-grafts" "--no-substitutes") port))) #$marionette) (marionette-eval* '(define installer-socket (open-installer-socket)) #$marionette) (screenshot "installer-start.ppm") (marionette-eval* '(choose-locale+keyboard installer-socket) #$marionette) (screenshot "installer-locale.ppm") ;; Choose the host name that the "basic" test expects. (marionette-eval* '(enter-host-name+passwords installer-socket #:host-name "liberigilo" #:root-password #$%root-password #:users '(("alice" "pass1") ("bob" "pass2"))) #$marionette) (screenshot "installer-services.ppm") (marionette-eval* '(choose-services installer-socket #:choose-desktop-environment? (const #$desktop?) #:choose-network-service? (const #f)) #$marionette) (screenshot "installer-partitioning.ppm") (marionette-eval* '(choose-partitioning installer-socket #:encrypted? #$encrypted? #:passphrase #$%luks-passphrase #:uefi-support? #$uefi-support?) #$marionette) (screenshot "installer-run.ppm") (unless #$encrypted? ;; At this point, user partitions are formatted and the installer is ;; waiting for us to start the final step: generating the ;; configuration file, etc. Set a fixed UUID on the swap partition ;; that matches what 'installation-target-os-for-gui-tests' expects. (marionette-eval* '(invoke #$(file-append util-linux "/sbin/swaplabel") "-U" "11111111-2222-3333-4444-123456789abc" "/dev/vda2") #$marionette)) (marionette-eval* '(start-installation installer-socket) #$marionette) ;; XXX: The grub-install process uses efibootmgr to add an UEFI Guix ;; boot entry. The corresponding UEFI variable is stored in RAM, and ;; possibly saved persistently on QEMU reboot in a NvVars file, see: ;; https://lists.gnu.org/archive/html/qemu-discuss/2018-04/msg00045.html. ;; ;; As we are running QEMU with the no-reboot flag, this variable is ;; never saved persistently, QEMU fails to boot the installed system and ;; an UEFI shell is displayed instead. ;; ;; To make the installed UEFI system bootable, register Grub as the ;; default UEFI boot entry, in the same way as if grub-install was ;; invoked with the --removable option. (when #$uefi-support? (marionette-eval* '(begin (use-modules (ice-9 match)) (let ((targets (cond ((string-prefix? "x86_64" #$system) '("grubx64.efi" "BOOTX64.EFI")) ((string-prefix? "i686" #$system) '("grubia32.efi" "BOOTIA32.EFI")) (else #f)))) (match targets ((src dest) (rename-file "/mnt/boot/efi/EFI/Guix" "/mnt/boot/efi/EFI/BOOT") (rename-file (string-append "/mnt/boot/efi/EFI/BOOT/" src) (string-append "/mnt/boot/efi/EFI/BOOT/" dest))) (_ #f)))) #$marionette)) (marionette-eval* '(complete-installation installer-socket) #$marionette) (sync) #t)) (define %extra-packages ;; Packages needed when installing with an encrypted root. (list isc-dhcp lvm2-static cryptsetup-static e2fsck/static loadkeys-static grub-efi fatfsck/static dosfstools)) (define installation-os-for-gui-tests ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the ;; target OS, as well as syslog output redirected to the console so we can ;; see what the installer is up to. (marionette-operating-system (operating-system (inherit (operating-system-with-console-syslog (operating-system-add-packages installation-os %extra-packages))) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) (gnu installer tests) (guix combinators)))) (define* (installation-target-os-for-gui-tests #:key (encrypted? #f) (uefi-support? #f)) (operating-system (inherit %minimal-os-on-vda) (file-systems `(,(file-system (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) ,@(if uefi-support? (list (file-system (device (uuid "1234-ABCD" 'fat)) (mount-point "/boot/efi") (type "vfat"))) '()) ,@%base-file-systems)) (users (append (list (user-account (name "alice") (comment "Bob's sister") (group "users") (supplementary-groups '("wheel" "audio" "video"))) (user-account (name "bob") (comment "Alice's brother") (group "users") (supplementary-groups '("wheel" "audio" "video")))) %base-user-accounts)) ;; The installer does not create a swap device in guided mode with ;; encryption support. The installer produces a UUID for the partition; ;; this "UUID" is explicitly set in 'gui-test-program' to the value shown ;; below. (swap-devices (if encrypted? '() (list (swap-space (target (uuid "11111111-2222-3333-4444-123456789abc")))))) (services (cons* (service dhcp-client-service-type) (service ntp-service-type) (operating-system-user-services %minimal-os-on-vda))))) (define* (installation-target-desktop-os-for-gui-tests #:key (encrypted? #f)) (operating-system (inherit (installation-target-os-for-gui-tests #:encrypted? encrypted?)) (keyboard-layout (keyboard-layout "us" "altgr-intl")) ;; Make sure that all the packages and services that may be used by the ;; graphical installer are available. (packages (append (list openbox awesome i3-wm i3status dmenu st ratpoison xterm emacs emacs-exwm emacs-desktop-environment) %base-packages)) (services (append (list (service gnome-desktop-service-type) (service xfce-desktop-service-type) (service mate-desktop-service-type) (service enlightenment-desktop-service-type) (set-xorg-configuration (xorg-configuration (keyboard-layout keyboard-layout))) (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) (guix build utils) (guix combinators)))))) %desktop-services)))) (define* (guided-installation-test name #:key (desktop? #f) (encrypted? #f) (uefi-support? #f) target-os (install-size 'guess) (target-size (* 2200 MiB))) (system-test (name name) (description "Install an OS using the graphical installer and test it.") (value (mlet* %store-monad ((images (run-install target-os '(this is unused) #:script #f #:os installation-os-for-gui-tests #:uefi-support? uefi-support? #:install-size install-size #:target-size target-size #:installation-image-type 'uncompressed-iso9660 #:gui-test (lambda (marionette) (gui-test-program marionette #:desktop? desktop? #:encrypted? encrypted? #:uefi-support? uefi-support?)))) (command (qemu-command* images #:uefi-support? uefi-support? #:memory-size 512))) (run-basic-test target-os command name #:initialization (and encrypted? enter-luks-passphrase) #:root-password %root-password #:desktop? desktop?))))) (define %test-gui-installed-os (guided-installation-test "gui-installed-os" #:target-os (installation-target-os-for-gui-tests))) ;; Test the UEFI installation of Guix System using the graphical installer. (define %test-gui-uefi-installed-os (guided-installation-test "gui-uefi-installed-os" #:uefi-support? #t #:target-os (installation-target-os-for-gui-tests #:uefi-support? #t) #:target-size (* 3200 MiB))) (define %test-gui-installed-os-encrypted (guided-installation-test "gui-installed-os-encrypted" #:encrypted? #t #:target-os (installation-target-os-for-gui-tests #:encrypted? #t))) ;; Building a desktop image is very time and space consuming. Install all ;; desktop environments in a single test to reduce the overhead. (define %test-gui-installed-desktop-os-encrypted (guided-installation-test "gui-installed-desktop-os-encrypted" #:desktop? #t #:encrypted? #t #:target-os (installation-target-desktop-os-for-gui-tests #:encrypted? #t) ;; XXX: The disk-image size guess is too low. Use ;; a constant value until this is fixed. #:install-size (* 8000 MiB) #:target-size (* 9000 MiB))) ;;; install.scm ends here