[shepherd] 04/07: service: Add one-shot services.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit c121eedfff7a50feddcf08e173d2b0dd807e8804
Author: Ludovic Courtès <address@hidden>
Date:   Thu Apr 18 12:10:02 2019 +0200

    service: Add one-shot services.
    
    * modules/shepherd/service.scm (<service>)[one-shot?]: New field.
    (start): Always set the 'running slot of a one-shot service to #f, but
    always return the value returned by the service's 'start' method.
    * tests/one-shot.sh: New file.
    * Makefile.am (TESTS): Add it.
    * doc/shepherd.texi (Slots of services): Document it.
    (Methods of services): Add 'one-shot?'.
---
 Makefile.am                  |  3 +-
 doc/shepherd.texi            | 17 +++++++++
 modules/shepherd/service.scm | 31 ++++++++++-----
 tests/one-shot.sh            | 91 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 132 insertions(+), 10 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 58438fe..b6d4831 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,6 +1,6 @@
 # Makefile.am -- How to build and install the Shepherd.
 # Copyright © 2002, 2003 Wolfgang Jährling <address@hidden>
-# Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <address@hidden>
+# Copyright © 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès 
<address@hidden>
 # Copyright © 2018 Carlo Zancanaro <address@hidden>
 #
 # This file is part of the GNU Shepherd.
@@ -192,6 +192,7 @@ TESTS =                                             \
   tests/pid-file.sh                            \
   tests/status-sexp.sh                         \
   tests/forking-service.sh                     \
