attempt to fix streaming data into remote sudo

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

3 files changed, 39 insertions, 19 deletions

diff --git a/src/connection/local.lisp b/src/connection/local.lisp
index b54fcd6..9fa4338 100644
--- a/src/connection/local.lisp
+++ b/src/connection/local.lisp
@@ -25,23 +25,36 @@
   (: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)
-  ;; assumes a POSIX shell (otherwise we could wrap in 'sh -c')
-  (multiple-value-bind (output _ exit-code)
-      (run-program shell-cmd
-		   :force-shell t
-		   :input (typecase input
-			    (stream input)
-			    (string (make-string-input-stream input))
-			    (t nil))
-		   :output :string
-		   :error-output :output
-		   :ignore-error-status t)
-    (declare (ignore _))
-    (values output exit-code)))
+  ;; 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-readfile ((connection local-connection) path)
   (read-file-string path))
diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp
index 71eecd5..75b7ec8 100644
--- a/src/connection/sudo.lisp
+++ b/src/connection/sudo.lisp
@@ -75,13 +75,20 @@
 	   (typecase input
 	     (stream input)
 	     (string (make-string-input-stream input))))
-	 (password (slot-value c 'password))
-	 (password-stream (and password
-			       (make-string-input-stream
-				(format nil "~A~A" password (code-char 13)))))
+	 (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 password-stream input-stream))
+		       (make-concatenated-stream
+			(case (stream-element-type input-stream)
+			  (character
+			   password-stream)
+			  (t
+			   (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
diff --git a/src/data.lisp b/src/data.lisp
index 48d4142..310ffe0 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -266,7 +266,7 @@ appropriate.  Falls back to CONNECTION-WRITEFILE."
 			(mapcar #'find-class (list *connection* t t))
 			nil))
       (connection-upload *connection* from to)
-      (with-open-file (s from)
+      (with-open-file (s from :element-type '(unsigned-byte 8))
 	(connection-writefile *connection* to s))))
 
 (defmethod connection-upload-data :around ((data data))