first attempt to implement :SSH connection type

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

1 files changed, 30 insertions, 12 deletions

diff --git a/src/connection/ssh.lisp b/src/connection/ssh.lisp
index 59135ab..6e05e53 100644
--- a/src/connection/ssh.lisp
+++ b/src/connection/ssh.lisp
@@ -17,36 +17,54 @@
 
 (in-package :consfigurator.connection.ssh)
 
+(named-readtables:in-readtable :interpol-syntax)
+
 (defmethod establish-connection ((type (eql :ssh)) remaining
 				 &key
-				   (hop (get-hostname)))
+				   (hop (get-hostname))
+				   user)
   (declare (ignore remaining))
   (run "ssh" "-fN" hop)
-  (make-instance 'ssh-connection :hostname hop))
+  (make-instance 'ssh-connection :hostname hop :user user))
 
 (defclass ssh-connection (posix-connection)
   ((hostname
-    :documentation "Hostname to SSH to."))
+    :initarg :hostname
+    :documentation "Hostname to SSH to.")
+   (user
+    :initarg :user
+    :documentation "User to log in as."))
   (:documentation "Deploy properties using non-interactive SSH."))
 
+(defmacro ssh-host ()
+  `(if-let ((user (slot-value connection :user)))
+     (strcat user "@" (slot-value connection :hostname))
+     (slot-value connection :hostname)))
+
 (defmacro sshcmd (&rest args)
-  ;; wrap in 'sh -c' in case the login shell is not POSIX
-  `(list "ssh"
-	 (slot-value connection :hostname)
-	 (escape-sh-command "sh" "-c" ,@args)))
+  `(list
+    "ssh"
+    (ssh-host)
+    ;; wrap in 'sh -c' in case the login shell is not POSIX
+    (strcat "sh -c "
+	    (escape-sh-token
+	     ,(if (cdr args) `(escape-sh-command ',args) `(car ',args))))))
 
 (defmethod connection-run ((connection ssh-connection) cmd &optional input)
   (run :input input (sshcmd cmd)))
 
 (defmethod connection-readfile ((connection ssh-connection) path)
   (multiple-value-bind (output error-code)
-      (run (sshcmd "test" "-r" "path" "&&" "cat" path))
+      (run (sshcmd "test" "-r" path "&&" "cat" path))
     (if (= 0 error-code)
 	output
 	(error "File ~S not readable" path))))
 
-;; write to a temporary file, and then atomically move into place
-(defmethod connection-writefile ((connection ssh-connection) path contents))
+(defmethod connection-writefile ((connection ssh-connection) path contents)
+  (with-remote-temporary-file (temp)
+    (run :input contents (sshcmd "cat" #?">$(temp)"))
+    (run "mv" temp path)))
 
-;; rsync it to its destination, so rsync can be smart about updates
-(defmethod connection-upload ((connection ssh-connection) from to))
+;; rsync it straight to to its destination so rsync can do incremental updates
+(defmethod connection-upload ((connection ssh-connection) from to)
+  (run "rsync" "-Pavc" from (strcat (ssh-host) ":" to)))