[bug#32408] [PATCH shepherd] Allow replacement of services

[Carlo Zancanaro <carlo@zancanaro.id.au>]

[-- Attachment #1.1: Type: text/plain, Size: 602 bytes --]

This is a relatively simple patch adding a replacement slot to 
services in the Shepherd. When stopping a service, the replacement 
slot is checked and, if it has a value, is used to upgrade the 
current service.

I've chosen to modify the existing service, rather than creating a 
new one, but that was mostly because it was easier for me to 
implement quickly, and I didn't have a huge amount of time.

I'm hopeful that this, or something like it, can be used by GuixSD 
to allow people to restart services after reconfiguring without 
rebooting (or remembering to stop, reconfigure, start).

Carlo


[-- Attachment #1.2: 0001-service-Add-a-replacement-slot-for-delayed-service-r.patch --]
[-- Type: text/x-patch, Size: 6964 bytes --]

From e03290041c91813f1a301c7e9c4dbb9ee768b400 Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <carlo@zancanaro.id.au>
Date: Thu, 9 Aug 2018 22:30:38 +1000
Subject: [PATCH] service: Add a replacement slot for delayed service
 replacement.

* modules/shepherd/service.scm (<service>): Add replacement slot
(replace-service): New procedure.
(stop): Call replace-service after stopping a service.
* tests/replacement.sh: Add a test for it.
* Makefile.am (TESTS): Add the new test.
* doc/shepherd.texi (Slots of services): Document it.
---
 Makefile.am                  |   1 +
 doc/shepherd.texi            |   9 +++
 modules/shepherd/service.scm |  23 +++++++-
 tests/replacement.sh         | 106 +++++++++++++++++++++++++++++++++++
 4 files changed, 138 insertions(+), 1 deletion(-)
 create mode 100644 tests/replacement.sh

diff --git a/Makefile.am b/Makefile.am
index 8dad006..4322d7f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -184,6 +184,7 @@ SUFFIXES = .go
 
 TESTS =						\
   tests/basic.sh				\
+  tests/replacement.sh				\
   tests/respawn.sh				\
   tests/respawn-throttling.sh			\
   tests/misbehaved-client.sh			\
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 7946f8b..1de6d80 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -708,6 +708,15 @@ handler will not start it again.
 
 otherwise @code{#f}.
 
+@item
+@vindex replacement (slot of <service>)
+@code{replacement} specifies a service to be used to replace this one
+when it is stopped.  This service will continue to function normally
+until the @code{stop} action is invoked.  After the service has been
+successfully stopped, its definition will be replaced by the value of
+this slot, which must itself be a service.  This slot is ignored if
+its value is @code{#f}.
+
 @end itemize
 
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 5653388..4f62dc1 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -205,7 +205,10 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
   (stop-delay? #:init-keyword #:stop-delay?
 	       #:init-value #f)
   ;; The times of the last respawns, most recent first.
-  (last-respawns #:init-form '()))
+  (last-respawns #:init-form '())
+  ;; A replacement for when this service is stopped.
+  (replacement #:init-keyword #:replacement
+               #:init-value #f))
 
 (define (service? obj)
   "Return true if OBJ is a service."
@@ -341,6 +344,21 @@ wire."
 			 (canonical-name obj)))))
   (slot-ref obj 'running))
 
+(define (replace-service service)
+  (let ((replacement (slot-ref service 'replacement)))
+    (define (copy-slot! slot)
+      (slot-set! service slot (slot-ref replacement slot)))
+    (when replacement
+      (copy-slot! 'provides)
+      (copy-slot! 'requires)
+      (copy-slot! 'respawn?)
+      (copy-slot! 'start)
+      (copy-slot! 'stop)
+      (copy-slot! 'actions)
+      (copy-slot! 'running)
+      (copy-slot! 'docstring))
+    service))
+
 ;; Stop the service, including services that depend on it.  If the
 ;; latter fails, continue anyway.  Return `#f' if it could be stopped.
 (define-method (stop (obj <service>) . args)
@@ -385,6 +403,9 @@ wire."
                ;; Reset the list of respawns.
                (slot-set! obj 'last-respawns '())
 
+               ;; Replace the service with its replacement, if it has one
+               (replace-service obj)
+
                ;; Status message.
                (let ((name (canonical-name obj)))
                  (if (running? obj)
diff --git a/tests/replacement.sh b/tests/replacement.sh
new file mode 100644
index 0000000..585ab5a
--- /dev/null
+++ b/tests/replacement.sh
@@ -0,0 +1,106 @@
+# GNU Shepherd --- Ensure replacing services works properly
+# Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
+#
+# 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-$$"
+rconf="t-rconf-$$"
+log="t-log-$$"
+stamp="t-stamp-$$"
+pid="t-pid-$$"
+
+herd="herd -s $socket"
+
+trap "rm -f $socket $conf $rconf $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 '(test)
+   #:start (const #t)
+   #:actions (make-actions
+              (say-hello (lambda _
+                          (call-with-output-file "$stamp"
+                           (lambda (port)
+                            (display "Hello" port))))))
+   #:respawn? #f))
+EOF
+
+rm -f "$pid" "$stamp" "$socket"
+shepherd -I -s "$socket" -c "$conf" --pid="$pid" --log="$log" &
+
+while ! test -f "$pid"; do sleep 0.5 ; done
+
+$herd start test
+
+if ! $herd say-hello test; then
+    echo "say-hello failed"
+    exit 1
+fi
+
+cat - > "$rconf"<<EOF
+(let ((service (lookup-running 'test)))
+  (slot-set! service 'replacement
+             (make <service>
+               #:provides '(test)
+               #:start (const #t)
+               #:actions (make-actions
+                          (say-goodbye (lambda _
+                                         (call-with-output-file "$stamp"
+                                           (lambda (port)
+                                             (display "Goodbye" port))))))
+               #:respawn? #f)))
+EOF
+
+$herd load root "$rconf"
+
+if ! $herd say-hello test; then
+    echo "say-hello failed after setting replacement"
+    exit 1
+fi
+
+if test `cat $stamp` != "Hello"; then
+    echo "Output file had the wrong contents! Was:"
+    cat $stamp
+    exit 1
+fi
+
+$herd stop test
+
+$herd start test
+
+if $herd say-hello test; then
+    echo "say-hello should have failed after stop/start"
+    exit 1
+fi
+
+if ! $herd say-goodbye test; then
+    echo "say-goodbye should have failed"
+    exit 1
+fi
+
+if test `cat $stamp` != "Goodbye"; then
+    echo "Output file had the wrong contents! Was:"
+    cat $stamp
+    exit 1
+fi
-- 
2.18.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]