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.
This commit is contained in:
Ludovic Courtès 2016-08-21 18:50:14 +02:00
parent 9af4983266
commit aa1145df8d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 24 additions and 26 deletions

View File

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

View File

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