Package: guix-patches;
Reported by: Massimo Zaniboni <mzan <at> dokmelody.org>
Date: Sat, 9 Nov 2024 00:35:01 UTC
Severity: normal
Tags: moreinfo, patch
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Massimo Zaniboni <mzan <at> dokmelody.org> To: guix-patches <at> gnu.org Cc: Massimo Zaniboni <mzan <at> dokmelody.org> Subject: [PATCH] Support for bcachefs-like multi-device file-systems. Date: Sat, 9 Nov 2024 01:23:43 +0100
Support multi-device like "/dev/sda:/dev/sdb".
Change-Id: Iddd9c31f8c083a55e7a1fb193e7bbfb396e2def6
---
I'm using this patch on my system.
This is the first patch that I send using Stacked Git (`stg`).
I hope that the email format is correct.
gnu/build/file-systems.scm | 49 ++++++++++++++++++++++++++++---------
gnu/machine/ssh.scm | 23 ++++++++++++++++-
gnu/system/file-systems.scm | 15 ++++++++++++
guix/scripts/system.scm | 25 ++++++++++++++++++-
4 files changed, 98 insertions(+), 14 deletions(-)
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 41e1c9e..7dba7e0 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2022 Oleg Pykhalov <go.wigust <at> gmail.com>
;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
;;; Copyright © 2024 Richard Sent <richard <at> freakingpenguin.com>
+;;; Copyright © 2024 Massimo Zaniboni <mzan <at> dokmelody.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1138,9 +1139,9 @@ (define find-partition-by-luks-uuid
(define (canonicalize-device-spec spec)
- "Return the device name corresponding to SPEC, which can be a <uuid>, a
-<file-system-label>, the string 'none' or another string (typically a /dev
-file name or an nfs-root containing ':/')."
+ "Return the device name corresponding to SPEC, which can be a <uuid>,
+a <file-system-label>, the string 'none' or another string like a device,
+a multi-device, file name, nfs-root."
(define max-trials
;; Number of times we retry partition label resolution, 1 second per
;; trial. Note: somebody reported a delay of 16 seconds (!) before their
@@ -1162,20 +1163,44 @@ (define (canonicalize-device-spec spec)
(sleep 1)
(loop (+ 1 count))))))))
+ (define (resolve-multi-device find-partition multi-device)
+ (let ((specs (string-split multi-device #\:)))
+ (let loop
+ ((count 0))
+ (let ((nfp (find (lambda (d) (not (find-partition d))) specs)))
+ (if nfp
+ ;; Some devices take a bit of time to appear, most notably USB
+ ;; storage devices. Thus, wait for the device to appear.
+ (if (> count max-trials)
+ (error "failed to resolve partition" nfp)
+ (begin
+ (format #t "waiting for partition '~a' to appear...~%" nfp)
+ (sleep 1)
+ (loop (+ 1 count))))
+ multi-device)))))
+
(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
+ ((multi-device-spec? spec)
+ (resolve-multi-device identity spec))
+ ((string-contains spec ":/")
+ ;NFS, something like 'server:/some/path'
+ spec)
+ ((and (>= (string-length spec) 2)
+ (equal? (string-take spec 2) "//"))
+ ;CIFS
+ spec)
+ ((string=? spec "none")
+ ;tmpfs
+ spec)
+ (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
- (file-system-label->string spec)
- identity))
+ (file-system-label->string spec) identity))
((? uuid?)
(resolve find-partition-by-uuid
(uuid-bytevector spec)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3e10d98..0054adf 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays <at> sdf.org>
;;; Copyright © 2020-2023 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2024 Ricardo <rekado <at> elephly.net>
+;;; Copyright © 2024 Massimo Zaniboni <mzan <at> dokmelody.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -241,6 +242,22 @@ (define (machine-check-file-system-availability machine)
(file-system-device fs)
(strerror errno))))))
+ (define (check-multi-device-file-system fs)
+ (define multi-device (file-system-device fs))
+ (define devices (string-split multi-device #\:))
+ (define (check-device device)
+ (remote-let ((errno #~(catch 'system-error
+ (lambda ()
+ (stat #$device)
+ #t)
+ (lambda args
+ (system-error-errno args)))))
+ (when (number? errno)
+ (raise (formatted-message (G_ "device '~a' not found: ~a")
+ device
+ (strerror errno))))))
+ (map check-device devices))
+
(define (check-labeled-file-system fs)
(define remote-exp
(with-imported-modules (source-module-closure
@@ -278,8 +295,12 @@ (define (machine-check-file-system-availability machine)
(machine-configuration machine))
(append (map check-literal-file-system
(filter (lambda (fs)
- (string? (file-system-device fs)))
+ (single-device-spec? (file-system-device fs)))
file-systems))
+ (append-map check-multi-device-file-system
+ (filter (lambda (fs)
+ (multi-device-spec? (file-system-device fs)))
+ file-systems))
(map check-labeled-file-system
(filter (lambda (fs)
(file-system-label? (file-system-device fs)))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 4ea8237..9f91bd7 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me <at> tobias.gr>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust <at> gmail.com>
+;;; Copyright © 2024 Massimo Zaniboni <mzan <at> dokmelody.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -73,6 +74,9 @@ (define-module (gnu system file-systems)
spec->file-system
specification->file-system-mapping
+ multi-device-spec?
+ single-device-spec?
+
%pseudo-file-system-types
%fuse-control-file-system
%binary-format-file-system
@@ -309,6 +313,17 @@ (define (file-system-needed-for-boot? fs)
(and (file-prefix? (file-system-mount-point fs) (%store-prefix))
(not (memq 'bind-mount (file-system-flags fs))))))
+(define (multi-device-spec? spec)
+ "Return #t if the specification is like '/dev/sda:/dev/sdb'."
+ (and (string? spec)
+ (string-contains spec ":/")
+ (string-prefix? "/dev/" spec)))
+
+(define (single-device-spec? spec)
+ "Return #t if the specification is a string, but not a multi-device."
+ (and (string? spec)
+ (not (multi-device-spec? spec))))
+
(define (file-system->spec fs)
"Return a list corresponding to file-system FS that can be passed to the
initrd code."
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3..3459891 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -11,6 +11,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2024 Massimo Zaniboni <mzan <at> dokmelody.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -601,9 +602,16 @@ (define (check-file-system-availability file-systems)
(file-system-label? (file-system-device fs)))
relevant))
+ (define multi-device
+ (filter (lambda (fs)
+ (and (string? (file-system-device fs))
+ (multi-device-spec? (file-system-device fs))))
+ relevant))
+
(define literal
(filter (lambda (fs)
- (string? (file-system-device fs)))
+ (and (string? (file-system-device fs))
+ (single-device-spec? (file-system-device fs))))
relevant))
(define uuid
@@ -637,6 +645,21 @@ (define (check-file-system-availability file-systems)
label, write @code{(file-system-label ~s)} in your @code{device} field.")
device device))))))
literal)
+ (for-each
+ (lambda (fs)
+ (let* ((devices-str (file-system-device fs))
+ (devices (string-split devices-str #\:)))
+ (for-each
+ (lambda (device)
+ (catch 'system-error
+ (lambda () (stat device))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (error (file-system-location* fs)
+ (G_ " #8605 device '~a' not found in multi-device '~a': ~a~%")
+ device devices-str (strerror errno))))))
+ devices)))
+ multi-device)
(for-each (lambda (fs)
(let ((label (file-system-label->string
(file-system-device fs))))
base-commit: 2a6d96425eea57dc6dd48a2bec16743046e32e06
prerequisite-patch-id: 25d78fbfbd3268c16c93cd5d222386a7f421979b
prerequisite-patch-id: 30bc9aa990c70c6c1c45c951a58cf9a532b388fb
prerequisite-patch-id: 0000000000000000000000000000000000000000
prerequisite-patch-id: e22870a8d4b3ab67b12e05b6242b7f1bf5ac193b
--
2.46.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.