~ruther/guix-local

aa1145df8d43187f3e92aa505298cdeca4fb1191 — Ludovic Courtès 9 years ago 9af4983
services: Make a single extensible 'file-systems' service.

Previously we would create one 'file-system-service-type' instead per
file system.  Now, we create only one instance for all the file
systems.

* gnu/services/base.scm (fstab-service-type)[compose]: Change to
CONCATENATE.
(file-system-shepherd-service): Change to return either one
<shepherd-service> or #f.
(file-system-service-type): Pluralize 'name'.  Adjust
SHEPHERD-ROOT-SERVICE-TYPE extension to above changes.  Add 'compose'
and 'extend'.
(file-system-service): Remove.
* gnu/system.scm (other-file-system-services): Rename to...
(non-boot-file-system-service): ... this.  Change to return a single
FILE-SYSTEM-SERVICE-TYPE instance.
(essential-services): Adjust accordingly.
2 files changed, 24 insertions(+), 26 deletions(-)

M gnu/services/base.scm
M gnu/system.scm
M gnu/services/base.scm => gnu/services/base.scm +15 -19
@@ 49,7 49,7 @@
  #:use-module (ice-9 format)
  #:export (fstab-service-type
            root-file-system-service
            file-system-service
            file-system-service-type
            user-unmount-service
            swap-service
            user-processes-service


@@ 164,7 164,7 @@
                (extensions
                 (list (service-extension etc-service-type
                                          file-systems->fstab)))
                (compose identity)
                (compose concatenate)
                (extend append)))

(define %root-file-system-shepherd-service


@@ 230,7 230,8 @@ FILE-SYSTEM."
     (file-system->shepherd-service-name fs))))

(define (file-system-shepherd-service file-system)
  "Return a list containing the shepherd service for @var{file-system}."
  "Return the shepherd service for @var{file-system}, or @code{#f} if
@var{file-system} is not auto-mounted upon boot."
  (let ((target  (file-system-mount-point file-system))
        (device  (file-system-device file-system))
        (type    (file-system-type file-system))


@@ 238,10 239,9 @@ FILE-SYSTEM."
        (check?  (file-system-check? file-system))
        (create? (file-system-create-mount-point? file-system))
        (dependencies (file-system-dependencies file-system)))
    (if (file-system-mount? file-system)
        (with-imported-modules '((gnu build file-systems)
                                 (guix build bournish))
          (list
    (and (file-system-mount? file-system)
         (with-imported-modules '((gnu build file-systems)
                                  (guix build bournish))
           (shepherd-service
            (provision (list (file-system->shepherd-service-name file-system)))
            (requirement `(root-file-system


@@ 290,23 290,19 @@ FILE-SYSTEM."
            ;; We need an additional module.
            (modules `(((gnu build file-systems)
                        #:select (check-file-system canonicalize-device-spec))
                       ,@%default-modules)))))
        '())))
                       ,@%default-modules)))))))

(define file-system-service-type
  ;; TODO(?): Make this an extensible service that takes <file-system> objects
  ;; and returns a list of <shepherd-service>.
  (service-type (name 'file-system)
  (service-type (name 'file-systems)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          file-system-shepherd-service)
                                          (lambda (file-systems)
                                            (filter-map file-system-shepherd-service
                                                        file-systems)))
                       (service-extension fstab-service-type
                                          identity)))))

(define* (file-system-service file-system)
  "Return a service that mounts @var{file-system}, a @code{<file-system>}
object."
  (service file-system-service-type file-system))
                                          identity)))
                (compose concatenate)
                (extend append)))

(define user-unmount-service-type
  (shepherd-service-type

M gnu/system.scm => gnu/system.scm +9 -7
@@ 178,9 178,9 @@
;;; Services.
;;;

(define (other-file-system-services os)
  "Return file system services for the file systems of OS that are not marked
as 'needed-for-boot'."
(define (non-boot-file-system-service os)
  "Return the file system service for the file systems of OS that are not
marked as 'needed-for-boot'."
  (define file-systems
    (remove file-system-needed-for-boot?
            (operating-system-file-systems os)))


@@ 204,7 204,8 @@ as 'needed-for-boot'."
                                  (file-system-dependencies fs))
                          eq?))))

  (map (compose file-system-service add-dependencies) file-systems))
  (service file-system-service-type
           (map add-dependencies file-systems)))

(define (mapped-device-user device file-systems)
  "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."


@@ 270,11 271,11 @@ a container or that of a \"bare metal\" system."

  (let* ((mappings  (device-mapping-services os))
         (root-fs   (root-file-system-service))
         (other-fs  (other-file-system-services os))
         (other-fs  (non-boot-file-system-service os))
         (unmount   (user-unmount-service known-fs))
         (swaps     (swap-services os))
         (procs     (user-processes-service
                     (map service-parameters other-fs)))
                     (service-parameters other-fs)))
         (host-name (host-name-service (operating-system-host-name os)))
         (entries   (operating-system-directory-base-entries
                     os #:container? container?)))


@@ 302,7 303,8 @@ a container or that of a \"bare metal\" system."
                    (operating-system-setuid-programs os))
           (service profile-service-type
                    (operating-system-packages os))
           (append other-fs mappings swaps
           other-fs
           (append mappings swaps

                   ;; Add the firmware service, unless we are building for a
                   ;; container.