diff options
| -rw-r--r-- | gnu/system.scm | 34 | ||||
| -rw-r--r-- | tests/system.scm | 23 |
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) |