[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 05/05: service: Raise specific error conditions for missing s
|
From: |
Ludovic Courtès |
|
Subject: |
[shepherd] 05/05: service: Raise specific error conditions for missing services. |
|
Date: |
Mon, 18 Jan 2016 22:10:59 +0000 |
civodul pushed a commit to branch master
in repository shepherd.
commit 25aa597d20ab5102470765930d51214d868d65e8
Author: Ludovic Courtès <address@hidden>
Date: Mon Jan 18 23:02:30 2016 +0100
service: Raise specific error conditions for missing services.
This fixes a regression introduced in 2f204c9 whereby
"herd status does-not-exist" would spit out a backtrace on a 'match'
error.
* modules/shepherd/service.scm (&service-error, &missing-service-error):
New error conditions.
(launch-service, stop, action, deregister-service): Raise it instead of
using 'local-output' when the designated service is missing.
* modules/shepherd.scm (process-command): Guard against
&missing-service-error and handle it.
* modules/herd.scm (display-service-status): Handle 'error' sexps.
* tests/basic.sh: Test exit code of "herd status does-not-exist".
* tests/status-sexp.sh: Test sexp returned for nonexistent services.
---
modules/herd.scm | 11 ++++++++++-
modules/shepherd.scm | 28 ++++++++++++++++++++--------
modules/shepherd/service.scm | 32 ++++++++++++++++++++++++--------
tests/basic.sh | 5 +++++
tests/status-sexp.sh | 13 +++++++++++++
5 files changed, 72 insertions(+), 17 deletions(-)
diff --git a/modules/herd.scm b/modules/herd.scm
index 47934a6..1351bde 100644
--- a/modules/herd.scm
+++ b/modules/herd.scm
@@ -97,7 +97,16 @@ of pairs."
;; (format #t (l10n " Conflicts with ~a." (conflicts-with obj)))
(if respawn?
(format #t (l10n " Will be respawned.~%"))
- (format #t (l10n " Will not be respawned.~%")))))))
+ (format #t (l10n " Will not be respawned.~%")))))
+ (('error ('version 0 _ ...) 'service-not-found service)
+ (format (current-error-port)
+ (l10n "Service ~a could not be found.~%")
+ service)
+ (exit 1))
+ (('error . _)
+ (format (current-error-port)
+ (l10n "Something went wrong: ~s~%")
+ service))))
(define (run-command socket-file action service args)
"Perform ACTION with ARGS on SERVICE, and display the result. Connect to
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index cc74743..01097ea 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -24,6 +24,7 @@
#:use-module (oop goops) ;; Defining classes and methods.
#:use-module (srfi srfi-1) ;; List library.
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (shepherd config)
#:use-module (shepherd support)
#:use-module (shepherd service)
@@ -228,14 +229,25 @@
;; line to herd before we actually quit.
(catch 'quit
(lambda ()
- (case the-action
- ((start) (apply start service-symbol args))
- ((stop) (apply stop service-symbol args))
- ((enforce) (apply enforce service-symbol args))
+ (guard (c ((missing-service-error? c)
+ (case the-action
+ ((status)
+ ;; For these actions, we must always return an sexp.
+ ;; TODO: Extend this to all actions.
+ (display `(error (version 0) service-not-found
+ ,(missing-service-name c))
+ (%current-client-socket)))
+ (else
+ (local-output "Service ~a not found"
+ (missing-service-name c))))))
+ (case the-action
+ ((start) (apply start service-symbol args))
+ ((stop) (apply stop service-symbol args))
+ ((enforce) (apply enforce service-symbol args))
- ;; Actions which have the semantics of `action' are
- ;; handled there.
- (else (apply action service-symbol the-action args))))
+ ;; Actions which have the semantics of `action' are
+ ;; handled there.
+ (else (apply action service-symbol the-action args)))))
(lambda (key)
;; Most likely we're receiving 'quit' from the 'stop' method of
;; DMD-SERVICE. So, if we're running as 'root', just reboot.
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 72fe34c..453b48a 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -22,6 +22,8 @@
#:use-module (oop goops)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (shepherd support)
@@ -68,7 +70,13 @@
make-init.d-service
dmd-service
- make-actions))
+ make-actions
+
+ &service-error
+ service-error?
+ &missing-service-error
+ missing-service-error?
+ missing-service-name))
;; Conveniently create an actions object containing the actions for a
;; <service> object. The current structure is a list of actions,
@@ -167,6 +175,15 @@ respawned, shows that it has been respawned more than
TIMES in SECONDS."
(define action:proc cadr)
(define action:doc cddr)
+;; Service errors.
+(define-condition-type &service-error &error service-error?)
+
+;; Error raised when looking up a service by name fails.
+(define-condition-type &missing-service-error &service-error
+ missing-service-error?
+ (name missing-service-name))
+
+
;; Return the canonical name of the service.
(define-method (canonical-name (obj <service>))
(car (provided-by obj)))
@@ -428,7 +445,7 @@ clients."
(define (launch-service name proc args)
(match (lookup-services name)
(()
- (local-output "No service provides ~a." name))
+ (raise (condition (&missing-service-error (name name)))))
((possibilities ...)
(or (first-running possibilities)
@@ -460,8 +477,8 @@ clients."
(if (and unknown
(defines-action? unknown 'stop))
(apply action unknown 'stop obj args)
- (local-output "No service currently providing ~a." obj)))
- (apply stop which args))))
+ (raise (condition (&missing-service-error (name obj))))))
+ (apply stop which args))))
;; Perform action THE-ACTION by name.
(define-method (action (obj <symbol>) the-action . args)
@@ -471,7 +488,7 @@ clients."
(if (and unknown
(defines-action? unknown 'action))
(apply action unknown 'action the-action args)
- (local-output "No service at all providing ~a." obj)))
+ (raise (condition (&missing-service-error (name obj))))))
(for-each (lambda (s)
(apply (case the-action
((enable) enable)
@@ -917,10 +934,9 @@ requested to be removed."
;; Removing only one service.
(match (lookup-services name)
(() ; unknown service
- (local-output
- "Not unloading: '~a' is an uknown service." name))
+ (raise (condition (&missing-service-error (name name)))))
((service) ; only SERVICE provides NAME
- ;; Are we removing a user service窶ｦ
+ ;; Are we removing a user service…
(if (eq? (canonical-name service) name)
(local-output "Removing service '~a'..." name)
;; or a virtual service?
diff --git a/tests/basic.sh b/tests/basic.sh
index 7e5faa7..e7865a4 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -83,6 +83,11 @@ $herd start test-2
$herd status test-2 | grep started
+if $herd status does-not-exist
+then false; else true; fi
+
+$herd status does-not-exist 2>&1 | grep "does-not-exist.*not.*found"
+
# Unload one service, make sure the other it still around.
$herd unload dmd test
$herd status | grep "Stopped: (test-2)"
diff --git a/tests/status-sexp.sh b/tests/status-sexp.sh
index d77007f..629e9dc 100644
--- a/tests/status-sexp.sh
+++ b/tests/status-sexp.sh
@@ -91,6 +91,19 @@ dmd_service_sexp="
(last-respawns ())))))
"
+# Make sure we get an 'error' sexp when querying a nonexistent service.
+"$GUILE" -c "
+(use-modules (shepherd comm) (ice-9 match))
+
+(match (let ((sock (open-connection \"$socket\")))
+ (write-command (dmd-command 'status 'does-not-exist) sock)
+ (read sock))
+ (('error _ ... 'service-not-found 'does-not-exist)
+ #t)
+ (x
+ (pk 'wrong x)
+ (exit 1)))"
+
# Unload everything and make sure only 'dmd' is left.
$herd unload dmd all