From: Carlo Zancanaro <carlo@zancanaro.id.au>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 32408@debbugs.gnu.org
Subject: [bug#32408] [PATCH shepherd] Allow replacement of services
Date: Thu, 23 Aug 2018 23:45:05 +1000 [thread overview]
Message-ID: <87o9dtqjry.fsf@zancanaro.id.au> (raw)
In-Reply-To: <87in44ovzm.fsf@gnu.org>
[-- Attachment #1.1: Type: text/plain, Size: 972 bytes --]
Hey Ludo’,
I've attached an updated patch. I couldn't think of any unwanted
consequences, so I took your idea of making register-services
handle most of the details of replacement. With my patch,
something like
> herd eval root '(register-services (load "a.scm") (load
> "b.scm"))'
will deal with a conflict by either replacing the old service (if
it's not running), arranging for the old service to be replaced
when it's stopped, or raising an error. This seems like a sensible
way for things to function.
>> At the very least we need to control the inherent race
>> condition [...]
>
> Indeed.
Despite my desire to deal with the race condition, I haven't done
anything about it in this patch. The modification of %services
that was done in register-services was already racy, and I don't
think this patch will make it worse. If it hasn't been a problem
up until now, then I don't think this will make it a problem.
Carlo
[-- Attachment #1.2: 0001-service-Add-a-replacement-slot-for-delayed-service-r.patch --]
[-- Type: text/x-patch, Size: 9670 bytes --]
From 9ec5c0000e9a45441417a6ee4138cdcbf1b1f2b2 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.
(register-services): Replace existing services where possible, setting the new
replacement slot if they are currently running.
* 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 | 68 ++++++++++++++++++-----
tests/replacement.sh | 105 +++++++++++++++++++++++++++++++++++
4 files changed, 168 insertions(+), 15 deletions(-)
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..006309c 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,20 @@ wire."
(canonical-name obj)))))
(slot-ref obj 'running))
+(define (replace-service old-service new-service)
+ "Replace OLD-SERVICE with NEW-SERVICE in the services registry. This
+completely removes all references to OLD-SERVICE before registering
+NEW-SERVICE."
+ (define (remove-service name)
+ (let* ((old (hashq-ref %services name))
+ (new (delete old-service old)))
+ (if (null? new)
+ (hashq-remove! %services name)
+ (hashq-set! %services name new))))
+ (when new-service
+ (for-each remove-service (provided-by old-service))
+ (register-services new-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 +402,11 @@ wire."
;; Reset the list of respawns.
(slot-set! obj 'last-respawns '())
+ ;; Replace the service with its replacement, if it has one
+ (let ((replacement (slot-ref obj 'replacement)))
+ (when replacement
+ (replace-service obj replacement)))
+
;; Status message.
(let ((name (canonical-name obj)))
(if (running? obj)
@@ -1038,25 +1060,41 @@ then disable it."
;; Add NEW-SERVICES to the list of known services.
(define (register-services . new-services)
+ "Add NEW-SERVICES to the list of known services. If a service has already
+been registered, arrange to have it replaced when it is next stopped. If it
+is currently stopped, replace it immediately."
(define (register-single-service new)
;; Sanity-checks first.
(assert (list-of-symbols? (provided-by new)))
(assert (list-of-symbols? (required-by new)))
(assert (boolean? (respawn? new)))
- ;; Canonical name actually must be canonical. (FIXME: This test
- ;; is incomplete, since we may add a service later that makes it
- ;; non-cannonical.)
- (assert (null? (lookup-services (canonical-name new))))
- ;; FIXME: Verify consistency: Check that there are no circular
- ;; dependencies, check for bogus conflicts/dependencies, whatever
- ;; else makes sense.
-
- ;; Insert into the hash table.
- (for-each (lambda (name)
- (let ((old (lookup-services name)))
- ;; Actually add the new service now.
- (hashq-set! %services name (cons new old))))
- (provided-by new)))
+
+ ;; FIXME: Just because we have a unique canonical name now doesn't mean it
+ ;; will remain unique as other services are added. Whenever a service is
+ ;; added it should check that it's not conflicting with any already
+ ;; registered canonical names.
+ (match (lookup-services (canonical-name new))
+ (() ;; empty, so we can safely add ourselves
+ (for-each (lambda (name)
+ (let ((old (lookup-services name)))
+ (hashq-set! %services name (cons new old))))
+ (provided-by new)))
+ ((old) ;; one service registered, so it may be an old version of us
+ (cond
+ ((not (eq? (canonical-name new) (canonical-name old)))
+ (local-output
+ "Cannot register service ~a: canonical name is not unique."
+ (canonical-name new))
+ (throw 'non-canonical-name))
+ ((running? old)
+ (slot-set! old 'replacement new))
+ (#:else
+ (replace-service old new))))
+ (_ ;; in any other case, there are too many services to register
+ (local-output
+ "Cannot register service ~a: canonical name is not unique."
+ (canonical-name new))
+ (throw 'non-canonical-name))))
(for-each register-single-service new-services))
diff --git a/tests/replacement.sh b/tests/replacement.sh
new file mode 100644
index 0000000..e06cb93
--- /dev/null
+++ b/tests/replacement.sh
@@ -0,0 +1,105 @@
+# 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
+(register-services
+ (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 failed after replacement"
+ 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 --]
next prev parent reply other threads:[~2018-08-23 13:46 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-08-09 12:42 [bug#32408] [PATCH shepherd] Allow replacement of services Carlo Zancanaro
2018-08-20 20:33 ` Ludovic Courtès
2018-08-20 21:16 ` Carlo Zancanaro
2018-08-21 10:27 ` Ludovic Courtès
2018-08-23 13:45 ` Carlo Zancanaro [this message]
2018-08-25 14:20 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87o9dtqjry.fsf@zancanaro.id.au \
--to=carlo@zancanaro.id.au \
--cc=32408@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.