services: nfs: Allow pipefs-service-type to be extended.

* gnu/services/nfs.scm (pipefs-service-type): Rewrite using SERVICE-TYPE to
add ability to extend the service.
This commit is contained in:
Ricardo Wurmus 2020-01-03 17:50:45 +01:00
parent ba1808d5e7
commit 25c8c8cd4f
No known key found for this signature in database
GPG key ID: 197A5888235FACAC

View file

@ -24,6 +24,7 @@ (define-module (gnu services nfs)
#:use-module (gnu packages linux)
#:use-module (guix)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (gnu build file-systems)
#:export (rpcbind-service-type
@ -96,23 +97,33 @@ (define-record-type* <pipefs-configuration>
(default default-pipefs-directory)))
(define pipefs-service-type
(shepherd-service-type
'pipefs
(lambda (config)
(define pipefs-directory (pipefs-configuration-mount-point config))
(let ((proc
(lambda (config)
(define pipefs-directory (pipefs-configuration-mount-point config))
(shepherd-service
(documentation "Mount the pipefs pseudo file system.")
(provision '(rpc-pipefs))
(shepherd-service
(documentation "Mount the pipefs pseudo file system.")
(provision '(rpc-pipefs))
(start #~(lambda ()
(mkdir-p #$pipefs-directory)
(mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
(member #$pipefs-directory (mount-points))))
(start #~(lambda ()
(mkdir-p #$pipefs-directory)
(mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
(member #$pipefs-directory (mount-points))))
(stop #~(lambda (pid . args)
(umount #$pipefs-directory MNT_DETACH)
(not (member #$pipefs-directory (mount-points)))))))))
(stop #~(lambda (pid . args)
(umount #$pipefs-directory MNT_DETACH)
(not (member #$pipefs-directory (mount-points)))))))))
(service-type
(name 'pipefs)
(extensions
(list (service-extension shepherd-root-service-type
(compose list proc))))
;; We use the extensions feature to allow other services to automatically
;; configure and start this service. Only one value can be provided. We
;; override it with the value returned by the extending service.
(compose identity)
(extend (lambda (config values) (first values)))
(default-value (pipefs-configuration)))))