From d240487a486a3f3dd1905b827716b5b13323ca43 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 6 Mar 2021 15:14:38 -0700 Subject: combine CONNECTION-WRITEFILE implementations for :LOCAL Signed-off-by: Sean Whitton --- src/connection/local.lisp | 36 +++++++++++++----------------------- 1 file changed, 13 insertions(+), 23 deletions(-) (limited to 'src/connection/local.lisp') diff --git a/src/connection/local.lisp b/src/connection/local.lisp index f181922..5a7da2d 100644 --- a/src/connection/local.lisp +++ b/src/connection/local.lisp @@ -44,36 +44,26 @@ root Lisp is running on, as the root Lisp's uid.")) (defmethod connection-readfile ((connection local-connection) path) (read-file-string path)) -;; in the following two functions, we cannot use UIOP:WITH-TEMPORARY-FILE -;; etc., because those do not ensure the file is only readable by us, and we -;; might be writing a secret key - (defmethod connection-writefile ((connection local-connection) path - (content string) + content mode) + ;; we cannot use UIOP:WITH-TEMPORARY-FILE etc., because those do not ensure + ;; the file is only readable by us, and we might be writing a secret key (with-remote-temporary-file (temp :connection connection :directory (pathname-directory-pathname path)) (run-program `("chmod" ,(format nil "~O" mode) ,temp)) - (with-open-file (stream temp :direction :output :if-exists :supersede) - (write-string content stream)) - (run-program `("mv" ,temp ,path)))) - -(defmethod connection-writefile ((connection local-connection) - path - (content stream) - mode - &aux - (type (stream-element-type content))) - (with-remote-temporary-file - (temp :connection connection - :directory (pathname-directory-pathname path)) - (run-program `("chmod" ,(format nil "~O" mode) ,temp)) - (with-open-file (stream temp :direction :output - :if-exists :supersede - :element-type type) - (copy-stream-to-stream content stream :element-type type)) + (etypecase content + (string + (with-open-file (stream temp :direction :output :if-exists :supersede) + (write-string content stream))) + (stream + (let ((type (stream-element-type content))) + (with-open-file (stream temp :direction :output + :if-exists :supersede + :element-type type) + (copy-stream-to-stream content stream :element-type type))))) (run-program `("mv" ,temp ,path)))) (defmethod connection-upload ((connection local-connection) from to) -- cgit v1.2.3