@@ -9,6 +9,7 @@
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
+;;; Copyright © 2024 Massimo Zaniboni <mzan@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)
@@ -2,6 +2,7 @@
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Ricardo <rekado@elephly.net>
+;;; Copyright © 2024 Massimo Zaniboni <mzan@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)))
@@ -5,6 +5,7 @@
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Massimo Zaniboni <mzan@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."
@@ -11,6 +11,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Massimo Zaniboni <mzan@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))))