me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
* gnu/services/nfs.scm (gss-service-type): Rewrite using SERVICE-TYPE to add
ability to extend the service.
This commit is contained in:
Ricardo Wurmus 2020-01-03 18:16:13 +01:00
parent 2a23942e3f
commit a6bdca6b9b
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 29 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
gnu/services/nfs.scm
View file

@ -136,26 +136,39 @@
(default nfs-utils))) (default nfs-utils)))
(define gss-service-type (define gss-service-type
(shepherd-service-type (let ((proc
'gss (lambda (config)
(lambda (config) (define nfs-utils
(define nfs-utils (gss-configuration-gss config))
(gss-configuration-gss config))
(define pipefs-directory (define pipefs-directory
(gss-configuration-pipefs-directory config)) (gss-configuration-pipefs-directory config))
(define gss-command (define gss-command
#~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f" #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
"-p" #$pipefs-directory)) "-p" #$pipefs-directory))
(shepherd-service (shepherd-service
(documentation "Start the RPC GSS daemon.") (documentation "Start the RPC GSS daemon.")
(requirement '(rpcbind-daemon rpc-pipefs)) (requirement '(rpcbind-daemon rpc-pipefs))
(provision '(gss-daemon)) (provision '(gss-daemon))
(start #~(make-forkexec-constructor #$gss-command)) (start #~(make-forkexec-constructor #$gss-command))
(stop #~(make-kill-destructor)))))) (stop #~(make-kill-destructor))))))
(service-type
(name 'gss)
(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)
(match values
((first . rest) first)
(_ config))))
(default-value (gss-configuration)))))