This is an automated email from the git hooks/post-receive script.
guix_mirror_bot pushed a commit to branch master
in repository guix.
The following commit(s) were added to refs/heads/master by this push:
new e3d8fc1147 file-systems: mount-file-system: Guard against missing
devices.
e3d8fc1147 is described below
commit e3d8fc1147d03b6e6a47f8f1976068ad0faec9ab
Author: Rutherther <[email protected]>
AuthorDate: Wed Feb 4 19:19:19 2026 +0100
file-systems: mount-file-system: Guard against missing devices.
When a device with a UUID is missing, canonicalize-device-spec will throw an
error. This error is not handled for mount-may-fail? devices. That means
that if you use UUID device and it isn't available, the boot will hang on
the user-file-systems not being started. All user services depend on that
service.
Also added a test for this behavior.
* gnu/build/file-systems.scm
(mount-file-system): Guard canonicalize-device-spec call.
(canonicalize-device-spec): Throw &partition-lookup-error on missing
partition.
(&partition-lookup-error): New variable.
* gnu/tests/base.scm (%test-missing-file-system): New variable.
Change-Id: I3b8d652251cef421cff6d2fdafb8d9d7d1fc74b5
Reported-By: renbus, on IRC
Signed-off-by: Maxim Cournoyer <[email protected]>
---
gnu/build/file-systems.scm | 80 +++++++++++++++++++++++++++++++---------------
gnu/tests/base.scm | 54 ++++++++++++++++++++++++++++++-
2 files changed, 107 insertions(+), 27 deletions(-)
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index d25b798b11..72d7f5f260 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -37,6 +37,7 @@
#:use-module (guix i18n)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
+ #:use-module (ice-9 exceptions)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
@@ -45,6 +46,8 @@
#:autoload (system repl repl) (start-repl)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:export (disk-partitions
partition-label-predicate
partition-uuid-predicate
@@ -65,6 +68,9 @@
cleanly-unmounted-ext2?
+ partition-lookup-error?
+ &partition-lookup-error
+
bind-mount
system*/tty
@@ -1182,6 +1188,10 @@ were found."
(define find-partition-by-luks-uuid
(find-partition luks-partition-uuid-predicate))
+(define-condition-type &partition-lookup-error &condition
+ partition-lookup-error?
+ (spec partition-lookup-error-spec))
+
(define (canonicalize-device-spec spec)
"Return the device name corresponding to SPEC, which can be a <uuid>, a
@@ -1201,7 +1211,9 @@ file name or an nfs-root containing ':/')."
;; 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" (fmt spec))
+ (raise (condition
+ (&partition-lookup-error
+ (spec (fmt spec)))))
(begin
(format #t "waiting for partition '~a' to appear...~%"
(fmt spec))
@@ -1319,6 +1331,14 @@ corresponds to the symbols listed in FLAGS."
(()
0))))
+(define kind-and-args-exception?
+ (exception-predicate &exception-with-kind-and-args))
+
+(define (system-error? exception)
+ "Return true if EXCEPTION is a Guile 'system-error exception."
+ (and (kind-and-args-exception? exception)
+ (eq? 'system-error (exception-kind exception))))
+
(define* (mount-file-system fs #:key (root "/root")
(check? (file-system-check? fs))
(skip-check-if-clean?
@@ -1339,8 +1359,8 @@ corresponds to the symbols listed in FLAGS."
(host-part (string-take source idx))
;; Strip [] from around host if present
(host (match (string-split host-part (string->char-set "[]"))
- (("" h "") h)
- ((h) h)))
+ (("" h "") h)
+ ((h) h)))
(inet-addr (host-to-ip host "nfs")))
;; Mounting an NFS file system requires passing the address
;; of the server in the addr= option
@@ -1426,26 +1446,37 @@ corresponds to the symbols listed in FLAGS."
"," 'prefix)
"")))))
- (let* ((type (file-system-type fs))
- (source (canonicalize-device-spec (file-system-device fs)))
- (target (string-append root "/"
- (file-system-mount-point fs)))
- (flags (logior (mount-flags->bit-mask (file-system-flags fs))
-
- ;; For bind mounts, preserve the original flags such
- ;; as MS_NOSUID, etc. Failing to do that, the
- ;; MS_REMOUNT call below fails with EPERM.
- ;; See <https://bugs.gnu.org/46292>
- (if (memq 'bind-mount (file-system-flags fs))
- (statfs-flags->mount-flags
- (file-system-mount-flags (statfs source)))
- 0)))
- (options (file-system-options fs)))
- (when check?
- (check-file-system source type (not skip-check-if-clean?) repair))
+ (guard (c ((partition-lookup-error? c)
+ (format (current-error-port)
+ "could not find the partition: ~a~%"
+ (partition-lookup-error-spec c))
+ (unless (file-system-mount-may-fail? fs)
+ (raise c)))
+ ((system-error? c)
+ (format (current-error-port)
+ "could not mount partition ~a: ~a~%"
+ (file-system-device fs)
+ (exception-message c))
+ (unless (file-system-mount-may-fail? fs)
+ (raise c))))
+ (let* ((type (file-system-type fs))
+ (source (canonicalize-device-spec (file-system-device fs)))
+ (target (string-append root "/"
+ (file-system-mount-point fs)))
+ (flags (logior (mount-flags->bit-mask (file-system-flags fs))
+
+ ;; For bind mounts, preserve the original flags
such
+ ;; as MS_NOSUID, etc. Failing to do that, the
+ ;; MS_REMOUNT call below fails with EPERM.
+ ;; See <https://bugs.gnu.org/46292>
+ (if (memq 'bind-mount (file-system-flags fs))
+ (statfs-flags->mount-flags
+ (file-system-mount-flags (statfs source)))
+ 0)))
+ (options (file-system-options fs)))
+ (when check?
+ (check-file-system source type (not skip-check-if-clean?) repair))
- (catch 'system-error
- (lambda ()
;; Create the mount point. Most of the time this is a directory, but
;; in the case of a bind mount, a regular file or socket may be
;; needed.
@@ -1474,10 +1505,7 @@ corresponds to the symbols listed in FLAGS."
(when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY)))
(let ((flags (logior MS_REMOUNT flags)))
- (mount source target type flags options))))
- (lambda args
- (or (file-system-mount-may-fail? fs)
- (apply throw args))))))
+ (mount source target type flags options))))))
(define %device-name-regexp "/dev/[hsvw]d([abcd])([0-9]*)")
(define %hurd-device-name-regexp "part:([0-9]*):device:[hw]d([0-9]*)")
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 86fa6374ef..403aa20cff 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -24,7 +24,8 @@
#:use-module (gnu tests)
#:use-module (gnu image)
#:use-module (gnu system)
- #:autoload (gnu system image) (system-image)
+ #:use-module (gnu system file-systems)
+ #:autoload (gnu system image) (system-image qcow2-image-type)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
@@ -61,6 +62,8 @@
%test-cleanup
%test-activation
+ %test-missing-file-system
+
%hello-dependencies-manifest
guix-daemon-test-cases
%test-guix-daemon
@@ -1357,3 +1360,52 @@ runs unprivileged.")
#:imported-modules '((gnu services herd)
(guix combinators)))))
(run-guix-daemon-test os "guix-daemon-unprivileged-test")))))
+
+(define %test-missing-file-system
+ (system-test
+ (name "missing-file-system")
+ (description
+ "Test that boot does not fail when a file system that might fail
+is specified and isn't provided by any device.")
+ (value
+ (let* ((os (marionette-operating-system
+ (operating-system
+ (inherit %simple-os)
+ (kernel-arguments (list "console=ttyS0,115200"))
+ (file-systems
+ (cons* (file-system
+ (device (uuid
"abcdef12-3456-7890-abcd-ef1234567890"))
+ (mount-point "/somewhere/1")
+ (mount? #t)
+ (mount-may-fail? #t)
+ (type "ext4"))
+ (file-system
+ (device (file-system-label "missing-fs"))
+ (mount-point "/somewhere/2")
+ (mount? #t)
+ (mount-may-fail? #t)
+ (type "ext4"))
+ (file-system
+ (device "/dev/missing")
+ (mount-point "/somewhere/3")
+ (mount? #t)
+ (mount-may-fail? #t)
+ (type "ext4"))
+ (file-system
+ (device (file-system-label "my-root"))
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems)))
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (image (system-image (os->image os #:type qcow2-image-type)))
+ (command
+ #~`(,(string-append #$qemu-minimal "/bin/" (qemu-command))
+ ,@(if (file-exists? "/dev/kvm")
+ '("-enable-kvm")
+ '())
+ "-m" "1024" ;memory size, in MiB
+ "-serial" "stdio"
+ "-snapshot" ;for volatile root, writable overlay
+ "-drive" ,(format #f "file=~a,if=virtio" #$image))))
+ (run-basic-test os command name)))))
