From e502bf8953afcd1e0cf29cd729e7c62c5c27792f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 29 Oct 2015 18:22:19 +0100 Subject: 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 ()[dependencies]: Update comment. * gnu/services/base.scm (mapped-device->dmd-service-name, dependency->dmd-service-name): New procedures. (file-system-service-type): Use it. --- gnu/services/base.scm | 14 +++++++++++++- gnu/system.scm | 23 ++++++++++------------- gnu/system/file-systems.scm | 5 ++--- 3 files changed, 25 insertions(+), 17 deletions(-) (limited to 'gnu') 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 ." + (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 objects ;; and returns a list of . @@ -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 + (default '()))) ; or (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 -- cgit v1.2.3