~ruther/guix-local

e502bf8953afcd1e0cf29cd729e7c62c5c27792f — Ludovic Courtès 10 years ago 362f496
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.
3 files changed, 25 insertions(+), 17 deletions(-)

M gnu/services/base.scm
M gnu/system.scm
M gnu/system/file-systems.scm
M gnu/services/base.scm => gnu/services/base.scm +13 -1
@@ 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'.

M gnu/system.scm => gnu/system.scm +10 -13
@@ 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."

M gnu/system/file-systems.scm => gnu/system/file-systems.scm +2 -3
@@ 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