From b07c6b345c0459f829a9792e49b321615c203c4e Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Wed, 24 Feb 2021 10:07:56 -0700
Subject: add some output as Consfigurator executes deployments

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 src/connection/debian-sbcl.lisp | 19 ++++++++++++-------
 src/connection/ssh.lisp         |  1 +
 src/connection/sudo.lisp        |  1 +
 src/data.lisp                   | 16 ++++++++--------
 4 files changed, 22 insertions(+), 15 deletions(-)

diff --git a/src/connection/debian-sbcl.lisp b/src/connection/debian-sbcl.lisp
index 596b85a..cee6a07 100644
--- a/src/connection/debian-sbcl.lisp
+++ b/src/connection/debian-sbcl.lisp
@@ -21,11 +21,16 @@
   (mrun "which sbcl >/dev/null 2>&1 || apt-get -y install sbcl")
   (request-lisp-systems)
   (upload-all-prerequisite-data)
-  (princ "Handing over to remote Lisp ...")
-  (terpri)
-  (format t "~{    ~A~%~}"
-	  (runlines :input (deployment-handover-program remaining)
-		   "sbcl" "--noinform" "--noprint"
-		   "--disable-debugger"
-		   "--no-sysinit" "--no-user-init"))
+  (princ "Waiting for remote Lisp to exit, this may take some time ... ")
+  (let ((program (deployment-handover-program remaining)))
+    (multiple-value-bind (out err exit)
+	(run :may-fail :input program
+	     "sbcl" "--noinform" "--noprint"
+	     "--disable-debugger"
+	     "--no-sysinit" "--no-user-init")
+      (format t "done.")
+      (if (= 0 exit)
+	  (format t "  Output was:~%~{    ~A~%~}" (lines out))
+	  (error "~%~%Remote Lisp failed; we sent~%~%~A~%~%and stderr was:~%~A"
+		 program err))))
   nil)
diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp
index 2962fbc..419bb62 100644
--- a/src/connection/ssh.lisp
+++ b/src/connection/ssh.lisp
@@ -24,6 +24,7 @@
 				   (hop (get-hostname))
 				   user)
   (declare (ignore remaining))
+  (format t "Establishing SSH connection to ~A~%" hop)
   (mrun "ssh" "-fN" hop)
   (make-instance 'ssh-connection :hostname hop :user user))
 
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 0674fac..2b61693 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -60,6 +60,7 @@
 				   user
 				   password)
   (declare (ignore remaining))
+  (format t "Establishing sudo connection to ~A~%" user)
   (make-instance 'sudo-connection :user user :password password))
 
 (defclass sudo-connection (posix-connection)
diff --git a/src/data.lisp b/src/data.lisp
index 5ec2c2a..5f9846c 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -274,14 +274,14 @@ appropriate.  Falls back to CONNECTION-WRITEFILE."
   (when (subtypep (class-of *connection*)
 		  'consfigurator.connection.local:local-connection)
     (error "Attempt to upload data to the root Lisp; this is not allowed"))
-  (let ((*dest* (remote-data-pathname (iden1 data)
-				      (iden2 data)
-				      (data-version data))))
-    (declare (special *dest*))
-    (run "mkdir" "-p" (pathname-directory-pathname *dest*))
-    (call-next-method)
-    (push (list (iden1 data) (iden2 data) *dest*)
-	  (getf *this-hop-info* :cached-data))))
+  (with-slots (iden1 iden2 data-version) data
+    (let ((*dest* (remote-data-pathname iden1 iden2 data-version)))
+      (declare (special *dest*))
+      (mrun "mkdir" "-p" (pathname-directory-pathname *dest*))
+      (format t "Uploading (~@{~S~^ ~}) ... " iden1 iden2 data-version)
+      (call-next-method)
+      (push (list iden1 iden2 *dest*) (getf *this-hop-info* :cached-data))
+      (format t "done.~%"))))
 
 (defmethod connection-upload-data ((data file-data))
   (declare (special *dest*))
-- 
cgit v1.2.3