commit 195a46b6b803150210cbe39fde33ee7593b49769 parent c1fb52d755c21289452f5b691829f7bf50942778 Author: Vineet Kumar <git@vineetk.net> Date: Tue, 19 May 2026 12:37:56 -0400 move base-system and linux-initrd to guix-epistemia Diffstat:
| D | epistemia/systems/base-system.scm | | | 33 | --------------------------------- |
| D | epistemia/systems/linux-initrd.scm | | | 268 | ------------------------------------------------------------------------------- |
2 files changed, 0 insertions(+), 301 deletions(-)
diff --git a/epistemia/systems/base-system.scm b/epistemia/systems/base-system.scm @@ -1,33 +0,0 @@ -(define-module (epistemia systems base-system) - #:use-module (gnu) - #:use-module (gnu packages bash) - #:use-module (gnu packages ssh) - #:use-module (guix) - #:export (base-system)) - -(define base-system - (operating-system - (host-name "base") - (timezone "Canada/Eastern") - (locale "en_US.utf8") - - ;; should be set per-system - (kernel '()) - (firmware '()) - - ;; will be overrided per-system - (bootloader (bootloader-configuration - (bootloader grub-efi-bootloader) - (targets '("/boot/efi")))) - - (file-systems %base-file-systems) - - (packages %base-packages) - - (services (modify-services %base-services - (guix-service-type config => - (guix-configuration - (inherit config) - (authorized-keys - (append (list (local-file "../../demiurge.pub")) - %default-authorized-guix-keys)))))))) diff --git a/epistemia/systems/linux-initrd.scm b/epistemia/systems/linux-initrd.scm @@ -1,268 +0,0 @@ -;;; SPDX-License-Identifier: GPL-3.0-or-later -;; AI disclosure: LLM slop, but it works. This was made before I got more familiar with Guile Scheme and took many retries to get working. -;; TODO: rewrite this later by deleting this and rewriting by reading the main initrd and my previous pre-guix initrd script. could maybe be deduplicated a lot via inherits. -(define-module (epistemia systems linux-initrd) - #:use-module (guix gexp) - #:use-module (guix utils) - #:use-module ((guix store) #:select (%store-prefix)) - #:use-module ((guix derivations) #:select (derivation->output-path)) - #:use-module (guix modules) - #:use-module (gnu packages compression) - #:use-module (gnu packages disk) - #:use-module (gnu packages guile) - #:use-module (gnu packages linux) - #:use-module (gnu packages file-systems) - #:use-module (gnu system file-systems) - #:use-module (gnu system mapped-devices) - #:use-module (gnu system keyboard) - #:use-module (gnu system linux-initrd) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:export (epistemia-zfs-initrd)) - -(define (flat-linux-module-directory* linux extra-packages modules) - "Return a flat directory containing the Linux kernel modules listed in -MODULES." - (define imported-modules - (source-module-closure '((gnu build linux-modules) - (guix build utils)))) - - (define build-exp - (with-imported-modules imported-modules - (with-extensions (list guile-zlib guile-zstd) - #~(begin - (use-modules (gnu build linux-modules) - (guix build utils) - (rnrs io ports) - (srfi srfi-1) - (srfi srfi-26) - (ice-9 match)) - - (define module-dirs - (map (lambda (pkg) (string-append pkg "/lib/modules")) - (cons #$linux '#$extra-packages))) - - (define builtin-modules - (match (find-files (string-append #$linux "/lib/modules") - (lambda (file stat) - (string=? (basename file) "modules.builtin"))) - ((file . _) - (call-with-input-file file - (lambda (port) - (map file-name->module-name - (string-tokenize (get-string-all port)))))) - (_ '()))) - - (define modules-to-lookup - (lset-difference string=? '#$modules builtin-modules)) - - (define (lookup-in-dirs name) - (let loop ((dirs module-dirs)) - (match dirs - ((dir . rest) - (let ((candidates - (find-files dir - (lambda (file stat) - (let ((base (basename file))) - (or (string=? base (string-append name ".ko")) - (string=? base (string-append name ".ko.gz")) - (string=? base (string-append name ".ko.zst")))))))) - (match candidates - ((first . _) first) - (() (loop rest))))) - (() #f)))) - - (define modules - (let ((found-modules (map lookup-in-dirs modules-to-lookup))) - (append (filter identity found-modules) - (recursive-module-dependencies - (filter identity found-modules) - #:lookup-module lookup-in-dirs)))) - - (define (maybe-uncompress file) - (cond - ((string-contains file ".ko.gz") - (invoke #+(file-append gzip "/bin/gunzip") file)) - ((string-contains file ".ko.zst") - (invoke #+(file-append zstd "/bin/zstd") "-d" file)))) - - (mkdir #$output) - (for-each (lambda (module) - (when module - (let ((out-module - (string-append #$output "/" - (basename module)))) - (format #t "copying '~a'...~%" module) - (copy-file module out-module) - (maybe-uncompress out-module)))) - (delete-duplicates modules)) - - (write-module-name-database #$output))))) - - (computed-file "linux-modules-combined" build-exp)) - -(define* (zfs-raw-initrd file-systems - #:key - (linux linux-libre) - (zfs-package zfs) - (linux-modules '()) - (pre-mount #t) - (mapped-devices '()) - (keyboard-layout #f) - (helper-packages '()) - qemu-networking? - volatile-root? - (on-error 'debug) - (monkey-patch? #t) - #:allow-other-keys) - - (define device-mapping-commands - (map (lambda (md) - (let* ((source (mapped-device-source md)) - (targets (mapped-device-targets md)) - (type (mapped-device-type md)) - (open (mapped-device-kind-open type))) - (apply open source targets - (mapped-device-arguments md)))) - mapped-devices)) - - (define file-system-scan-commands - (let ((file-system-types (map file-system-type file-systems))) - (if (member "btrfs" file-system-types) - #~((system* (string-append #$btrfs-progs/static "/bin/btrfs") - "device" "scan")) - #~()))) - - (define zfs-import-commands - #~(begin - (format #t "Epistemia: Importing ZFS pools...~%") - (false-if-exception - (system* (string-append #$zfs-package "/sbin/zpool") - "import" "-a" "-N" "-f" "-d" "/dev")) - (format #t "Epistemia: Imported ZFS pools:~%") - (false-if-exception - (system* (string-append #$zfs-package "/sbin/zpool") - "status")) - (sleep 2) - #t)) - - (define kodir - (flat-linux-module-directory* linux - (list (gexp-input zfs-package "module")) - linux-modules)) - - (expression->initrd - (with-imported-modules (source-module-closure - '((gnu build linux-boot) - (guix build utils) - (guix build bournish) - (gnu system file-systems) - (gnu build file-systems))) - #~(begin - (use-modules (gnu build linux-boot) - (gnu system file-systems) - ((guix build utils) #:hide (delete)) - (guix build bournish) - (srfi srfi-1) - (srfi srfi-13) - (srfi srfi-26)) - - ;; We must patch BOTH modules because linux-boot likely already - ;; imported the function. - #$(if monkey-patch? - #~(let* ((fs-mod (resolve-module '(gnu build file-systems))) - (boot-mod (resolve-module '(gnu build linux-boot))) - (orig-canon (module-ref fs-mod 'canonicalize-device-spec)) - (new-canon - (lambda (spec) - ;; ZFS datasets in Guix config are either strings or file-system-labels. - ;; If it's a label record, the first field is the label string. - (let ((device (cond - ((string? spec) spec) - ((and (struct? spec) - (string? (struct-ref spec 0))) - (struct-ref spec 0)) - (else #f)))) - (if (and device - (or (string-contains device "zroot/") - (string-contains device "zfs"))) - (begin - (format #t "Epistemia: ZFS bypass for ~s~%" device) - device) - (orig-canon spec)))))) - - ;; 1. Overwrite the definition source - (module-set! fs-mod 'canonicalize-device-spec new-canon) - - ;; 2. Overwrite the consumer's binding (Crucial for boot-system) - (module-set! boot-mod 'canonicalize-device-spec new-canon) - - (format #t "Epistemia: ZFS Monkey Patch Applied.~%")) - #~#t) - - (with-output-to-port (%make-void-port "w") - (lambda () - (set-path-environment-variable "PATH" '("bin" "sbin") - '#$helper-packages))) - - (parameterize ((current-warning-port (%make-void-port "w"))) - (boot-system #:mounts - (map spec->file-system - '#$(map file-system->spec file-systems)) - #:pre-mount (lambda () - (and #$pre-mount - #$@device-mapping-commands - #$@file-system-scan-commands - #$zfs-import-commands)) - #:linux-modules '#$linux-modules - #:linux-module-directory '#$kodir - #:keymap-file #+(and=> keyboard-layout - keyboard-layout->console-keymap) - #:qemu-guest-networking? #$qemu-networking? - #:volatile-root? '#$volatile-root? - #:on-error '#$on-error)))) - #:name "zfs-initrd")) - -(define* (epistemia-zfs-initrd file-systems - #:key - (linux linux-libre) - (zfs-package zfs) - (linux-modules '()) - (mapped-devices '()) - (keyboard-layout #f) - qemu-networking? - volatile-root? - (extra-modules '()) - (on-error 'debug) - (monkey-patch? #t) - #:allow-other-keys) - - (define linux-modules* - (cons "zfs" - `(,@linux-modules - ,@(file-system-modules file-systems) - ,@(if volatile-root? '("overlay") '()) - ,@extra-modules))) - - (define helper-packages - (cons zfs-package - (append (file-system-packages file-systems - #:volatile-root? volatile-root?) - (if keyboard-layout - (list loadkeys-static) - '())))) - - (zfs-raw-initrd file-systems - #:linux linux - #:zfs-package zfs-package - #:linux-modules linux-modules* - #:mapped-devices mapped-devices - #:helper-packages helper-packages - #:keyboard-layout keyboard-layout - #:qemu-networking? qemu-networking? - #:volatile-root? volatile-root? - #:on-error on-error - #:monkey-patch? monkey-patch?))