seasharp/Rosenthal
1
0
Fork 0
mirror of https://codeberg.org/hako/Rosenthal.git synced 2025-09-18 12:44:37 +00:00
Code Issues Packages Projects Releases Wiki Activity
a71e15a31f
Rosenthal/modules/rosenthal/packages/patches/guix-wip-zfs-boot-support.patch
Hilton Chain a71e15a31f
rosenthal: guix/dolly: Apply ZFS patches. 
* modules/rosenthal/packages/package-management.scm (guix/hako): Rename to...
(guix/dolly): ...this and apply patches necessary for root on ZFS support.
2025-09-13 18:00:32 +08:00

174 lines
7.5 KiB
Diff
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

From 06b0653460f4d6b104a2d1a22032978f1423ca4e Mon Sep 17 00:00:00 2001
Message-ID: <06b0653460f4d6b104a2d1a22032978f1423ca4e.1757757101.git.hako@ultrarare.space>
From: Hilton Chain <hako@ultrarare.space>
Date: Sun, 7 Sep 2025 13:52:57 +0800
Subject: [PATCH] WIP: ZFS boot support.
Change-Id: I6579a36d66fcd0a487fe262c9a7c36e51532cb70
---
gnu/build/file-systems.scm | 21 ++++++++++++++-------
gnu/build/linux-boot.scm | 1 +
gnu/system/file-systems.scm | 26 ++++++++++++++++++--------
gnu/system/linux-initrd.scm | 25 ++++++++++++++++++++-----
guix/scripts/system.scm | 3 ++-
5 files changed, 55 insertions(+), 21 deletions(-)
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index c506a4911ff..05d0cb819ae 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1173,13 +1173,20 @@ (define (canonicalize-device-spec spec)
(match spec
((? string?)
- (if (or (string-contains spec ":/") ;nfs
- (and (>= (string-length spec) 2)
- (equal? (string-take spec 2) "//")) ;cifs
- (string=? spec "none"))
- spec ; do not resolve NFS / CIFS / tmpfs devices
- ;; Nothing to do, but wait until SPEC shows up.
- (resolve identity spec identity)))
+ (cond
+ ((or (string-contains spec ":/") ;nfs
+ (and (>= (string-length spec) 2)
+ (equal? (string-take spec 2) "//")) ;cifs
+ (string=? spec "none"))
+ ;; Do not resolve NFS / CIFS / tmpfs devices.
+ spec)
+ ((and (>= (string-length spec) 4)
+ (string=? (string-take spec 4) "zfs:"))
+ ;; "zfs:zpool/dataset" => "zpool/dataset"
+ (string-drop spec 4))
+ (else
+ ;; Nothing to do, but wait until SPEC shows up.
+ (resolve identity spec identity))))
((? file-system-label?)
;; Resolve the label.
(resolve find-partition-by-label
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 548e28a1c97..2b577483832 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -523,6 +523,7 @@ (define* (boot-system #:key
;; So check for all four.
(cond ((string-prefix? "/" device-string) device-string)
((string-contains device-string ":/") device-string) ; nfs-root
+ ((string-prefix? "zfs:" device-string) device-string)
((uuid device-string) => identity)
(else (file-system-label device-string))))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 4ea8237c70d..d29ecb14fba 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -627,18 +627,21 @@ (define (file-system-mount-point-predicate mount-point)
;;;
-;;; Btrfs specific helpers.
+;;; Btrfs specific helpers. TODO: Refactor
;;;
(define (btrfs-subvolume? fs)
"Predicate to check if FS, a file-system object, is a Btrfs subvolume."
- (and-let* ((btrfs-file-system? (string= "btrfs" (file-system-type fs)))
- (option-keys (map (match-lambda
- ((key . value) key)
- (key key))
- (file-system-options->alist
- (file-system-options fs)))))
- (find (cut string-prefix? "subvol" <>) option-keys)))
+ (or (and-let* ((btrfs-file-system? (string= "btrfs" (file-system-type fs)))
+ (option-keys (map (match-lambda
+ ((key . value) key)
+ (key key))
+ (file-system-options->alist
+ (file-system-options fs)))))
+ (find (cut string-prefix? "subvol" <>) option-keys))
+ (and (string=? "zfs" (file-system-type fs))
+ ;; "zfs:zpool/dataset"
+ (string-contains (file-system-device fs) "/"))))
(define (btrfs-store-subvolume-file-name file-systems)
"Return the subvolume file name within the Btrfs top level onto which the
@@ -664,6 +667,13 @@ (define (btrfs-store-subvolume-file-name file-systems)
;; XXX: Deriving the subvolume name based from a subvolume ID is not
;; supported, as we'd need to query the actual file system.
(or (and=> (assoc-ref options "subvol") prepend-slash/maybe)
+ (and (string=? "zfs" (file-system-type store-subvolume-fs))
+ ;; "zfs:zpool/dataset" => "/dataset@"
+ (and=> (file-system-device store-subvolume-fs)
+ (lambda (device)
+ (string-append
+ (substring device (string-index device #\/))
+ "@"))))
(raise (condition
(&message
(message "The store is on a Btrfs subvolume, but the \
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 978084062b2..8bd4a4a7850 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -249,11 +249,25 @@ (define* (raw-initrd file-systems
;; File systems like btrfs need help to assemble multi-device file systems
;; but do not use manually-specified <mapped-devices>.
(let ((file-system-types (map file-system-type file-systems)))
- (if (member "btrfs" file-system-types)
- ;; Ignore errors: if the system manages to boot anyway, the better.
- #~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
- "device" "scan"))
- #~())))
+ (and
+ (if (member "btrfs" file-system-types)
+ ;; Ignore errors: if the system manages to boot anyway, the better.
+ #~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
+ "device" "scan"))
+ #~())
+ (map (lambda (zpool)
+ ;; Ignore errors: if the system manages to boot anyway, the
+ ;; better.
+ #~(system* #$(file-append zfs "/sbin/zpool")
+ "import" "-N" #$zpool))
+ (delete-duplicates
+ ;; "zfs:zpool/dataset" => "zpool"
+ (map (compose second
+ (cut string-split <> (char-set #\: #\/))
+ file-system-device)
+ (filter (lambda (fs)
+ (equal? (file-system-type fs) "zfs"))
+ file-systems)))))))
(define kodir
(flat-linux-module-directory (cons linux linux-extra-module-directories)
@@ -364,6 +378,7 @@ (define file-system-type-modules
("jfs" => '("jfs"))
("f2fs" => '("f2fs" "crc32_generic"))
("xfs" => '("xfs"))
+ ("zfs" => '("zfs"))
(else '())))
(define (file-system-modules file-systems)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 8a56f1cc63d..75a5bb1d5f1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -610,7 +610,8 @@ (define (check-file-system-availability file-systems)
(define literal
(filter (lambda (fs)
- (string? (file-system-device fs)))
+ (and (string? (file-system-device fs))
+ (not (string=? "zfs" (file-system-type fs)))))
relevant))
(define uuid
base-commit: 6174b135ffa3328fd7ad404b15b1586fc64e5666
prerequisite-patch-id: f71061d735b69d75799eb03df6215bbcb20d53b2
prerequisite-patch-id: 88337e68e714f3b1fe0d8e6588a1a4f423251610
prerequisite-patch-id: 466ade9e99cc152f8e9a33c742a4954ade466c25
prerequisite-patch-id: d66207367fc491f6569100503cd9df98b6888560
--
2.51.0
Reference in New Issue View Git Blame Copy Permalink