civodul pushed a commit to branch wip-goopsless
in repository shepherd.
commit 553810beec572cd997a0c1b2299f036734e7ce49
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Wed Apr 12 21:49:26 2023 +0200
service: Turn 'stop' method into a procedure.
* modules/shepherd/service.scm (stop): Rename to...
(stop-service): ... this. Turn into a procedure.
(stop): Define as a deprecated method.
(perform-service-action, deregister-service)
(shutdown-services): Use 'stop-service' instead of 'stop'.
* modules/shepherd/service/repl.scm (run-client-repl): Likewise.
* modules/shepherd.scm (call-with-server-socket)
(handle-SIGINT, process-command, process-textual-commands): Likewise.
* doc/shepherd.texi (Methods of services): Update accordingly.
(Service Convenience): Remove 'stop'.
---
doc/shepherd.texi | 20 ++++++--------
modules/shepherd.scm | 11 +++++---
modules/shepherd/service.scm | 58 ++++++++++++++++++++-------------------
modules/shepherd/service/repl.scm | 2 +-
4 files changed, 46 insertions(+), 45 deletions(-)
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index f9f634b..0368d35 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -739,14 +739,14 @@ Start @var{service} and its dependencies, passing
@var{args} to its
@code{start} method.
@end defun
-@deffn {method} stop (obj <service>)
-This will stop the service @var{obj}, trying to stop services that
-depend in it first, so they can be shutdown cleanly. If this will
-fail, it will continue anyway. Stopping of services should usually
-succeed, though. Otherwise, the behaviour is very similar to the
-@code{start} method. The return value is also the new running
-value, thus @code{#f} if the service was stopped.
-@end deffn
+@defun stop-service @var{service} . @var{args}
+Stop @var{service} and any service that depends on it. Return the list of
+canonical names for all of the services that have been stopped (including
+transitive dependent services).
+
+If @var{service} is not running, print a warning and return its canonical name
+in a list.
+@end defun
@defun perform-service-action @var{service} @var{the-action} . @var{args}
Perform @var{the-action} (a symbol such as @code{'restart} or @code{'status})
@@ -828,10 +828,6 @@ This procedure can be useful in a configuration file
because it lets you
interact right away with shepherd using the @command{herd} command.
@end deffn
-@deffn {method} stop (obj <symbol>)
-Stop a registered service providing @var{obj}.
-@end deffn
-
@deffn {procedure} for-each-service proc
Call @var{proc}, a procedure taking one argument, once for each
registered service.
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 1db2ae9..c2e478c 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -75,7 +75,7 @@ socket file at FILE-NAME upon exit of PROC. Return the
values of PROC."
(strerror (system-error-errno args)))
;; Stop services that were started from the config file
;; and quit.
- (stop 'root)))))))
+ (stop-service root-service)))))))
(unwind-protect (proc sock)
(begin
(close sock)
@@ -122,7 +122,7 @@ already ~a threads running, disabling 'signalfd' support")
(lambda ()
(catch 'quit
(lambda ()
- (stop root-service))
+ (stop-service root-service))
quit-exception-handler))))
(define (signal-handler signal)
@@ -520,7 +520,10 @@ fork in the child process."
(service-canonical-name service))
service)
(apply start-service service args)))
- ((stop) (apply stop service-symbol args))
+ ((stop)
+ (if (service-stopped? service)
+ '()
+ (apply stop-service service args)))
;; XXX: This used to return a list of action results, on the
;; grounds that there could be several services called NAME.
@@ -542,7 +545,7 @@ would write them on the 'herd' command line."
(if (eof-object? line)
;; Exit on `C-d'.
- (stop root-service)
+ (stop-service root-service)
(begin
(match (string-tokenize line)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 36fff39..ffc9cd5 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -77,7 +77,7 @@
disable-service
start-service
start-in-the-background
- stop
+ stop-service
perform-service-action
for-each-service
@@ -155,6 +155,7 @@
enable
disable
start
+ stop
action
action-list
lookup-action
@@ -793,23 +794,26 @@ 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 (service <service>) . args)
- "Stop SERVICE, and any services which depend on it. Returns a list of
-canonical names for all of the services which have been stopped (including
-transitive dependent services). This method will print a warning if SERVICE
-is not already running, and will return SERVICE's canonical name in a list."
+(define (stop-service service . args)
+ "Stop @var{service} and any service that depends on it. Return the list of
+canonical names for all of the services that have been stopped (including
+transitive dependent services).
+
+If @var{service} is not running, print a warning and return its canonical name
+in a list."
(if (service-stopped? service)
(begin
(local-output (l10n "Service ~a is not running.")
(service-canonical-name service))
(list (service-canonical-name service)))
(let ((name (service-canonical-name service))
- (stopped-dependents (fold-services (lambda (other acc)
- (if (and (service-running?
other)
- (required-by?
service other))
- (append (stop other) acc)
- acc))
- '())))
+ (stopped-dependents
+ (fold-services (lambda (other acc)
+ (if (and (service-running? other)
+ (required-by? service other))
+ (append (stop-service other) acc)
+ acc))
+ '())))
;; Stop the service itself.
(let ((reply (make-channel)))
(put-message (service-control service) `(stop ,reply))
@@ -856,7 +860,7 @@ the action."
;; Restarting is done in the obvious way.
((restart)
(lambda (running . args)
- (let ((stopped-services (stop service)))
+ (let ((stopped-services (stop-service service)))
(for-each (compose start-service lookup-service)
stopped-services)
#t)))
@@ -1119,19 +1123,6 @@ service state and to send requests to the service
monitor."
head
(loop (cdr lst)))))))))
-;; Stopping by name.
-(define-method (stop (name <symbol>) . args)
- (match (lookup-service name)
- (#f
- (raise (condition (&missing-service-error (name name)))))
- (service
- ;; XXX: This used to return a list of results, on the grounds that there
- ;; could be several services called NAME. Clients like 'herd' expect a
- ;; list.
- (if (service-stopped? service)
- '()
- (apply stop service args)))))
-
(define (start-in-the-background services)
"Start the services named by @var{services}, a list of symbols, in the
background. In other words, this procedure returns immediately without
@@ -2417,7 +2408,7 @@ name, or if it is the only service providing the service
that is
requested to be removed."
(define (deregister service)
(when (service-running? service)
- (stop service))
+ (stop-service service))
;; Remove services provided by service from the hash table.
(put-message (current-registry-channel)
`(unregister ,(list service))))
@@ -2530,6 +2521,17 @@ Used by `start'."
(if (eq? 'running (service-status service))
service
(apply start service args)))))
+(define-deprecated-method/rest (stop (service <service>))
+ stop-service)
+(define-method (stop (name <symbol>) . args)
+ (match (lookup-service name)
+ (#f
+ (raise (condition (&missing-service-error (name name)))))
+ (service
+ (if (service-stopped? service)
+ '()
+ (apply stop service args)))))
+
@@ -2543,7 +2545,7 @@ Used by `start'."
(for-each
(lambda (service)
(when (service-running? service)
- (stop service)))
+ (stop-service service)))
(service-list)))
(define (check-for-dead-services)
diff --git a/modules/shepherd/service/repl.scm
b/modules/shepherd/service/repl.scm
index a5f9785..4de9b66 100644
--- a/modules/shepherd/service/repl.scm
+++ b/modules/shepherd/service/repl.scm
@@ -89,7 +89,7 @@ crashes, stop @var{service}."
(start-repl))))))
(lambda args
(local-output (l10n "Uncaught REPL exception: ~s.") args)))
- (stop service))
+ (stop-service service))
(define default-repl-socket-file
;; Default socket file for the REPL.
