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) #:use-module (ice-9 format)
#:export (fstab-service-type #:export (fstab-service-type
root-file-system-service root-file-system-service
file-system-service file-system-service-type
user-unmount-service user-unmount-service
swap-service swap-service
user-processes-service user-processes-service
@ -164,7 +164,7 @@
(extensions (extensions
(list (service-extension etc-service-type (list (service-extension etc-service-type
file-systems->fstab))) file-systems->fstab)))
(compose identity) (compose concatenate)
(extend append))) (extend append)))
(define %root-file-system-shepherd-service (define %root-file-system-shepherd-service
@ -230,7 +230,8 @@ FILE-SYSTEM."
(file-system->shepherd-service-name fs)))) (file-system->shepherd-service-name fs))))
(define (file-system-shepherd-service file-system) (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)) (let ((target (file-system-mount-point file-system))
(device (file-system-device file-system)) (device (file-system-device file-system))
(type (file-system-type file-system)) (type (file-system-type file-system))
@ -238,10 +239,9 @@ FILE-SYSTEM."
(check? (file-system-check? file-system)) (check? (file-system-check? file-system))
(create? (file-system-create-mount-point? file-system)) (create? (file-system-create-mount-point? file-system))
(dependencies (file-system-dependencies file-system))) (dependencies (file-system-dependencies file-system)))
(if (file-system-mount? file-system) (and (file-system-mount? file-system)
(with-imported-modules '((gnu build file-systems) (with-imported-modules '((gnu build file-systems)
(guix build bournish)) (guix build bournish))
(list
(shepherd-service (shepherd-service
(provision (list (file-system->shepherd-service-name file-system))) (provision (list (file-system->shepherd-service-name file-system)))
(requirement `(root-file-system (requirement `(root-file-system
@ -290,23 +290,19 @@ FILE-SYSTEM."
;; We need an additional module. ;; We need an additional module.
(modules `(((gnu build file-systems) (modules `(((gnu build file-systems)
#:select (check-file-system canonicalize-device-spec)) #:select (check-file-system canonicalize-device-spec))
,@%default-modules))))) ,@%default-modules)))))))
'())))
(define file-system-service-type (define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects (service-type (name 'file-systems)
;; and returns a list of <shepherd-service>.
(service-type (name 'file-system)
(extensions (extensions
(list (service-extension shepherd-root-service-type (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 (service-extension fstab-service-type
identity))))) identity)))
(compose concatenate)
(define* (file-system-service file-system) (extend append)))
"Return a service that mounts @var{file-system}, a @code{<file-system>}
object."
(service file-system-service-type file-system))
(define user-unmount-service-type (define user-unmount-service-type
(shepherd-service-type (shepherd-service-type

View File

@ -178,9 +178,9 @@
;;; Services. ;;; Services.
;;; ;;;
(define (other-file-system-services os) (define (non-boot-file-system-service os)
"Return file system services for the file systems of OS that are not marked "Return the file system service for the file systems of OS that are not
as 'needed-for-boot'." marked as 'needed-for-boot'."
(define file-systems (define file-systems
(remove file-system-needed-for-boot? (remove file-system-needed-for-boot?
(operating-system-file-systems os))) (operating-system-file-systems os)))
@ -204,7 +204,8 @@ as 'needed-for-boot'."
(file-system-dependencies fs)) (file-system-dependencies fs))
eq?)))) 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) (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."
@ -270,11 +271,11 @@ a container or that of a \"bare metal\" system."
(let* ((mappings (device-mapping-services os)) (let* ((mappings (device-mapping-services os))
(root-fs (root-file-system-service)) (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)) (unmount (user-unmount-service known-fs))
(swaps (swap-services os)) (swaps (swap-services os))
(procs (user-processes-service (procs (user-processes-service
(map service-parameters other-fs))) (service-parameters other-fs)))
(host-name (host-name-service (operating-system-host-name os))) (host-name (host-name-service (operating-system-host-name os)))
(entries (operating-system-directory-base-entries (entries (operating-system-directory-base-entries
os #:container? container?))) os #:container? container?)))
@ -302,7 +303,8 @@ a container or that of a \"bare metal\" system."
(operating-system-setuid-programs os)) (operating-system-setuid-programs os))
(service profile-service-type (service profile-service-type
(operating-system-packages os)) (operating-system-packages os))
(append other-fs mappings swaps other-fs
(append mappings swaps
;; Add the firmware service, unless we are building for a ;; Add the firmware service, unless we are building for a
;; container. ;; container.