+  tests/one-shot.sh                            \
   tests/signals.sh
 
 TEST_EXTENSIONS = .sh
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 143a74f..e652fc4 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -638,6 +638,19 @@ service if that process terminates.  Otherwise this slot 
is @code{#f},
 which is the default.  See also the @code{last-respawns} slot.
 
 @item
address@hidden one-shot? (slot of <service>)
address@hidden one-shot services
+The @code{one-shot?} slot determines whether the service is a @dfn{one-shot
+service}.  A one-shot service is a service that, as soon as it has been
+successfully started, is marked as ``stopped.''  Other services can
+nonetheless require one-shot services.  One-shot services are useful to
+trigger an action before other services are started, such as a cleanup or an
+initialization action.
+
+As for other services, the @code{start} method of a one-shot service must
+return a truth value to indicate success, and false to indicate failure.
+
address@hidden
 @vindex start (slot of <service>)
 @cindex Starting a service
 @cindex Service constructor
@@ -770,6 +783,10 @@ Returns which symbols are provided by @var{obj}.
 Returns which symbols are required by @var{obj}.
 @end deffn
 
address@hidden {method} one-shot? (obj <service>)
+Returns whether the service @var{obj} is a one-shot service.
address@hidden deffn
+
 @deffn {method} running? (obj <service>)
 Returns whether the service @var{obj} is running.
 @end deffn
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index bc75eca..53437b6 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1,5 +1,5 @@
 ;; service.scm -- Representation of services.
-;; Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès 
<address@hidden>
+;; Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<address@hidden>
 ;; Copyright (C) 2002, 2003 Wolfgang Järling <address@hidden>
 ;; Copyright (C) 2014 Alex Sassmannshausen <address@hidden>
 ;; Copyright (C) 2016 Alex Kost <address@hidden>
@@ -40,6 +40,7 @@
             service?
             canonical-name
             running?
+            one-shot?
             action-list
             lookup-action
             defines-action?
@@ -159,6 +160,12 @@ respawned, shows that it has been respawned more than 
TIMES in SECONDS."
   (requires #:init-keyword #:requires
            #:init-value '()
            #:getter required-by)
+  ;; If true, the service is a "one-shot" service: it becomes marked as
+  ;; stopped as soon as its 'start' method as completed, but services that
+  ;; depend on it may be started.
+  (one-shot? #:init-keyword #:one-shot?
+             #:init-value #f
+             #:getter one-shot?)
   ;; If `#t', then assume the `running' slot specifies a PID and
   ;; respawn it if that process terminates.  Otherwise `#f'.
   (respawn? #:init-keyword #:respawn?
@@ -301,17 +308,19 @@ wire."
 (define-method (start (obj <service>) . args)
   (cond ((running? obj)
         (local-output (l10n "Service ~a is already running.")
-                      (canonical-name obj)))
+                      (canonical-name obj))
+         (slot-ref obj 'running))
        ((not (enabled? obj))
         (local-output (l10n "Service ~a is currently disabled.")
-                      (canonical-name obj)))
+                      (canonical-name obj))
+         (slot-ref obj 'running))
        ((let ((conflicts (conflicts-with-running obj)))
           (or (null? conflicts)
               (local-output (l10n "Service ~a conflicts with running services 
~a.")
                             (canonical-name obj)
                             (map canonical-name conflicts)))
           (not (null? conflicts)))
-        #f) ;; Dummy.
+        (slot-ref obj 'running))
        (else
         ;; It is not running and does not conflict with anything
         ;; that's running, so we can go on and launch it.
@@ -337,11 +346,15 @@ wire."
                                                                 key args)))))))
 
           ;; Status message.
-          (local-output (if (running? obj)
-                            (l10n "Service ~a has been started.")
-                             (l10n "Service ~a could not be started."))
-                        (canonical-name obj)))))
-  (slot-ref obj 'running))
+           (let ((running (slot-ref obj 'running)))
+             (when (one-shot? obj)
+               (slot-set! obj 'running #f))
+             (local-output (if running
+                              (l10n "Service ~a has been started.")
+                               (l10n "Service ~a could not be started."))
+                          (canonical-name obj))
+
+             running)))))
 
 (define (replace-service old-service new-service)
   "Replace OLD-SERVICE with NEW-SERVICE in the services registry.  This
diff --git a/tests/one-shot.sh b/tests/one-shot.sh
new file mode 100644
index 0000000..93f545b
--- /dev/null
+++ b/tests/one-shot.sh
@@ -0,0 +1,91 @@
+# GNU Shepherd --- Test one-shot services.
+# Copyright © 2019 Ludovic Courtès <address@hidden>
+#
+# This file is part of the GNU Shepherd.
+#
+# The GNU Shepherd 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.
+#
+# The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
+
+shepherd --version
+herd --version
+
+socket="t-socket-$$"
+conf="t-conf-$$"
+confdir="t-confdir-$$"
+log="t-log-$$"
+stamp="t-stamp-$$"
+pid="t-pid-$$"
+
+herd="herd -s $socket"
+
+trap "cat $log || true; rm -f $socket $conf $stamp $log;
+      test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
+
+cat > "$conf"<<EOF
+(use-modules (srfi srfi-26))
+(register-services
+ (make <service>
+   #:provides '(always-fail)
+   #:start (const #f)
+   #:one-shot? #t)
+ (make <service>
+   #:provides '(test)
+   #:start (lambda _
+             (call-with-output-file "$stamp"
+               (cut display "foo" <>))
+             #t)
+   #:one-shot? #t)
+ (make <service>
+   #:provides '(test-2)
+   #:requires '(test)
+   #:start (lambda _
+             (call-with-output-file "$stamp-2"
+               (cut display "bar" <>))
+             #t)
+   #:stop  (lambda _
+             (delete-file "$stamp-2")
+             #f)))
+EOF
+
+rm -f "$pid"
+shepherd -I -s "$socket" -c "$conf" -l "$log" --pid="$pid" &
+
+# Wait till it's ready.
+while ! test -f "$pid" ; do sleep 0.3 ; done
+
+shepherd_pid="`cat $pid`"
+
+kill -0 $shepherd_pid
+test -S "$socket"
+
+# Make sure we notice startup failures of one-shot services.
+if $herd start always-fail; then false; else true; fi
+
+for i in 1 2 3
+do
+    rm -f "$stamp"
+    $herd start test
+    test -f "$stamp"
+    $herd status test | grep stopped
+    grep "test.*started" "$log"
+    $herd stop test            # no-op since it's already stopped
+done
+
+rm -f "$stamp" "$stamp-2"
+$herd start test-2
+test -f "$stamp"
+test -f "$stamp-2"
+$herd status test | grep stopped
+$herd status test-2 | grep started
+$herd stop test-2
+if test -f "$stamp-2"; then false; else true; fi