add some output as Consfigurator executes deployments

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

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*))