mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
parent
9af4983266
commit
aa1145df8d
2 changed files with 24 additions and 26 deletions
|
|
@ -49,7 +49,7 @@ (define-module (gnu services base)
|
|||
#: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 @@ (define fstab-service-type
|
|||
(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 @@ (define dependency->shepherd-service-name
|
|||
(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 @@ (define (file-system-shepherd-service 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 @@ (define (file-system-shepherd-service 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
|
||||
|
|
|
|||
|
|
@ -178,9 +178,9 @@ (define-record-type* <operating-system> operating-system
|
|||
;;; 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 @@ (define (add-dependencies fs)
|
|||
(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 @@ (define known-fs
|
|||
|
||||
(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 @@ (define known-fs
|
|||
(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.
|
||||
|
|
|
|||
Loading…
Reference in a new issue