[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 01/02: services: Add 'eval' action to 'root'.
From: |
Ludovic Courtès |
Subject: |
[shepherd] 01/02: services: Add 'eval' action to 'root'. |
Date: |
Wed, 27 Jan 2016 21:06:48 +0000 |
civodul pushed a commit to branch master
in repository shepherd.
commit fe6033d2ebb0ffea2a3c5e7299e936757588bb5b
Author: Ludovic Courtès <address@hidden>
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}).
address@hidden 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: ()"