summaryrefslogtreecommitdiff
path: root/gnu/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-06-21 23:50:47 +0200
committerLudovic Courtès <ludo@gnu.org>2018-06-21 23:54:15 +0200
commit68a58775e071d4b0e000b93ad121b6e64d161b79 (patch)
treec3975b2782da2ad4e08071bbdc579b500dee4a77 /gnu/system.scm
parent1f1d76a1789dafb55cc9450cc1dbafb718a62215 (diff)
downloadpatches-68a58775e071d4b0e000b93ad121b6e64d161b79.tar
patches-68a58775e071d4b0e000b93ad121b6e64d161b79.tar.gz
system: Mapped devices needed for boot do not yield Shepherd services.
Fixes <https://bugs.gnu.org/31889>. Reported by Taylan Kammer <taylanbayirli@gmail.com>. * gnu/system.scm (non-boot-file-system-service)[mapped-devices-for-boot]: New variable. Remove dependencies of FS that are members of MAPPED-DEVICES-FOR-BOOT. (mapped-device-user): Rename to... (mapped-device-users): ... this. Use 'filter' instead of 'find'. (operating-system-user-mapped-devices) (operating-system-boot-mapped-devices): Use 'any file-system-needed-for-boot?' instead of looking at the first user. * tests/system.scm ("non-boot-file-system-service"): New test.
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm34
1 files changed, 19 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)