simplify control flow by specialising on INPUT in CONNECTION-RUN

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

4 files changed, 52 insertions, 64 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index 7963c00..ce5adf0 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -62,7 +62,7 @@ For an example of usage, see the :SUDO connection type."))
 
 ;;; generic functions to operate on subclasses of CONNECTION
 
-(defgeneric connection-run (connection cmd &optional input)
+(defgeneric connection-run (connection cmd input)
   (:documentation "Subroutine to run shell commands on the host.
 
 INPUT is a string to send to the shell command's stdin, or a stream which will
@@ -75,7 +75,7 @@ Returns (values OUT EXIT) where OUT is either merged stdout and stderr or
 stderr followed by stdout, and EXIT is the exit code.  Should not signal any
 error condition just because EXIT is non-zero."))
 
-(defmethod connection-run :around ((connection connection) cmd &optional input)
+(defmethod connection-run :around ((connection connection) cmd input)
   (declare (ignore cmd input))
   (let ((*connection* (slot-value connection 'parent)))
     (call-next-method)))
@@ -145,8 +145,10 @@ the root Lisp's machine.  For example, using rsync(1) over SSH."))
   `(let ((,file (mktemp)))
      (unwind-protect
 	  (progn ,@body)
-       (connection-run *connection* (format nil "rm -f ~A"
-					    (escape-sh-token ,file))))))
+       (connection-run *connection*
+		       (format nil "rm -f ~A"
+			       (escape-sh-token ,file))
+		       nil))))
 
 (defun mktemp ()
   "Make a temporary file on the remote side."
@@ -157,7 +159,8 @@ the root Lisp's machine.  For example, using rsync(1) over SSH."))
       ;; mktemp(1) as these may differ on different platforms.
       (connection-run
        *connection*
-       "echo 'mkstemp('${TMPDIR:-/tmp}'/tmp.XXXXXX)' | m4 2>/dev/null || mktemp")
+       "echo 'mkstemp('${TMPDIR:-/tmp}'/tmp.XXXXXX)' | m4 2>/dev/null || mktemp"
+       nil)
     (if (= exit 0)
 	(car (lines out))
 	(error 'run-failed :cmd "(attempt to make a temporary file on remote)"
diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index e78cee6..06b4e67 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -25,36 +25,24 @@
   (:documentation "The root deployment: applying properties to the machine the
 root Lisp is running on, as the root Lisp's uid."))
 
-;; assumes a POSIX shell (otherwise we could wrap in 'sh -c')
-(defmethod connection-run ((connection local-connection)
-			   shell-cmd
-			   &optional
-			     input)
-  ;; if INPUT is a stream, RUN-PROGRAM will empty it into a temporary file
-  ;; anyway, but it will not do so successfully if INPUT is a binary stream --
-  ;; in particular, it will try to call COPY-STREAM-TO-STREAM with
-  ;; :ELEMENT-TYPE CHARACTER.  so empty it into a temporary file ourselves.
-  (with-temporary-file (:pathname temp)
-    (etypecase input
-      (string
-       (with-output-to-file (s temp :if-exists :supersede)
-	 (write-sequence input s)))
-      (stream
-       (with-open-file (s temp :element-type (stream-element-type input)
-			       :direction :output
-			       :if-exists :supersede)
-	 (copy-stream-to-stream input s
-				:element-type (stream-element-type input))))
-      (null nil))
-    (multiple-value-bind (output _ exit-code)
-	(run-program shell-cmd
-		     :force-shell t
-		     :input temp
-		     :output :string
-		     :error-output :output
-		     :ignore-error-status t)
-      (declare (ignore _))
-      (values output exit-code))))
+(defmethod connection-run ((c local-connection) cmd (s stream))
+  ;; see https://gitlab.common-lisp.net/asdf/asdf/-/issues/59
+  (call-next-method c cmd `(,s :element-type ,(stream-element-type s))))
+
+(defmethod connection-run ((c local-connection) cmd (s string))
+  (call-next-method c cmd (make-string-input-stream s)))
+
+(defmethod connection-run ((connection local-connection) shell-cmd input)
+  (multiple-value-bind (output _ exit-code)
+      ;; assumes a POSIX shell (otherwise we could wrap in 'sh -c')
+      (run-program shell-cmd
+		   :force-shell t
+		   :input input
+		   :output :string
+		   :error-output :output
+		   :ignore-error-status t)
+    (declare (ignore _))
+    (values output exit-code)))
 
 (defmethod connection-readfile ((connection local-connection) path)
   (read-file-string path))
diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp
index e56aad4..883757b 100644
--- a/src/connection/shell-wrap.lisp
+++ b/src/connection/shell-wrap.lisp
@@ -22,7 +22,7 @@
 
 (defgeneric connection-shell-wrap (connection cmd))
 
-(defmethod connection-run ((c shell-wrap-connection) cmd &optional input)
+(defmethod connection-run ((c shell-wrap-connection) cmd input)
   (mrun :may-fail :input input (connection-shell-wrap c cmd)))
 
 (defmethod connection-readfile ((c shell-wrap-connection) path)
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 234dac7..95d31fa 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -61,7 +61,12 @@
 				   password)
   (declare (ignore remaining))
   (format t "Establishing sudo connection to ~A~%" user)
-  (make-instance 'sudo-connection :user user :password password))
+  (make-instance 'sudo-connection
+		 :user user
+		 ;; we'll send the password followed by ^M, then the real
+		 ;; stdin.  use CODE-CHAR in this way so that we can be sure
+		 ;; ASCII ^M is what will get emitted.
+		 :password (strcat password (string (code-char 13)))))
 
 (defclass sudo-connection (shell-wrap-connection)
   ((user
@@ -75,33 +80,25 @@
   (format nil "sudo -HkS --prompt=\"\" --user=~A sh -c ~A"
 	  (slot-value connection 'user) (escape-sh-token cmd)))
 
-(defmethod connection-run ((c sudo-connection) cmd &optional input)
-  ;; send the password followed by ^M, then the real stdin.  use CODE-CHAR in
-  ;; this way so that we can be sure ASCII ^M is what will get emitted.
-  (let* ((input-stream
-	   (typecase input
-	     (stream input)
-	     (string (make-string-input-stream input))))
-	 (password (when-let ((password (slot-value c 'password)))
-		     (format nil "~A~A" password (code-char 13))))
-	 (password-stream (and password (make-string-input-stream password)))
-	 (new-input (cond
-		      ((and password input)
-		       (make-concatenated-stream
-			(if (subtypep (stream-element-type input-stream)
-				      'character)
-			    password-stream
-			    (babel-streams:make-in-memory-input-stream
-			     (babel:string-to-octets password :encoding :UTF-8)
-			     :element-type (stream-element-type input-stream)))
-			input-stream))
-		      (password
-		       password-stream)
-		      (input
-		       input-stream)
-		      (t
-		       nil))))
-    (call-next-method c cmd new-input)))
+(defmethod connection-run ((c sudo-connection) cmd (input null))
+  (call-next-method c cmd (slot-value c 'password)))
+
+(defmethod connection-run ((c sudo-connection) cmd (input string))
+  (call-next-method c cmd (strcat (slot-value c 'password) input)))
+
+(defmethod connection-run ((connection sudo-connection) cmd (input stream))
+  (call-next-method connection
+		    cmd
+		    (if-let ((password (slot-value connection 'password)))
+		      (make-concatenated-stream
+		       (if (subtypep (stream-element-type input) 'character)
+			   (make-string-input-stream password)
+			   (babel-streams:make-in-memory-input-stream
+			    (babel:string-to-octets
+			     password :encoding :UTF-8)
+			    :element-type (stream-element-type input)))
+		       input)
+		      input)))
 
 (defmethod connection-upload ((c sudo-connection) from to)
   (connection-run c #?"cp ${from} ${to}" nil))