summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-29 18:22:19 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-29 19:07:58 +0100
commite502bf8953afcd1e0cf29cd729e7c62c5c27792f (patch)
tree24a796b0e8beef91632b2d36f93fae32b2543c7d
parent362f496da9fc929d9548b8a56990779718b13c95 (diff)
system: File systems depend on their corresponding device mappings.
Fixes a regression introduced in commit 0adfe95. * gnu/system.scm (other-file-system-services)[requirements]: Remove. [add-dependencies]: New procedure. Use it. * gnu/system/file-systems.scm (<file-system>)[dependencies]: Update comment. * gnu/services/base.scm (mapped-device->dmd-service-name, dependency->dmd-service-name): New procedures. (file-system-service-type): Use it.
-rw-r--r--gnu/services/base.scm14
-rw-r--r--gnu/system.scm23
-rw-r--r--gnu/system/file-systems.scm5
3 files changed, 25 insertions, 17 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index b8e8ccd5f1..604416b985 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -144,6 +144,18 @@ FILE-SYSTEM."
(symbol-append 'file-system-
(string->symbol (file-system-mount-point file-system))))
+(define (mapped-device->dmd-service-name md)
+ "Return the symbol that denotes the dmd service of MD, a <mapped-device>."
+ (symbol-append 'device-mapping-
+ (string->symbol (mapped-device-target md))))
+
+(define dependency->dmd-service-name
+ (match-lambda
+ ((? mapped-device? md)
+ (mapped-device->dmd-service-name md))
+ ((? file-system? fs)
+ (file-system->dmd-service-name fs))))
+
(define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects
;; and returns a list of <dmd-service>.
@@ -160,7 +172,7 @@ FILE-SYSTEM."
(dmd-service
(provision (list (file-system->dmd-service-name file-system)))
(requirement `(root-file-system
- ,@(map file-system->dmd-service-name dependencies)))
+ ,@(map dependency->dmd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
;; FIXME: Use or factorize with 'mount-file-system'.
diff --git a/gnu/system.scm b/gnu/system.scm
index aa768824d9..37d6d075c5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -195,19 +195,16 @@ as 'needed-for-boot'."
(file-system-device fs)))
(operating-system-mapped-devices os)))
- (define (requirements fs)
- ;; XXX: Fiddling with dmd service names is not nice.
- (append (map (lambda (fs)
- (symbol-append 'file-system-
- (string->symbol
- (file-system-mount-point fs))))
- (file-system-dependencies fs))
- (map (lambda (md)
- (symbol-append 'device-mapping-
- (string->symbol (mapped-device-target md))))
- (device-mappings fs))))
-
- (map file-system-service file-systems))
+ (define (add-dependencies fs)
+ ;; Add the dependencies due to device mappings to FS.
+ (file-system
+ (inherit fs)
+ (dependencies
+ (delete-duplicates (append (device-mappings fs)
+ (file-system-dependencies fs))
+ eq?))))
+
+ (map (compose file-system-service add-dependencies) file-systems))
(define (mapped-device-user device file-systems)
"Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 8155b273e3..0a4b385fe3 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -99,9 +99,8 @@
(default #t))
(create-mount-point? file-system-create-mount-point? ; Boolean
(default #f))
- (dependencies file-system-dependencies ; list of strings (mount
- ; points depended on)
- (default '())))
+ (dependencies file-system-dependencies ; list of <file-system>
+ (default '()))) ; or <mapped-device>
(define-inlinable (file-system-needed-for-boot? fs)
"Return true if FS has the 'needed-for-boot?' flag set, or if it's the root