From cee190286b47d39d7bb056aab296ebbd1f1fe833 Mon Sep 17 00:00:00 2001
From: Rutherther <rutherther@ditigal.xyz>
Date: Sat, 31 Jan 2026 13:58:42 +0100
Subject: [PATCH] feat: add test for LVM root

---
 modules/ruther/tests/lvm.scm | 113 +++++++++
 modules/ruthless/image.scm   | 448 +++++++++++++++++++++++++++++++++++
 2 files changed, 561 insertions(+)
 create mode 100644 modules/ruther/tests/lvm.scm
 create mode 100644 modules/ruthless/image.scm

diff --git a/modules/ruther/tests/lvm.scm b/modules/ruther/tests/lvm.scm
new file mode 100644
index 0000000000000000000000000000000000000000..91f0a8e4b3e0b434a2024c914011b0f99bbbcf6b
--- /dev/null
+++ b/modules/ruther/tests/lvm.scm
@@ -0,0 +1,113 @@
+;;; Test for Guix System with root on LVM
+;;; Copyright © 2025
+
+(define-module (ruther tests lvm)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu build marionette)
+  #:use-module (gnu packages firmware)
+  #:use-module (gnu packages virtualization)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system mapped-devices)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (gnu tests base)
+  #:use-module (guix gexp)
+  #:use-module (ruthless image)
+  #:export (%test-root-lvm))
+
+;;;
+;;; OS definition with root on LVM
+;;;
+
+(define %lvm-root-os
+  ;; Operating system with root filesystem on LVM.
+  ;; Uses vg0/root as the root logical volume.
+  (operating-system
+    (host-name "lvmroot")
+    (timezone "Europe/Berlin")
+    (locale "en_US.UTF-8")
+
+    (bootloader (bootloader-configuration
+                 (bootloader grub-efi-removable-bootloader)
+                 (targets '("/boot/efi"))
+                 (terminal-outputs '(console))))
+
+    (kernel-arguments '("console=ttyS0"))
+
+    (mapped-devices
+     (list (mapped-device
+            (source "vg0")
+            (targets '("vg0-root"))
+            (type lvm-device-mapping))))
+
+    (file-systems
+     (cons* (file-system
+              (device "/dev/mapper/vg0-root")
+              (mount-point "/")
+              (type "ext4")
+              (dependencies mapped-devices))
+            (file-system
+              (device (file-system-label "ESP"))
+              (mount-point "/boot/efi")
+              (type "vfat"))
+            %base-file-systems))
+
+    (users (cons (user-account
+                  (name "alice")
+                  (group "users")
+                  (supplementary-groups '("wheel")))
+                 %base-user-accounts))
+
+    (services %base-services)))
+
+;;;
+;;; Test execution
+;;;
+
+(define (run-lvm-root-test)
+  "Run the basic test suite on an OS with root on LVM."
+  (define os
+    (marionette-operating-system
+     %lvm-root-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  ;; Use the generic disk image builder with LVM initializer
+  (define image
+    (build-disk-image os
+                      #:disk-initializer lvm-disk-initializer
+                      #:disk-size (* 2048 1024 1024)  ; 2 GiB
+                      #:uefi? #t
+                      #:name "lvm-root-image"))
+
+  (define vm-command
+    #~(list (string-append #$qemu-minimal "/bin/"
+                           #$(qemu-command))
+            "-m" "512"
+            "-bios" #$(file-append ovmf-x86-64 "/share/firmware/ovmf_x64.bin")
+            "-drive"
+            (string-append "file=" #$image
+                           ",format=qcow2,if=virtio")
+            "-snapshot"  ; Use snapshot mode since image is in read-only store
+            "-no-reboot"
+            #$@(if (file-exists? "/dev/kvm")
+                   '("-enable-kvm")
+                   '())
+            "-nographic"))
+
+  (run-basic-test os vm-command "lvm-root"))
+
+;;;
+;;; System test definition
+;;;
+
+(define %test-root-lvm
+  (system-test
+   (name "lvm-root")
+   (description "Test basic functionality of a Guix System with root on LVM.")
+   (value (run-lvm-root-test))))
diff --git a/modules/ruthless/image.scm b/modules/ruthless/image.scm
new file mode 100644
index 0000000000000000000000000000000000000000..e1d49156931cb26610a90b35fa9dde77ee83d58c
--- /dev/null
+++ b/modules/ruthless/image.scm
@@ -0,0 +1,448 @@
+;;; Generic disk image builder for ruthless-guix
+;;; Copyright © 2025
+;;;
+;;; This module provides a generic, reusable wrapper for building disk images
+;;; that can work with different partition schemes (LVM, RAID, plain, etc.).
+
+(define-module (ruthless image)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu build marionette)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bootloaders)
+  #:use-module (gnu packages cryptsetup)
+  #:use-module (gnu packages disk)
+  #:use-module (gnu packages file-systems)
+  #:use-module (gnu packages firmware)
+  #:use-module (gnu packages gnupg)
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages virtualization)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (gnu tests base)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (guix scripts system reconfigure)
+  #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:export (<disk-initializer>
+            disk-initializer
+            disk-initializer?
+            disk-initializer-name
+            disk-initializer-packages
+            disk-initializer-setup-proc
+            disk-initializer-cleanup-proc
+
+            build-disk-image
+
+            make-lvm-disk-initializer
+            lvm-disk-initializer
+            make-simple-gpt-disk-initializer
+            simple-gpt-disk-initializer))
+
+;;;
+;;; Disk initializer record
+;;;
+
+(define-record-type* <disk-initializer> disk-initializer
+  make-disk-initializer
+  disk-initializer?
+  (name          disk-initializer-name)           ; symbol
+  (packages      disk-initializer-packages        ; list of packages
+                 (default '()))
+  (setup-proc    disk-initializer-setup-proc)     ; gexp: sets up disk, mounts to /mnt
+  (cleanup-proc  disk-initializer-cleanup-proc))  ; gexp: unmounts, deactivates
+
+;;;
+;;; Helper utilities
+;;;
+
+;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
+(define gcrypt-sqlite3&co
+  (append-map
+   (lambda (package)
+     (cons package
+           (match (package-transitive-propagated-inputs package)
+             (((labels packages) ...)
+              packages))))
+   (list guile-gcrypt guile-sqlite3)))
+
+(define neither-config-nor-git?
+  ;; Select (guix …) and (gnu …) modules, except (guix config) and (guix git).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix 'git) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (rest #f)))
+
+(define-syntax-rule (with-imported-modules* gexp* ...)
+  "Import necessary modules for image building operations."
+  (with-extensions gcrypt-sqlite3&co
+    (with-imported-modules `(,@(source-module-closure
+                                '((gnu build image)
+                                  (gnu build bootloader)
+                                  (gnu build hurd-boot)
+                                  (gnu build linux-boot)
+                                  (guix store database))
+                                #:select? neither-config-nor-git?)
+                             ((guix config) => ,(make-config.scm)))
+      #~(begin
+          (use-modules (gnu build image)
+                       (gnu build bootloader)
+                       (gnu build hurd-boot)
+                       (gnu build linux-boot)
+                       (guix store database)
+                       (guix build utils))
+          gexp* ...))))
+
+;;;
+;;; Main disk image builder
+;;;
+
+(define* (build-disk-image os
+                           #:key
+                           disk-initializer
+                           (disk-size (* 2048 1024 1024))  ; 2 GiB
+                           (memory-size 1024)
+                           (uefi? #t)
+                           (image-format 'qcow2)
+                           (name "disk-image"))
+  "Return a derivation that builds a disk image with OS installed.
+
+DISK-INITIALIZER is a <disk-initializer> record that defines:
+  - Packages needed for disk setup
+  - How to partition and format the disk
+  - How to mount filesystems to /mnt
+  - How to cleanup/unmount after initialization
+
+The procedure handles:
+  - Creating a builder VM with necessary packages
+  - Creating the target disk
+  - Calling the disk initializer's setup procedure
+  - Running initialize-root-partition on the mounted filesystem
+  - Installing the bootloader
+  - Calling the cleanup procedure
+  - Converting to the requested image format"
+
+  (define builder-os
+    ;; The helper OS that prepares the disk image.
+    (marionette-operating-system
+     (operating-system
+       (inherit %simple-os)
+       (packages
+        (append (disk-initializer-packages disk-initializer)
+                (list parted e2fsprogs dosfstools)
+                (operating-system-packages %simple-os))))
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define builder-vm
+    (virtual-machine
+     (operating-system builder-os)
+     (memory-size memory-size)
+     (disk-image-size (* 1024 1024 1024))))  ; 1 GiB for builder
+
+  (define bootcfg
+    (operating-system-bootcfg os))
+
+  (define bootloader-config
+    (operating-system-bootloader os))
+
+  (define bootloader
+    (bootloader-configuration-bootloader bootloader-config))
+
+  (define graph "system-graph")
+
+  (define schema
+    (local-file (search-path %load-path "guix/store/schema.sql")))
+
+  ;; Computed file that contains the references graph for the OS closure.
+  ;; This is needed because program-file doesn't support #:references-graphs.
+  (define references-graph
+    (computed-file
+     "references-graph"
+     #~(copy-file #$graph #$output)
+     #:options `(#:references-graphs ((,graph ,os)))))
+
+  ;; Program that initializes the root partition.
+  ;; This will be loaded inside the VM via primitive-load.
+  ;; Note: bootloader installation is handled separately after this step.
+  (define initialize-root-program
+    (program-file
+     "initialize-root.scm"
+     (with-imported-modules*
+      (parameterize ((sql-schema #$schema))
+        (initialize-root-partition
+         "/mnt"
+         #:references-graphs (list #$references-graph)
+         #:copy-closures? #t
+         #:register-closures? #t
+         #:deduplicate? #f
+         #:system-directory #$os
+         #:bootcfg #$bootcfg
+         #:bootcfg-location #$(bootloader-configuration-file bootloader)
+         #:bootloader-package #$(bootloader-package bootloader)
+         ;; Bootloader installer is called separately via install-bootloader
+         #:bootloader-installer #f)))))
+
+  (define setup-proc (disk-initializer-setup-proc disk-initializer))
+  (define cleanup-proc (disk-initializer-cleanup-proc disk-initializer))
+
+  ;; Main build procedure
+  (define build
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (gnu build marionette)))
+      #~(begin
+          (use-modules (guix build utils)
+                       (gnu build marionette)
+                       (ice-9 format))
+
+          (define target-disk
+            (string-append #$output ".raw"))
+
+          ;; Create the target disk image
+          (invoke #$(file-append qemu-minimal "/bin/qemu-img")
+                  "create" "-f" "qcow2" target-disk
+                  (number->string #$disk-size))
+
+          ;; Boot the builder VM with UEFI if requested
+          (let ((marionette
+                 (make-marionette
+                  (list #$builder-vm
+                        #$@(if uefi?
+                               #~("-bios" #$(file-append ovmf-x86-64
+                                                         "/share/firmware/ovmf_x64.bin"))
+                               #~())
+                        "-drive"
+                        (format #f "file=~a,if=virtio,cache=writeback,werror=report"
+                                target-disk)))))
+
+            ;; Wait for the system to be ready
+            (unless (marionette-eval
+                     '(begin
+                        (use-modules (gnu services herd))
+                        (start-service 'term-tty1)
+                        #t)
+                     marionette)
+              (error "Failed to start term-tty1 service in VM"))
+
+            ;; Step 1: Run disk setup (partition, format, mount to /mnt)
+            (display "Setting up disk...\n")
+            (unless (marionette-eval
+                     '(begin
+                        #$setup-proc
+                        #t)
+                     marionette)
+              (error "Could not set up disks."))
+
+            ;; Step 2: Initialize root partition (copy store, create structure, etc.)
+            (display "Initializing root filesystem...\n")
+            (unless (marionette-eval
+                     '(begin
+                        (primitive-load #$initialize-root-program)
+                        #t)
+                     marionette)
+              (error "Failed to initialize root partition in VM"))
+
+            ;; Step 3: Install bootloader
+            (display "Installing bootloader...\n")
+            (unless (#$(install-bootloader
+                        (lambda (exp)
+                          #~(lambda (marionette)
+                              (marionette-eval '(begin #$exp #t) marionette)))
+                        bootloader-config
+                        bootcfg
+                        #:target "/mnt")
+                     marionette)
+              (error "Failed to install bootloader"))
+
+            ;; Step 4: Cleanup (unmount, deactivate LVM, etc.)
+            (display "Cleaning up...\n")
+            (unless (marionette-eval
+                     '(begin
+                        #$cleanup-proc
+                        #t)
+                     marionette)
+              (error "Cleanup failed"))
+
+            ;; Shutdown builder VM
+            (display "Shutting down builder VM...\n")
+            (marionette-eval
+             '(system* "/run/current-system/profile/sbin/halt")
+             marionette)
+
+            ;; Wait for VM to terminate
+            (false-if-exception
+             (let loop ()
+               (let ((status (waitpid (marionette-pid marionette) WNOHANG)))
+                 (when (zero? (car status))
+                   (sleep 1)
+                   (loop))))))
+
+          ;; Convert to final format or rename
+          #$(match image-format
+              ('qcow2
+               #~(rename-file target-disk #$output))
+              ('raw
+               #~(begin
+                   (invoke #$(file-append qemu-minimal "/bin/qemu-img")
+                           "convert" "-f" "qcow2" "-O" "raw"
+                           target-disk #$output)
+                   (delete-file target-disk)))))))
+
+  (computed-file (string-append name "." (symbol->string image-format))
+                 build))
+
+;;;
+;;; Pre-built disk initializers
+;;;
+
+(define* (make-lvm-disk-initializer #:key
+                                    (volume-group "vg0")
+                                    (root-volume "root")
+                                    (esp-size "259MiB")
+                                    (esp-label "ESP")
+                                    (root-label "root"))
+  "Create a disk-initializer for LVM root with UEFI boot.
+
+The partition layout is:
+  - 1-3 MiB: BIOS boot partition (for legacy GRUB)
+  - 3-ESP-SIZE: EFI System Partition
+  - ESP-SIZE-100%: LVM physical volume containing VOLUME-GROUP/ROOT-VOLUME"
+  (disk-initializer
+   (name 'lvm-uefi)
+   (packages (list lvm2))
+   (setup-proc
+    #~(begin
+        (use-modules (guix build utils))
+
+        ;; Partition: GPT with BIOS boot, ESP, and LVM PV
+        (unless (zero?
+                 (system* #$(file-append parted "/sbin/parted")
+                          "-s" "/dev/vdb"
+                          "mklabel" "gpt"
+                          "mkpart" "bios_grub" "1MiB" "3MiB"
+                          "set" "1" "bios_grub" "on"
+                          "mkpart" "ESP" "fat32" "3MiB" #$esp-size
+                          "set" "2" "esp" "on"
+                          "mkpart" "lvm" #$esp-size "100%"
+                          "set" "3" "lvm" "on"))
+          (error "Failed to partition disk"))
+
+        ;; Create ESP filesystem
+        (unless (zero?
+                 (system* #$(file-append dosfstools "/sbin/mkfs.fat")
+                          "-F" "32" "-n" #$esp-label "/dev/vdb2"))
+          (error "Failed to create ESP filesystem"))
+
+        ;; Setup LVM
+        (unless (zero?
+                 (system* #$(file-append lvm2 "/sbin/pvcreate") "-ff" "-y" "/dev/vdb3"))
+          (error "Failed to create LVM physical volume"))
+        (unless (zero?
+                 (system* #$(file-append lvm2 "/sbin/vgcreate") #$volume-group "/dev/vdb3"))
+          (error "Failed to create LVM volume group"))
+        (unless (zero?
+                 (system* #$(file-append lvm2 "/sbin/lvcreate")
+                          "-l" "100%FREE" "-n" #$root-volume #$volume-group))
+          (error "Failed to create LVM root volume"))
+
+        ;; Format root
+        (unless (zero?
+                 (system* #$(file-append e2fsprogs "/sbin/mkfs.ext4")
+                          "-L" #$root-label
+                          #$(string-append "/dev/mapper/" volume-group "-" root-volume)))
+          (error "Failed to format root filesystem"))
+
+        ;; Mount filesystems
+        (mkdir-p "/mnt")
+        (unless (zero?
+                 (system* "mount"
+                          #$(string-append "/dev/mapper/" volume-group "-" root-volume)
+                          "/mnt"))
+          (error "Failed to mount root filesystem"))
+        (mkdir-p "/mnt/boot/efi")
+        (unless (zero? (system* "mount" "/dev/vdb2" "/mnt/boot/efi"))
+          (error "Failed to mount ESP"))))
+
+   (cleanup-proc
+    #~(begin
+        (sync)
+        (unless (zero? (system* "umount" "/mnt/boot/efi"))
+          (error "Failed to unmount ESP"))
+        (unless (zero? (system* "umount" "/mnt"))
+          (error "Failed to unmount root"))
+        (unless (zero? (system* #$(file-append lvm2 "/sbin/vgchange") "-an" #$volume-group))
+          (error "Failed to deactivate LVM volume group"))))))
+
+(define lvm-disk-initializer
+  (make-lvm-disk-initializer))
+
+(define* (make-simple-gpt-disk-initializer #:key
+                                           (esp-size "259MiB")
+                                           (esp-label "ESP")
+                                           (root-label "root"))
+  "Create a disk-initializer for simple GPT with UEFI boot (no LVM).
+
+The partition layout is:
+  - 1-3 MiB: BIOS boot partition (for legacy GRUB)
+  - 3-ESP-SIZE: EFI System Partition
+  - ESP-SIZE-100%: Root partition (ext4)"
+  (disk-initializer
+   (name 'simple-gpt-uefi)
+   (packages '())
+   (setup-proc
+    #~(begin
+        (use-modules (guix build utils))
+
+        ;; Partition: GPT with BIOS boot, ESP, and root
+        (unless (zero?
+                 (system* #$(file-append parted "/sbin/parted")
+                          "-s" "/dev/vdb"
+                          "mklabel" "gpt"
+                          "mkpart" "bios_grub" "1MiB" "3MiB"
+                          "set" "1" "bios_grub" "on"
+                          "mkpart" "ESP" "fat32" "3MiB" #$esp-size
+                          "set" "2" "esp" "on"
+                          "mkpart" "root" "ext4" #$esp-size "100%"))
+          (error "Failed to partition disk"))
+
+        ;; Create filesystems
+        (unless (zero?
+                 (system* #$(file-append dosfstools "/sbin/mkfs.fat")
+                          "-F" "32" "-n" #$esp-label "/dev/vdb2"))
+          (error "Failed to create ESP filesystem"))
+        (unless (zero?
+                 (system* #$(file-append e2fsprogs "/sbin/mkfs.ext4")
+                          "-L" #$root-label "/dev/vdb3"))
+          (error "Failed to format root filesystem"))
+
+        ;; Mount filesystems
+        (mkdir-p "/mnt")
+        (unless (zero? (system* "mount" "/dev/vdb3" "/mnt"))
+          (error "Failed to mount root filesystem"))
+        (mkdir-p "/mnt/boot/efi")
+        (unless (zero? (system* "mount" "/dev/vdb2" "/mnt/boot/efi"))
+          (error "Failed to mount ESP"))))
+
+   (cleanup-proc
+    #~(begin
+        (sync)
+        (unless (zero? (system* "umount" "/mnt/boot/efi"))
+          (error "Failed to unmount ESP"))
+        (unless (zero? (system* "umount" "/mnt"))
+          (error "Failed to unmount root"))))))
+
+(define simple-gpt-disk-initializer
+  (make-simple-gpt-disk-initializer))