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.
This commit is contained in:
parent
362f496da9
commit
e502bf8953
@ -144,6 +144,18 @@ FILE-SYSTEM."
|
|||||||
(symbol-append 'file-system-
|
(symbol-append 'file-system-
|
||||||
(string->symbol (file-system-mount-point 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
|
(define file-system-service-type
|
||||||
;; TODO(?): Make this an extensible service that takes <file-system> objects
|
;; TODO(?): Make this an extensible service that takes <file-system> objects
|
||||||
;; and returns a list of <dmd-service>.
|
;; and returns a list of <dmd-service>.
|
||||||
@ -160,7 +172,7 @@ FILE-SYSTEM."
|
|||||||
(dmd-service
|
(dmd-service
|
||||||
(provision (list (file-system->dmd-service-name file-system)))
|
(provision (list (file-system->dmd-service-name file-system)))
|
||||||
(requirement `(root-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.")
|
(documentation "Check, mount, and unmount the given file system.")
|
||||||
(start #~(lambda args
|
(start #~(lambda args
|
||||||
;; FIXME: Use or factorize with 'mount-file-system'.
|
;; FIXME: Use or factorize with 'mount-file-system'.
|
||||||
|
@ -195,19 +195,16 @@ as 'needed-for-boot'."
|
|||||||
(file-system-device fs)))
|
(file-system-device fs)))
|
||||||
(operating-system-mapped-devices os)))
|
(operating-system-mapped-devices os)))
|
||||||
|
|
||||||
(define (requirements fs)
|
(define (add-dependencies fs)
|
||||||
;; XXX: Fiddling with dmd service names is not nice.
|
;; Add the dependencies due to device mappings to FS.
|
||||||
(append (map (lambda (fs)
|
(file-system
|
||||||
(symbol-append 'file-system-
|
(inherit fs)
|
||||||
(string->symbol
|
(dependencies
|
||||||
(file-system-mount-point fs))))
|
(delete-duplicates (append (device-mappings fs)
|
||||||
(file-system-dependencies fs))
|
(file-system-dependencies fs))
|
||||||
(map (lambda (md)
|
eq?))))
|
||||||
(symbol-append 'device-mapping-
|
|
||||||
(string->symbol (mapped-device-target md))))
|
|
||||||
(device-mappings fs))))
|
|
||||||
|
|
||||||
(map file-system-service file-systems))
|
(map (compose file-system-service add-dependencies) file-systems))
|
||||||
|
|
||||||
(define (mapped-device-user device file-systems)
|
(define (mapped-device-user device file-systems)
|
||||||
"Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
|
"Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
|
||||||
|
@ -99,9 +99,8 @@
|
|||||||
(default #t))
|
(default #t))
|
||||||
(create-mount-point? file-system-create-mount-point? ; Boolean
|
(create-mount-point? file-system-create-mount-point? ; Boolean
|
||||||
(default #f))
|
(default #f))
|
||||||
(dependencies file-system-dependencies ; list of strings (mount
|
(dependencies file-system-dependencies ; list of <file-system>
|
||||||
; points depended on)
|
(default '()))) ; or <mapped-device>
|
||||||
(default '())))
|
|
||||||
|
|
||||||
(define-inlinable (file-system-needed-for-boot? fs)
|
(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
|
"Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
|
||||||
|
Loading…
Reference in New Issue
Block a user