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:
Ludovic Courtès 2015-10-29 18:22:19 +01:00
parent 362f496da9
commit e502bf8953
3 changed files with 24 additions and 16 deletions

@ -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