Subject: [bug#74273] [PATCH] Support for bcachefs-like multi-device file-systems.

From: Massimo Zaniboni <[email-masked]>
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 <[email-masked]>
 ;;; Copyright © 2024 Nicolas Graves <[email-masked]>
 ;;; Copyright © 2024 Richard Sent <[email-masked]>
+;;; Copyright © 2024 Massimo Zaniboni <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2020-2023 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2024 Ricardo <[email-masked]>
+;;; Copyright © 2024 Massimo Zaniboni <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <[email-masked]>
 ;;; Copyright © 2022 Oleg Pykhalov <[email-masked]>
+;;; Copyright © 2024 Massimo Zaniboni <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2021 Simon Tournier <[email-masked]>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <[email-masked]>
+;;; Copyright © 2024 Massimo Zaniboni <[email-masked]>
 ;;;
 ;;; 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