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:
parent
9af4983266
commit
aa1145df8d
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue