move base-system and linux-initrd to guix-epistemia

author: Vineet Kumar <git@vineetk.net> 2026-05-19 12:37:56 -0400
committer: Vineet Kumar <git@vineetk.net> 2026-05-19 14:03:02 -0400
commit: 195a46b6b803150210cbe39fde33ee7593b49769 (patch)
tree: 77573a9d88955450b2fa252d8fbad235f5c8bfa9 /epistemia
parent: c1fb52d755c21289452f5b691829f7bf50942778 (diff)
2 files changed, 0 insertions, 301 deletions
diff --git a/epistemia/systems/base-system.scm b/epistemia/systems/base-system.scm
deleted file mode 100644
index 86abafd..0000000
--- a/epistemia/systems/base-system.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index c727428..0000000
--- a/epistemia/systems/linux-initrd.scm
+++ /dev/null
@@ -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?))
author	Vineet Kumar <git@vineetk.net>	2026-05-19 12:37:56 -0400
committer	Vineet Kumar <git@vineetk.net>	2026-05-19 14:03:02 -0400
commit	195a46b6b803150210cbe39fde33ee7593b49769 (patch)
tree	77573a9d88955450b2fa252d8fbad235f5c8bfa9 /epistemia
parent	c1fb52d755c21289452f5b691829f7bf50942778 (diff)

