diff options
| -rw-r--r-- | src/connection.lisp | 48 | ||||
| -rw-r--r-- | src/connection/local.lisp | 3 | ||||
| -rw-r--r-- | src/connection/shell-wrap.lisp | 18 | ||||
| -rw-r--r-- | src/package.lisp | 1 |
4 files changed, 55 insertions, 15 deletions
diff --git a/src/connection.lisp b/src/connection.lisp index 9c1a291..99d4137 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -106,6 +106,23 @@ error condition just because EXIT is non-zero.")) (let ((*connection* (slot-value connection 'parent))) (call-next-method))) +(defgeneric connection-readfile-and-remove (connection path) + (:documentation "As READFILE and then delete the file. + +For some connection types, when latency is high, combining these two +operations is noticeably faster than doing one after the other. For every use +of RUN we read and delete the file containing the command's stdout, so the +time savings add up.")) + +(defmethod connection-readfile-and-remove + :around ((connection connection) path) + (let ((*connection* (slot-value connection 'parent))) + (call-next-method))) + +(defmethod connection-readfile-and-remove ((connection connection) path) + (prog1 (connection-readfile connection path) + (connection-run connection (strcat "rm " (escape-sh-token path)) nil))) + ;; only functional difference between WRITEFILE and UPLOAD is what args they ;; take: a string vs. a path. for a given connection type, they may have same ;; or different implementations. @@ -430,17 +447,26 @@ Keyword arguments accepted: Returns command's stdout, stderr and exit code, unless :FOR-EXIT, in which case return only the exit code." (%process-run-args - (with-remote-temporary-file (stdout) - (setq cmd (format nil "( ~A ) >~A" cmd stdout)) - (informat 4 "~&RUN ~A" cmd) - (multiple-value-bind (err exit) - (connection-run *connection* cmd input) - (let ((out (readfile stdout))) - (when inform (informat 1 "~& % ~A~%~{ ~A~%~}" cmd (lines out))) - (if (or may-fail (= exit 0)) - (if for-exit exit (values out err exit)) - (error 'run-failed - :cmd cmd :stdout out :stderr err :exit-code exit))))))) + (let ((stdout (mktemp))) + (handler-bind + ((serious-condition + (lambda (c) + (declare (ignore c)) + (connection-run + *connection* + (format nil "rm -f ~A" (escape-sh-token stdout)) + nil)))) + (setq cmd (format nil "( ~A ) >~A" cmd stdout)) + (informat 4 "~&RUN ~A" cmd) + (multiple-value-bind (err exit) + (connection-run *connection* cmd input) + (let ((out (connection-readfile-and-remove *connection* stdout))) + (when inform + (informat 1 "~& % ~A~%~{ ~A~%~}" cmd (lines out))) + (if (or may-fail (= exit 0)) + (if for-exit exit (values out err exit)) + (error 'run-failed + :cmd cmd :stdout out :stderr err :exit-code exit)))))))) (defun mrun (&rest args) "Like RUN but don't separate stdout and stderr (\"m\" for \"merged\"; note diff --git a/src/connection/local.lisp b/src/connection/local.lisp index 4bd272e..6645178 100644 --- a/src/connection/local.lisp +++ b/src/connection/local.lisp @@ -45,6 +45,9 @@ root Lisp is running on, as the root Lisp's uid.")) (defmethod connection-readfile ((connection local-connection) path) (read-file-string path)) +(defmethod connection-readfile-and-remove ((connection local-connection) path) + (prog1 (read-file-string path) (delete-file path))) + (defmethod connection-writefile ((connection local-connection) path content diff --git a/src/connection/shell-wrap.lisp b/src/connection/shell-wrap.lisp index d821f22..ba4312f 100644 --- a/src/connection/shell-wrap.lisp +++ b/src/connection/shell-wrap.lisp @@ -25,11 +25,21 @@ (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) +(defun %readfile (c path &optional delete) (multiple-value-bind (out exit) - (let ((path (escape-sh-token path))) - (connection-run c #?"test -r ${path} && cat ${path}" nil)) - (if (zerop exit) out (error "File ~S not readable" path)))) + (let* ((path (escape-sh-token path)) + (base #?"test -r ${path} && cat ${path}") + (cmd (if delete (strcat base #?"&& rm ${path}") base))) + (connection-run c cmd nil)) + (if (zerop exit) + out + (error "Could not read~:[~; and/or remove~] ~S" delete path)))) + +(defmethod connection-readfile ((c shell-wrap-connection) path) + (%readfile c path)) + +(defmethod connection-readfile-and-remove ((c shell-wrap-connection) path) + (%readfile c path t)) (defmethod connection-writefile ((conn shell-wrap-connection) path diff --git a/src/package.lisp b/src/package.lisp index 6c4e81b..e1699bb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -134,6 +134,7 @@ #:lisp-connection-p #:connection-run #:connection-readfile + #:connection-readfile-and-remove #:connection-writefile #:connection-teardown #:connection-connattr |