From be461462885b987222eef811fef4cd3551a14527 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 23 Feb 2021 13:40:25 -0700 Subject: attempt to fix streaming data into remote sudo Signed-off-by: Sean Whitton --- src/connection/local.lisp | 39 ++++++++++++++++++++++++++------------- src/connection/sudo.lisp | 17 ++++++++++++----- src/data.lisp | 2 +- 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)) -- cgit v1.2.3