services: nscd: Add 'invalidate' and 'statistics' actions.

* gnu/services/base.scm (nscd-action-procedure, nscd-actions): New
procedures.
(nscd-shepherd-service): Add 'modules' and 'actions' fields.
* gnu/tests/base.scm (run-basic-test)["nscd invalidate action"]
["nscd invalidate action, wrong table"]: New tests.
* doc/guix.texi (Services): Mention 'herd doc nscd action'.
(Base Services): Document the actions.
This commit is contained in:
Ludovic Courtès 2018-11-13 11:02:13 +01:00
parent 190877748e
commit d3f75179e5
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 88 additions and 6 deletions

View File

@ -10563,11 +10563,14 @@ Start,,, shepherd, The GNU Shepherd Manual}). For example:
The above command, run as @code{root}, lists the currently defined
services. The @command{herd doc} command shows a synopsis of the given
service:
service and its associated actions:
@example
# herd doc nscd
Run libc's name service cache daemon (nscd).
# herd doc nscd action invalidate
invalidate: Invalidate the given cache--e.g., 'hosts' for host name lookups.
@end example
The @command{start}, @command{stop}, and @command{restart} sub-commands
@ -10965,6 +10968,27 @@ The Kmscon package to use.
Return a service that runs the libc name service cache daemon (nscd) with the
given @var{config}---an @code{<nscd-configuration>} object. @xref{Name
Service Switch}, for an example.
For convenience, the Shepherd service for nscd provides the following actions:
@table @code
@item invalidate
@cindex cache invalidation, nscd
@cindex nscd, cache invalidation
This invalidate the given cache. For instance, running:
@example
herd invalidate nscd hosts
@end example
@noindent
invalidates the host name lookup cache of nscd.
@item statistics
Running @command{herd statistics nscd} displays information about nscd usage
and caches.
@end table
@end deffn
@defvr {Scheme Variable} %nscd-default-configuration

View File

@ -1252,18 +1252,57 @@ the tty to run, among other things."
(string-concatenate
(map cache->config caches)))))))
(define (nscd-action-procedure nscd config option)
;; XXX: This is duplicated from mcron; factorize.
#~(lambda (_ . args)
;; Run 'nscd' in a pipe so we can explicitly redirect its output to
;; 'current-output-port', which at this stage is bound to the client
;; connection.
(let ((pipe (apply open-pipe* OPEN_READ #$nscd
"-f" #$config #$option args)))
(let loop ()
(match (read-line pipe 'concat)
((? eof-object?)
(catch 'system-error
(lambda ()
(zero? (close-pipe pipe)))
(lambda args
;; There's a race with the SIGCHLD handler, which could
;; call 'waitpid' before 'close-pipe' above does. If we
;; get ECHILD, that means we lost the race, but that's
;; fine.
(or (= ECHILD (system-error-errno args))
(apply throw args)))))
(line
(display line)
(loop)))))))
(define (nscd-actions nscd config)
"Return Shepherd actions for NSCD."
;; Make this functionality available as actions because that's a simple way
;; to run the right 'nscd' binary with the right config file.
(list (shepherd-action
(name 'statistics)
(documentation "Display statistics about nscd usage.")
(procedure (nscd-action-procedure nscd config "--statistics")))
(shepherd-action
(name 'invalidate)
(documentation
"Invalidate the given cache--e.g., 'hosts' for host name lookups.")
(procedure (nscd-action-procedure nscd config "--invalidate")))))
(define (nscd-shepherd-service config)
"Return a shepherd service for CONFIG, an <nscd-configuration> object."
(let ((nscd.conf (nscd.conf-file config))
(let ((nscd (file-append (nscd-configuration-glibc config)
"/sbin/nscd"))
(nscd.conf (nscd.conf-file config))
(name-services (nscd-configuration-name-services config)))
(list (shepherd-service
(documentation "Run libc's name service cache daemon (nscd).")
(provision '(nscd))
(requirement '(user-processes))
(start #~(make-forkexec-constructor
(list #$(file-append (nscd-configuration-glibc config)
"/sbin/nscd")
"-f" #$nscd.conf "--foreground")
(list #$nscd "-f" #$nscd.conf "--foreground")
;; Wait for the PID file. However, the PID file is
;; written before nscd is actually listening on its
@ -1277,7 +1316,12 @@ the tty to run, among other things."
(string-append dir "/lib"))
(list #$@name-services))
":")))))
(stop #~(make-kill-destructor))))))
(stop #~(make-kill-destructor))
(modules `((ice-9 popen) ;for the actions
(ice-9 rdelim)
(ice-9 match)
,@%default-modules))
(actions (nscd-actions nscd nscd.conf))))))
(define nscd-activation
;; Actions to take before starting nscd.

View File

@ -335,6 +335,20 @@ info --version")
(x
(pk 'failure x #f))))
(test-equal "nscd invalidate action"
'(#t) ;one value, #t
(marionette-eval '(with-shepherd-action 'nscd ('invalidate "hosts")
result
result)
marionette))
(test-equal "nscd invalidate action, wrong table"
'(#f) ;one value, #f
(marionette-eval '(with-shepherd-action 'nscd ('invalidate "xyz")
result
result)
marionette))
(test-equal "host not found"
#f
(marionette-eval