civodul pushed a commit to branch master in repository shepherd. commit fe6033d2ebb0ffea2a3c5e7299e936757588bb5b Author: Ludovic Courtès <l...@gnu.org> Date: Wed Jan 27 21:43:14 2016 +0100
services: Add 'eval' action to 'root'. * modules/shepherd/support.scm (eval-in-user-module): New procedure. * modules/shepherd/service.scm (root-service): Add 'eval' action. * tests/basic.sh: Add tests. * modules/shepherd/scripts/herd.scm (run-command): Add special case for 'eval'. * shepherd.texi (The root and unknown services): Document it. * NEWS: Mention it. --- NEWS | 1 + modules/shepherd/scripts/herd.scm | 5 +++++ modules/shepherd/service.scm | 14 +++++++++++++- modules/shepherd/support.scm | 8 ++++++++ shepherd.texi | 4 ++++ tests/basic.sh | 14 +++++++++++++- 6 files changed, 44 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 5971016..bcfd3cc 100644 --- a/NEWS +++ b/NEWS @@ -42,6 +42,7 @@ ctrl-alt-del is pressed (see ctrlaltdel(8)). ** ‘halt’ and ‘reboot’ connect to the system socket unconditionally ** ‘herd’ uses a non-zero exit code upon errors +** The ‘root’ service has a new ‘eval’ action ** Basic man pages are now provided ** ‘make-forkexec-constructor’ has new #:group and #:user parameters ** ‘make-forkexec-constructor’ has a new #:pid-file parameter diff --git a/modules/shepherd/scripts/herd.scm b/modules/shepherd/scripts/herd.scm index 98e2c7f..e87fd03 100644 --- a/modules/shepherd/scripts/herd.scm +++ b/modules/shepherd/scripts/herd.scm @@ -117,6 +117,11 @@ the daemon via SOCKET-FILE." ((help-text) (display (gettext help-text)) (newline)))) + (('eval (or 'root 'shepherd)) + (match result + ((value) + (write value) + (newline)))) (('status _) ;; We get a list of statuses, in case several services have the ;; same name. diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm index a7a0daa..6c50273 100644 --- a/modules/shepherd/service.scm +++ b/modules/shepherd/service.scm @@ -29,6 +29,7 @@ #:use-module (rnrs io ports) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:autoload (ice-9 pretty-print) (truncated-print) #:use-module (shepherd support) #:use-module (shepherd comm) #:use-module (shepherd config) @@ -1163,12 +1164,23 @@ Clients such as 'herd' can read it and format it in a human-readable way." (lambda (key) (local-output "Shutting down...") (power-off))))) - ;; Load a configuration file. + ;; Evaluate arbitrary code. (load "Load the Scheme code from FILE into shepherd. This is potentially dangerous. You have been warned." (lambda (running file-name) (load-config file-name))) + (eval + "Evaluate the given Scheme expression into the shepherd. This is +potentially dangerous, be careful." + (lambda (running str) + (let ((exp (call-with-input-string str read))) + (local-output "Evaluating user expression ~a." + (call-with-output-string + (lambda (port) + (truncated-print exp port #:width 50)))) + (eval-in-user-module exp)))) + ;; Unload a service (unload "Unload the service identified by SERVICE-NAME or all services diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm index ba575d3..9bc5f5d 100644 --- a/modules/shepherd/support.scm +++ b/modules/shepherd/support.scm @@ -50,6 +50,7 @@ default-persistency-state-file load-in-user-module + eval-in-user-module persistency persistency-state-file @@ -333,6 +334,13 @@ which has essential bindings pulled in." (set-current-module user-module) (primitive-load file))))) +(define (eval-in-user-module exp) + "Eval EXP in a fresh user module that has essential bindings pulled in." + (let ((user-module (make-user-module))) + (save-module-excursion + (lambda () + (eval exp user-module))))) + (define* (verify-dir dir #:key (secure? #t)) "Check if the directory DIR exists and create it if it is the default directory, but does not exist. If SECURE? is false, permissions of the diff --git a/shepherd.texi b/shepherd.texi index 5dc5f9c..5203af1 100644 --- a/shepherd.texi +++ b/shepherd.texi @@ -946,6 +946,10 @@ Evaluate the Scheme code in @var{file} in a fresh module that uses the @code{(oop goops)} and @code{(shepherd services)} modules---as with the @code{--config} option of @command{shepherd} (@pxref{Invoking shepherd}). +@item eval @var{exp} +Likewise, evaluate Scheme expression @var{exp} in a fresh module with +all the necessary bindings. + @item unload @var{service-name} Attempt to remove the service identified by @var{service-name}. @command{shepherd} will first stop the service, if necessary, and then diff --git a/tests/basic.sh b/tests/basic.sh index ca49109..89f09c3 100644 --- a/tests/basic.sh +++ b/tests/basic.sh @@ -30,7 +30,7 @@ pid="t-pid-$$" herd="herd -s $socket" -trap "rm -f $socket $conf $stamp $log; +trap "cat $log || true; rm -f $socket $conf $stamp $log; test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT cat > "$conf"<<EOF @@ -162,6 +162,18 @@ $herd start test-loaded $herd status test-loaded | grep -i "running.*#<unspecified>" $herd stop test-loaded +# Deregister 'test-loaded' via 'eval'. +$herd eval root "(action root-service 'unload \"test-loaded\")" +if $herd status test-loaded +then false; else true; fi + +# Evaluate silly code, make sure nothing breaks. +if $herd eval root '(/ 0 0)' +then false; else true; fi + +if $herd eval root '(no closing paren' +then false; else true; fi + # Unload everything and make sure only 'root' is left. $herd unload root all $herd status | grep "Stopped: ()"