guix-commits
[Top][All Lists]
Advanced

[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"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]