report whether FAILED-CHANGE, :NO-CHANGE or something else at end

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

3 files changed, 35 insertions, 10 deletions

diff --git a/src/combinator.lisp b/src/combinator.lisp
index 636893e..bcf532a 100644
--- a/src/combinator.lisp
+++ b/src/combinator.lisp
@@ -147,10 +147,16 @@ apply the elements of REQUIREMENTS in reverse order."
               ;; without any way to distinguish them.  Perhaps we can use the
               ;; :TEST argument to RESTART-CASE such that only the
               ;; innermost(?) skip option appears.
-              (setq result (restart-case (if announce
-                                             (announce-propapp-apply propapp)
-                                             (propapp-apply propapp))
-                             (skip-property () 'failed-change)))
+              (setq result
+                    (restart-case (if announce
+                                      (announce-propapp-apply propapp)
+                                      (propapp-apply propapp))
+                      (skip-property (c)
+                        ;; Re-signal as a non-error, for notification purposes.
+                        (signal 'failed-change
+                                :format-control (simple-condition-format-control c)
+                                :format-arguments (simple-condition-format-arguments c))
+                        'failed-change)))
             (when (and (plusp (length buffer))
                        (or (> *consfigurator-debug-level* 1)
                            (not (eql result :no-change))))
diff --git a/src/connection/fork.lisp b/src/connection/fork.lisp
index ae25bca..0a5e03c 100644
--- a/src/connection/fork.lisp
+++ b/src/connection/fork.lisp
@@ -100,11 +100,11 @@ for example, such that we don't see it."
            (princ (readfile output))
            (let ((exited (wifexited status)))
              (unless exited
-               (error
+               (failed-change
                 "Fork connection child did not exit normally, status #x~(~4,'0X~)"
                 status))
              (let ((exit-status (wexitstatus status)))
                (unless (< exit-status 2)
-                 (error
+                 (failed-change
                   "Fork connection child failed, exit code ~D" exit-status))
                (values nil (if (zerop status) :no-change nil))))))))))
diff --git a/src/deployment.lisp b/src/deployment.lisp
index fa79e81..348687a 100644
--- a/src/deployment.lisp
+++ b/src/deployment.lisp
@@ -71,6 +71,23 @@ will not be discarded."
         :propspec (with-*host*-*consfig*
                     (make-propspec :propspec propspec-expression)))))
 
+(defmacro with-deployment-report (&rest forms)
+  (with-gensyms (failures)
+    `(let (,failures)
+       (handler-bind
+           ((failed-change (lambda (c) (setq ,failures t) (signal c))))
+         (let ((result (progn ,@forms)))
+           (inform
+            t
+            (cond
+              ((eql :no-change result)
+               "No changes were made.")
+              (,failures
+               "There were failures while attempting to apply some properties.")
+              (t
+               "Changes were made without any reported failures.")))
+           result)))))
+
 (defun deploy* (connections host &optional additional-properties)
   "Execute the deployment which is defined by the pair (CONNECTIONS . HOST),
 except possibly with the property application specification
@@ -80,8 +97,9 @@ This is the entry point to Consfigurator's primary loop.  Typically users use
 DEPLOY, DEPLOY-THESE, and the function definitions established by DEFDEPLOY,
 DEFDEPLOY-THESE, etc., rather than calling this function directly.  However,
 code which programmatically constructs deployments will need to call this."
-  (%consfigure (preprocess-connections connections)
-               (union-propspec-into-host host additional-properties)))
+  (with-deployment-report
+      (%consfigure (preprocess-connections connections)
+                   (union-propspec-into-host host additional-properties))))
 
 (defun deploy-these* (connections host properties)
   "Like DEPLOY*, but replace the properties of HOST with PROPERTIES.
@@ -91,8 +109,9 @@ properties, plus any set by PROPERTIES.  Static informational attributes set
 by PROPERTIES can override the host's usual static informational attributes,
 in the same way that later entries in the list of properties specified in
 DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
-  (%consfigure (preprocess-connections connections)
-               (replace-propspec-into-host host properties)))
+  (with-deployment-report
+      (%consfigure (preprocess-connections connections)
+                   (replace-propspec-into-host host properties))))
 
 (defun continue-deploy* (connection remaining-connections)
   "Complete the work of an enclosing call to DEPLOY* or DEPLOY-THESE*.