services: opendht: Use 'least-authority-wrapper'.

* gnu/services/networking.scm (opendht-configuration->command-line-arguments):
Use 'least-authority-wrapper'.
(opendht-shepherd-service): Use 'make-forkexec-constructor'.
This commit is contained in:
Ludovic Courtès 2022-04-27 18:35:21 +02:00
parent dac4efc466
commit fee06d5aaa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -796,7 +796,19 @@ (define (opendht-configuration->command-line-arguments config)
(match-record config <opendht-configuration> (match-record config <opendht-configuration>
(opendht bootstrap-host enable-logging? port debug? peer-discovery? (opendht bootstrap-host enable-logging? port debug? peer-discovery?
proxy-server-port proxy-server-port-tls) proxy-server-port proxy-server-port-tls)
(let ((dhtnode #~(string-append #$opendht:tools "/bin/dhtnode"))) (let ((dhtnode (least-authority-wrapper
;; XXX: Work around lack of support for multiple outputs
;; in 'file-append'.
(computed-file "dhtnode"
#~(symlink
(string-append #$opendht:tools
"/bin/dhtnode")
#$output))
#:name "dhtnode"
#:mappings (list (file-system-mapping
(source "/dev/log") ;for syslog
(target source)))
#:namespaces (delq 'net %namespaces))))
`(,dhtnode `(,dhtnode
"--service" ;non-forking mode "--service" ;non-forking mode
,@(if (string? bootstrap-host) ,@(if (string? bootstrap-host)
@ -822,23 +834,15 @@ (define (opendht-configuration->command-line-arguments config)
(define (opendht-shepherd-service config) (define (opendht-shepherd-service config)
"Return a <shepherd-service> running OpenDHT." "Return a <shepherd-service> running OpenDHT."
(with-imported-modules (source-module-closure (shepherd-service
'((gnu build shepherd) (documentation "Run an OpenDHT node.")
(gnu system file-systems))) (provision '(opendht dhtnode dhtproxy))
(shepherd-service (requirement '(networking syslogd))
(documentation "Run an OpenDHT node.") (start #~(make-forkexec-constructor
(provision '(opendht dhtnode dhtproxy)) (list #$@(opendht-configuration->command-line-arguments config))
(requirement '(networking syslogd)) #:user "opendht"
(modules '((gnu build shepherd) #:group "opendht"))
(gnu system file-systems))) (stop #~(make-kill-destructor))))
(start #~(make-forkexec-constructor/container
(list #$@(opendht-configuration->command-line-arguments config))
#:mappings (list (file-system-mapping
(source "/dev/log") ;for syslog
(target source)))
#:user "opendht"
#:group "opendht"))
(stop #~(make-kill-destructor)))))
(define opendht-service-type (define opendht-service-type
(service-type (service-type