[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dmd] 04/04: service: Add 'status-sexp' action for dmd.
From: |
Ludovic Courtès |
Subject: |
[dmd] 04/04: service: Add 'status-sexp' action for dmd. |
Date: |
Thu, 07 Jan 2016 23:09:23 +0000 |
civodul pushed a commit to branch master
in repository dmd.
commit 841b009b4c59a8e698780974e0421a44f4b9c6c6
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 7 23:48:28 2016 +0100
service: Add 'status-sexp' action for dmd.
* modules/dmd/service.scm (service->sexp, service-list): New
procedures.
(dmd-service)[status-sexp]: New action.
* tests/status-sexp.sh: New file.
* Makefile.am (TESTS): Add it.
---
.gitignore | 2 +
Makefile.am | 1 +
modules/dmd/service.scm | 31 +++++++++++++++
tests/status-sexp.sh | 99 +++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 133 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
index 230d029..0b281f8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -48,3 +48,5 @@ Makefile
/tests/no-home.trs
/tests/sigint.log
/tests/sigint.trs
+/tests/status-sexp.log
+/tests/status-sexp.trs
diff --git a/Makefile.am b/Makefile.am
index 54993f0..3c4a642 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -136,6 +136,7 @@ TESTS = \
tests/basic.sh \
tests/respawn.sh \
tests/no-home.sh \
+ tests/status-sexp.sh \
tests/sigint.sh
TEST_EXTENSIONS = .sh
diff --git a/modules/dmd/service.scm b/modules/dmd/service.scm
index 81d0a72..f945497 100644
--- a/modules/dmd/service.scm
+++ b/modules/dmd/service.scm
@@ -436,6 +436,20 @@ respawned, shows that it has been respawned more than
TIMES in SECONDS."
(local-output " Will be respawned.")
(local-output " Will not be respawned.")))
+(define-method (service->sexp (service <service>))
+ "Return a representation of SERVICE as an sexp meant to be consumed by
+clients."
+ `(service (version 0) ;protocol version
+ (provides ,(provided-by service))
+ (requires ,(required-by service))
+ (respawn? ,(respawn? service))
+ (docstring ,(slot-ref service 'docstring))
+
+ ;; Status.
+ (enabled? ,(enabled? service))
+ (running ,(slot-ref service 'running))
+ (last-respawns ,(slot-ref service 'last-respawns))))
+
;; Return whether OBJ requires something that is not yet running.
(define-method (depends-resolved? (obj <service>))
(call/ec (lambda (return)
@@ -783,6 +797,13 @@ given USER and/or GROUP to run COMMAND."
#f ;; Unused
services))
+(define (service-list)
+ "Return the list of services currently defined."
+ (hash-fold (lambda (key services result)
+ (append services result))
+ '()
+ services))
+
(define (find-service pred)
"Return the first service that matches PRED, or #f if none was found."
(call/ec
@@ -1061,6 +1082,16 @@ which ones are not."
"Display detailed information about all services."
(lambda (running)
(for-each-service dmd-status)))
+
+ ;; Same, but send the result as an sexp.
+ (status-sexp
+ "Return an s-expression showing information about all the services."
+ (lambda (running)
+ (local-output "~s~%"
+ `(service-list
+ (version 0) ;protocol version
+ ,@(map service->sexp (service-list))))))
+
;; Halt.
(halt
"Halt the system."
diff --git a/tests/status-sexp.sh b/tests/status-sexp.sh
new file mode 100644
index 0000000..e55566a
--- /dev/null
+++ b/tests/status-sexp.sh
@@ -0,0 +1,99 @@
+# GNU dmd --- Test status sexps.
+# Copyright © 2016 Ludovic Courtès <address@hidden>
+#
+# This file is part of GNU dmd.
+#
+# GNU dmd is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU dmd is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU dmd. If not, see <http://www.gnu.org/licenses/>.
+
+dmd --version
+deco --version
+
+socket="t-socket-$$"
+conf="t-conf-$$"
+log="t-log-$$"
+pid="t-pid-$$"
+
+deco="deco -s $socket"
+
+trap "rm -f $socket $conf $stamp $log $pid;
+ test -f $pid && kill \`cat $pid\` || true" EXIT
+
+cat > "$conf"<<EOF
+(register-services
+ (make <service>
+ #:provides '(foo)
+ #:start (const 42)
+ #:stop (const #f)
+ #:docstring "Foo!"
+ #:respawn? #t)
+ (make <service>
+ #:provides '(bar)
+ #:requires '(foo)
+ #:start (const 'up-and-running)
+ #:stop (const #f)
+ #:docstring "Bar!"
+ #:respawn? #f))
+
+(start 'foo)
+EOF
+
+rm -f "$pid"
+dmd -I -s "$socket" -c "$conf" -l "$log" --pid="$pid" &
+
+# Wait till it's ready.
+while ! test -f "$pid" ; do : ; done
+
+dmd_pid="`cat $pid`"
+
+kill -0 $dmd_pid
+test -S "$socket"
+
+dmd_service_sexp="
+ (service (version 0)
+ (provides (dmd)) (requires ())
+ (respawn? #f)
+ (docstring \"The dmd service is used to operate on dmd itself.\")
+ (enabled? #t) (running #t) (last-respawns ()))"
+
+guile -c "
+(use-modules (srfi srfi-1))
+
+(exit
+ (lset= equal? '`$deco status-sexp dmd`
+ '(service-list (version 0)
+ $dmd_service_sexp
+ (service (version 0)
+ (provides (foo)) (requires ())
+ (respawn? #t) (docstring \"Foo!\")
+ (enabled? #t) (running 42)
+ (last-respawns ()))
+ (service (version 0)
+ (provides (bar)) (requires (foo))
+ (respawn? #f) (docstring \"Bar!\")
+ (enabled? #t) (running #f)
+ (last-respawns ())))))
+"
+
+# Unload everything and make sure only 'dmd' is left.
+$deco unload dmd all
+
+guile -c "
+(exit
+ (equal? '`$deco status-sexp dmd`
+ '(service-list (version 0) $dmd_service_sexp)))"
+
+$deco stop dmd
+! kill -0 $dmd_pid
+
+test -f "$log"