summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-11-13 11:02:13 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-13 14:59:45 +0100
commitd3f75179e5741db29358e3e723146fd20ec79de9 (patch)
tree0994f9c9a433ae4296e0764ce551dd7ff009897a /gnu
parent190877748eeadff475dca822847fb3a5cc4467b9 (diff)
downloadpatches-d3f75179e5741db29358e3e723146fd20ec79de9.tar
patches-d3f75179e5741db29358e3e723146fd20ec79de9.tar.gz
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.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/base.scm54
-rw-r--r--gnu/tests/base.scm14
2 files changed, 63 insertions, 5 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3409bd352c..228d3c5926 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -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.
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 896d4a8f88..02882f4b46 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -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