diff --git a/epistemia/systems/base-system.scm b/epistemia/systems/base-system.scm deleted file mode 100644 index 86abafd..0000000 --- a/epistemia/systems/base-system.scm +++ /dev/null
@@ -1,33 +0,0 @@
1	(define-module (epistemia systems base-system)
2	#:use-module (gnu)
3	#:use-module (gnu packages bash)
4	#:use-module (gnu packages ssh)
5	#:use-module (guix)
6	#:export (base-system))
7
8	(define base-system
9	(operating-system
10	(host-name "base")
11	(timezone "Canada/Eastern")
12	(locale "en_US.utf8")
13
14	;; should be set per-system
15	(kernel '())
16	(firmware '())
17
18	;; will be overrided per-system
19	(bootloader (bootloader-configuration
20	(bootloader grub-efi-bootloader)
21	(targets '("/boot/efi"))))
22
23	(file-systems %base-file-systems)
24
25	(packages %base-packages)
26
27	(services (modify-services %base-services
28	(guix-service-type config =>
29	(guix-configuration
30	(inherit config)
31	(authorized-keys
32	(append (list (local-file "../../demiurge.pub"))
33	%default-authorized-guix-keys))))))))


diff --git a/epistemia/systems/linux-initrd.scm b/epistemia/systems/linux-initrd.scm deleted file mode 100644 index c727428..0000000 --- a/epistemia/systems/linux-initrd.scm +++ /dev/null
@@ -1,268 +0,0 @@
1	;;; SPDX-License-Identifier: GPL-3.0-or-later
2	;; 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.
3	;; 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.
4	(define-module (epistemia systems linux-initrd)
5	#:use-module (guix gexp)
6	#:use-module (guix utils)
7	#:use-module ((guix store) #:select (%store-prefix))
8	#:use-module ((guix derivations) #:select (derivation->output-path))
9	#:use-module (guix modules)
10	#:use-module (gnu packages compression)
11	#:use-module (gnu packages disk)
12	#:use-module (gnu packages guile)
13	#:use-module (gnu packages linux)
14	#:use-module (gnu packages file-systems)
15	#:use-module (gnu system file-systems)
16	#:use-module (gnu system mapped-devices)
17	#:use-module (gnu system keyboard)
18	#:use-module (gnu system linux-initrd)
19	#:use-module (ice-9 match)
20	#:use-module (ice-9 regex)
21	#:use-module (ice-9 vlist)
22	#:use-module (srfi srfi-1)
23	#:use-module (srfi srfi-26)
24	#:export (epistemia-zfs-initrd))
25
26	(define (flat-linux-module-directory* linux extra-packages modules)
27	"Return a flat directory containing the Linux kernel modules listed in
28	MODULES."
29	(define imported-modules
30	(source-module-closure '((gnu build linux-modules)
31	(guix build utils))))
32
33	(define build-exp
34	(with-imported-modules imported-modules
35	(with-extensions (list guile-zlib guile-zstd)
36	#~(begin
37	(use-modules (gnu build linux-modules)
38	(guix build utils)
39	(rnrs io ports)
40	(srfi srfi-1)
41	(srfi srfi-26)
42	(ice-9 match))
43
44	(define module-dirs
45	(map (lambda (pkg) (string-append pkg "/lib/modules"))
46	(cons #$linux '#$extra-packages)))
47
48	(define builtin-modules
49	(match (find-files (string-append #$linux "/lib/modules")
50	(lambda (file stat)
51	(string=? (basename file) "modules.builtin")))
52	((file . _)
53	(call-with-input-file file
54	(lambda (port)
55	(map file-name->module-name
56	(string-tokenize (get-string-all port))))))
57	(_ '())))
58
59	(define modules-to-lookup
60	(lset-difference string=? '#$modules builtin-modules))
61
62	(define (lookup-in-dirs name)
63	(let loop ((dirs module-dirs))
64	(match dirs
65	((dir . rest)
66	(let ((candidates
67	(find-files dir
68	(lambda (file stat)
69	(let ((base (basename file)))
70	(or (string=? base (string-append name ".ko"))
71	(string=? base (string-append name ".ko.gz"))
72	(string=? base (string-append name ".ko.zst"))))))))
73	(match candidates
74	((first . _) first)
75	(() (loop rest)))))
76	(() #f))))
77
78	(define modules
79	(let ((found-modules (map lookup-in-dirs modules-to-lookup)))
80	(append (filter identity found-modules)
81	(recursive-module-dependencies
82	(filter identity found-modules)
83	#:lookup-module lookup-in-dirs))))
84
85	(define (maybe-uncompress file)
86	(cond
87	((string-contains file ".ko.gz")
88	(invoke #+(file-append gzip "/bin/gunzip") file))
89	((string-contains file ".ko.zst")
90	(invoke #+(file-append zstd "/bin/zstd") "-d" file))))
91
92	(mkdir #$output)
93	(for-each (lambda (module)
94	(when module
95	(let ((out-module
96	(string-append #$output "/"
97	(basename module))))
98	(format #t "copying '~a'...~%" module)
99	(copy-file module out-module)
100	(maybe-uncompress out-module))))
101	(delete-duplicates modules))
102
103	(write-module-name-database #$output)))))
104
105	(computed-file "linux-modules-combined" build-exp))
106
107	(define* (zfs-raw-initrd file-systems
108	#:key
109	(linux linux-libre)
110	(zfs-package zfs)
111	(linux-modules '())
112	(pre-mount #t)
113	(mapped-devices '())
114	(keyboard-layout #f)
115	(helper-packages '())
116	qemu-networking?
117	volatile-root?
118	(on-error 'debug)
119	(monkey-patch? #t)
120	#:allow-other-keys)
121
122	(define device-mapping-commands
123	(map (lambda (md)
124	(let* ((source (mapped-device-source md))
125	(targets (mapped-device-targets md))
126	(type (mapped-device-type md))
127	(open (mapped-device-kind-open type)))
128	(apply open source targets
129	(mapped-device-arguments md))))
130	mapped-devices))
131
132	(define file-system-scan-commands
133	(let ((file-system-types (map file-system-type file-systems)))
134	(if (member "btrfs" file-system-types)
135	#~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
136	"device" "scan"))
137	#~())))
138
139	(define zfs-import-commands
140	#~(begin
141	(format #t "Epistemia: Importing ZFS pools...~%")
142	(false-if-exception
143	(system* (string-append #$zfs-package "/sbin/zpool")
144	"import" "-a" "-N" "-f" "-d" "/dev"))
145	(format #t "Epistemia: Imported ZFS pools:~%")
146	(false-if-exception
147	(system* (string-append #$zfs-package "/sbin/zpool")
148	"status"))
149	(sleep 2)
150	#t))
151
152	(define kodir
153	(flat-linux-module-directory* linux
154	(list (gexp-input zfs-package "module"))
155	linux-modules))
156
157	(expression->initrd
158	(with-imported-modules (source-module-closure
159	'((gnu build linux-boot)
160	(guix build utils)
161	(guix build bournish)
162	(gnu system file-systems)
163	(gnu build file-systems)))
164	#~(begin
165	(use-modules (gnu build linux-boot)
166	(gnu system file-systems)
167	((guix build utils) #:hide (delete))
168	(guix build bournish)
169	(srfi srfi-1)
170	(srfi srfi-13)
171	(srfi srfi-26))
172
173	;; We must patch BOTH modules because linux-boot likely already
174	;; imported the function.
175	#$(if monkey-patch?
176	#~(let* ((fs-mod (resolve-module '(gnu build file-systems)))
177	(boot-mod (resolve-module '(gnu build linux-boot)))
178	(orig-canon (module-ref fs-mod 'canonicalize-device-spec))
179	(new-canon
180	(lambda (spec)
181	;; ZFS datasets in Guix config are either strings or file-system-labels.
182	;; If it's a label record, the first field is the label string.
183	(let ((device (cond
184	((string? spec) spec)
185	((and (struct? spec)
186	(string? (struct-ref spec 0)))
187	(struct-ref spec 0))
188	(else #f))))
189	(if (and device
190	(or (string-contains device "zroot/")
191	(string-contains device "zfs")))
192	(begin
193	(format #t "Epistemia: ZFS bypass for ~s~%" device)
194	device)
195	(orig-canon spec))))))
196
197	;; 1. Overwrite the definition source
198	(module-set! fs-mod 'canonicalize-device-spec new-canon)
199
200	;; 2. Overwrite the consumer's binding (Crucial for boot-system)
201	(module-set! boot-mod 'canonicalize-device-spec new-canon)
202
203	(format #t "Epistemia: ZFS Monkey Patch Applied.~%"))
204	#~#t)
205
206	(with-output-to-port (%make-void-port "w")
207	(lambda ()
208	(set-path-environment-variable "PATH" '("bin" "sbin")
209	'#$helper-packages)))
210
211	(parameterize ((current-warning-port (%make-void-port "w")))
212	(boot-system #:mounts
213	(map spec->file-system
214	'#$(map file-system->spec file-systems))
215	#:pre-mount (lambda ()
216	(and #$pre-mount
217	#$@device-mapping-commands
218	#$@file-system-scan-commands
219	#$zfs-import-commands))
220	#:linux-modules '#$linux-modules
221	#:linux-module-directory '#$kodir
222	#:keymap-file #+(and=> keyboard-layout
223	keyboard-layout->console-keymap)
224	#:qemu-guest-networking? #$qemu-networking?
225	#:volatile-root? '#$volatile-root?
226	#:on-error '#$on-error))))
227	#:name "zfs-initrd"))
228
229	(define* (epistemia-zfs-initrd file-systems
230	#:key
231	(linux linux-libre)
232	(zfs-package zfs)
233	(linux-modules '())
234	(mapped-devices '())
235	(keyboard-layout #f)
236	qemu-networking?
237	volatile-root?
238	(extra-modules '())
239	(on-error 'debug)
240	(monkey-patch? #t)
241	#:allow-other-keys)
242
243	(define linux-modules*
244	(cons "zfs"
245	`(,@linux-modules
246	,@(file-system-modules file-systems)
247	,@(if volatile-root? '("overlay") '())
248	,@extra-modules)))
249
250	(define helper-packages
251	(cons zfs-package
252	(append (file-system-packages file-systems
253	#:volatile-root? volatile-root?)
254	(if keyboard-layout
255	(list loadkeys-static)
256	'()))))
257
258	(zfs-raw-initrd file-systems
259	#:linux linux
260	#:zfs-package zfs-package
261	#:linux-modules linux-modules*
262	#:mapped-devices mapped-devices
263	#:helper-packages helper-packages
264	#:keyboard-layout keyboard-layout
265	#:qemu-networking? qemu-networking?
266	#:volatile-root? volatile-root?
267	#:on-error on-error
268	#:monkey-patch? monkey-patch?))