aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/system.scm34
-rw-r--r--tests/system.scm23
2 files changed, 42 insertions, 15 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index 84eab5f84f..e4a57475a9 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -359,6 +359,9 @@ marked as 'needed-for-boot'."
(remove file-system-needed-for-boot?
(operating-system-file-systems os)))
+ (define mapped-devices-for-boot
+ (operating-system-boot-mapped-devices os))
+
(define (device-mappings fs)
(let ((device (file-system-device fs)))
(if (string? device) ;title is 'device
@@ -374,21 +377,23 @@ marked as 'needed-for-boot'."
(file-system
(inherit fs)
(dependencies
- (delete-duplicates (append (device-mappings fs)
- (file-system-dependencies fs))
- eq?))))
+ (delete-duplicates
+ (remove (cut member <> mapped-devices-for-boot)
+ (append (device-mappings fs)
+ (file-system-dependencies fs)))
+ eq?))))
(service file-system-service-type
(map add-dependencies file-systems)))
-(define (mapped-device-user device file-systems)
- "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
+(define (mapped-device-users device file-systems)
+ "Return the subset of FILE-SYSTEMS that use DEVICE."
(let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
- (find (lambda (fs)
- (or (member device (file-system-dependencies fs))
- (and (string? (file-system-device fs))
- (string=? (file-system-device fs) target))))
- file-systems)))
+ (filter (lambda (fs)
+ (or (member device (file-system-dependencies fs))
+ (and (string? (file-system-device fs))
+ (string=? (file-system-device fs) target))))
+ file-systems)))
(define (operating-system-user-mapped-devices os)
"Return the subset of mapped devices that can be installed in
@@ -396,9 +401,8 @@ user-land--i.e., those not needed during boot."
(let ((devices (operating-system-mapped-devices os))
(file-systems (operating-system-file-systems os)))
(filter (lambda (md)
- (let ((user (mapped-device-user md file-systems)))
- (or (not user)
- (not (file-system-needed-for-boot? user)))))
+ (let ((users (mapped-device-users md file-systems)))
+ (not (any file-system-needed-for-boot? users))))
devices)))
(define (operating-system-boot-mapped-devices os)
@@ -407,8 +411,8 @@ from the initrd."
(let ((devices (operating-system-mapped-devices os))
(file-systems (operating-system-file-systems os)))
(filter (lambda (md)
- (let ((user (mapped-device-user md file-systems)))
- (and user (file-system-needed-for-boot? user))))
+ (let ((users (mapped-device-users md file-systems)))
+ (any file-system-needed-for-boot? users)))
devices)))
(define (device-mapping-services os)
diff --git a/tests/system.scm b/tests/system.scm
index 7d55da7174..9416b950e6 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -19,6 +19,7 @@
(define-module (test-system)
#:use-module (gnu)
+ #:use-module ((gnu services) #:select (service-value))
#:use-module (guix store)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64))
@@ -117,4 +118,26 @@
(type "ext4"))
%base-file-systems)))))
+(test-equal "non-boot-file-system-service"
+ '()
+
+ ;; Make sure that mapped devices with at least one needed-for-boot user are
+ ;; handled exclusively from the initrd. See <https://bugs.gnu.org/31889>.
+ (append-map file-system-dependencies
+ (service-value
+ ((@@ (gnu system) non-boot-file-system-service)
+ (operating-system
+ (inherit %os-with-mapped-device)
+ (file-systems
+ (list (file-system
+ (mount-point "/foo/bar")
+ (device "qux:baz")
+ (type "none")
+ (dependencies (list %luks-device)))
+ (file-system
+ (device (file-system-label "my-root"))
+ (mount-point "/")
+ (type "ext4")
+ (dependencies (list %luks-device))))))))))
+
(test-end)