+(define (mapped-device-user device file-systems)
+ "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
+ (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
+ (find (lambda (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
+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)))))
+ devices)))
+
+(define (operating-system-boot-mapped-devices os)
+ "Return the subset of mapped devices that must be installed during boot,
+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))))
+ devices)))
+
+(define (device-mapping-services os)
+ "Return the list of device-mapping services for OS as a monadic list."
+ (sequence %store-monad
+ (map (lambda (md)
+ (let* ((source (mapped-device-source md))
+ (target (mapped-device-target md))
+ (type (mapped-device-type md))
+ (open (mapped-device-kind-open type))
+ (close (mapped-device-kind-close type)))
+ (device-mapping-service target
+ (open source target)
+ (close source target))))
+ (operating-system-user-mapped-devices os))))
+
+(define (swap-services os)
+ "Return the list of swap services for OS as a monadic list."
+ (sequence %store-monad
+ (map swap-service (operating-system-swap-devices os))))
+