[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ssh-deploy 14e7700 043/173: Now uses asynchrous tranfer
From: |
Stefan Monnier |
Subject: |
[elpa] externals/ssh-deploy 14e7700 043/173: Now uses asynchrous tranfers progressively |
Date: |
Sat, 20 Oct 2018 10:36:27 -0400 (EDT) |
branch: externals/ssh-deploy
commit 14e77005b9539ae0ac85014b7794cbe37a494b5c
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>
Now uses asynchrous tranfers progressively
---
README.md | 17 +++---
ssh-deploy.el | 167 ++++++++++++++++++++++++++++++++++++++--------------------
2 files changed, 119 insertions(+), 65 deletions(-)
diff --git a/README.md b/README.md
index 671687f..6a2535c 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
# `emacs-ssh-deploy`
-The `ssh-deploy` plug-in makes it possible to effortlessly deploy local files
and directories to remote hosts via SSH and FTP. It also makes it possible to
define remote paths per directory and whether or not you want to deploy on
explicit save actions or not. Also it enables manual upload and download of
files and directories. You can also check differences between local files and
directories and remote files and directories if you have `tramp`,`ediff` and
`ztree` installed. You can als [...]
+The `ssh-deploy` plug-in makes it possible to effortlessly deploy local files
and directories to remote hosts via SSH and FTP. It also makes it possible to
define remote paths per directory and whether or not you want to deploy on
explicit save actions or not. Also it enables manual upload and download of
files and directories. You can also check differences between local files and
directories and remote files and directories if you have `tramp`,`ediff` and
`ztree` installed. You can als [...]
`ssh-deploy` works with `DirectoryVariables` so you can have different deploy
setups in different ways for different folders.
@@ -17,21 +17,21 @@ This application is made by Christian Johansson
<address@hidden> 2016 and is l
``` emacs-lisp
((nil . (
-(ssh-deploy-root-local . "/Users/username/Web/MySite/")
-(ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/MySite/")
-(ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-root-local . "/Users/username/Web/MySite/")
+ (ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/MySite/")
+ (ssh-deploy-on-explicit-save . t)
)))
```
For automatic SSH connections you need to setup password-less public-key
authorization or equivalent.
-Or for FTP use this
+Or for FTP use this:
``` emacs-lisp
((nil . (
-(ssh-deploy-root-local . "/Users/username/Web/MySite/")
-(ssh-deploy-root-remote . "/ftp:address@hidden:/MySite/")
-(ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-root-local . "/Users/username/Web/MySite/")
+ (ssh-deploy-root-remote . "/ftp:address@hidden:/MySite/")
+ (ssh-deploy-on-explicit-save . t)
)))
```
@@ -93,3 +93,4 @@ Host remote-host
* <http://melpa.org/>
* <https://github.com/fourier/ztree>
* <https://github.com/randymorris/tramp-term.el>
+* <https://github.com/jwiegley/emacs-async>
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 6e53342..7d44d33 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -31,20 +31,19 @@
;; `ssh-deploy' enables automatic deploys on explicit-save, manual uploads,
;; downloads, differences, remote terminals (optional) and remote directory
browsing via TRAMP.
-;; To do this it uses `tramp', `tramp-term', `ediff' and `ztree'.
+;; To do this it progressively uses `tramp', `tramp-term', `ediff', `async`
and `ztree'.
;; By setting the variables (globally or per directory):
-;; `ssh-deploy-root-local',`ssh-deploy-root-remote',
-;; `ssh-deploy-on-explicit-save' you can setup a directory for
-;; SSH or FTP deployment.
+;; `ssh-deploy-root-local',`ssh-deploy-root-remote',
`ssh-deploy-on-explicit-save'
+;; you can setup a directory for SSH or FTP deployment.
;;
-;; Since transfers are done asynchrously, you need to setup ~/.netrc or
equivalent for automatic transfers.
+;; For asynchrous transfers you need to setup ~/.netrc or equivalent for
automatic authentifications.
;;
;; Example contents of ~/.netrc:
;; machine myserver.com login myuser port ftp password mypassword
;;
;; Set permissions to this file to 700 with you as the owner.
;;
-;; - To setup a hook on explicit save do this:
+;; - To setup a upload hook on save do this:
;; (add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save
(ssh-deploy-upload-handler)) ))
;;
;; - To set key-bindings do something like this:
@@ -54,18 +53,18 @@
;; (global-set-key (kbd "C-c C-z t") (lambda()
(interactive)(ssh-deploy-remote-terminal-handler) ))
;; (global-set-key (kbd "C-c C-z b") (lambda()
(interactive)(ssh-deploy-browse-remote-handler) ))
;;
-;; An illustrative example for SSH, /Users/Chris/Web/Site1/.dir.locals.el
+;; An illustrative example for SSH deployment,
/Users/Chris/Web/Site1/.dir.locals.el
;; ((nil . (
;; (ssh-deploy-root-local . "/Users/Chris/Web/Site1/")
;; (ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/site1/")
;; (ssh-deploy-on-explicity-save . t)
;; )))
;;
-;; An example for FTP, /Users/Chris/Web/Site2/.dir.locals.el:
+;; An example for FTP deployment, /Users/Chris/Web/Site2/.dir.locals.el:
;; ((nil . (
-;; (ssh-deploy-root-local . "/Users/Chris/Web/Site2/")
-;; (ssh-deploy-root-remote . "/ftp:address@hidden:/site2/")
-;; (ssh-deploy-on-explicit-save . nil)
+;; (ssh-deploy-root-local . "/Users/Chris/Web/Site2/")
+;; (ssh-deploy-root-remote . "/ftp:address@hidden:/site2/")
+;; (ssh-deploy-on-explicit-save . nil)
;; )))
;;
;; Now when you are in a directory which is deployed via SSH or FTP you can
access these features.
@@ -99,6 +98,11 @@
:type 'boolean
:group 'ssh-deploy)
+(defcustom ssh-deploy-async t
+ "Boolean variable if asynchrous method for transfers should be used, t by
default."
+ :type 'boolean
+ :group 'ssh-deploy)
+
(defun ssh-deploy--browse-remote (local-root remote-root-string path)
"Browse relative to LOCAL-ROOT on REMOTE-ROOT-STRING the path PATH in
`dired-mode`."
(if (ssh-deploy--file-is-in-path path local-root)
@@ -109,22 +113,37 @@
(dired command))))))
(defun ssh-deploy--remote-terminal (remote-host-string)
- "Opens REMOTE-HOST-STRING in tramp terminal."
+ "Opens REMOTE-HOST-STRING in terminal."
+ (let ((remote-root (ssh-deploy--parse-remote remote-host-string)))
+ (if (string= (alist-get 'protocol remote-root) "ssh")
+ (if (and (fboundp 'tramp-term)
+ (fboundp 'tramp-term--initialize)
+ (fboundp 'tramp-term--do-ssh-login))
+ (progn
+ (let ((hostname (concat (alist-get 'username remote-root) "@"
(alist-get 'server remote-root))))
+ (let ((host (split-string hostname "@")))
+ (message "Opening tramp-terminal for remote host
'address@hidden' and '%s'.." (car host) (car (last host)) hostname)
+ (unless (eql (catch 'tramp-term--abort
(tramp-term--do-ssh-login host)) 'tramp-term--abort)
+ (tramp-term--initialize hostname)
+ (run-hook-with-args 'tramp-term-after-initialized-hook
hostname)
+ (message "tramp-term initialized")))))
+ (message "tramp-term is not installed."))
+ (if (string= (alist-get 'protocol remote-root) "ftp")
+ (ssh-deploy-browse-remote-handler)))))
+
+(defun ssh-deploy--remote-terminal-ssh (remote-root)
+ "Opens REMOTE-ROOT in tramp terminal."
(if (and (fboundp 'tramp-term)
(fboundp 'tramp-term--initialize)
(fboundp 'tramp-term--do-ssh-login))
(progn
- (let ((remote-root (ssh-deploy--parse-remote remote-host-string)))
- (if (string= (alist-get 'protocol remote-root) "ssh")
- (progn
- (let ((hostname (concat (alist-get 'username remote-root) "@"
(alist-get 'server remote-root))))
- (let ((host (split-string hostname "@")))
- (message "Opening tramp-terminal for remote host
'address@hidden' and '%s'.." (car host) (car (last host)) hostname)
- (unless (eql (catch 'tramp-term--abort
(tramp-term--do-ssh-login host)) 'tramp-term--abort)
- (tramp-term--initialize hostname)
- (run-hook-with-args 'tramp-term-after-initialized-hook
hostname)
- (message "tramp-term initialized")))))
- (message "Terminal is only available for the SSH protocol."))))
+ (let ((hostname (concat (alist-get 'username remote-root) "@"
(alist-get 'server remote-root))))
+ (let ((host (split-string hostname "@")))
+ (message "Opening tramp-terminal for remote host 'address@hidden'
and '%s'.." (car host) (car (last host)) hostname)
+ (unless (eql (catch 'tramp-term--abort (tramp-term--do-ssh-login
host)) 'tramp-term--abort)
+ (tramp-term--initialize hostname)
+ (run-hook-with-args 'tramp-term-after-initialized-hook hostname)
+ (message "tramp-term initialized")))))
(message "tramp-term is not installed.")))
(defun ssh-deploy--file-is-in-path (file path)
@@ -196,59 +215,93 @@
(defun ssh-deploy--download (remote local local-root)
"Download REMOTE to LOCAL with the LOCAL-ROOT via tramp."
- (ssh-deploy--download-via-tramp remote local local-root))
+ (if (and ssh-deploy-async (fboundp 'async-start))
+ (ssh-deploy--download-via-tramp-async remote local local-root)
+ (ssh-deploy--download-via-tramp remote local local-root)))
-(defun ssh-deploy--upload-via-tramp (local remote local-root)
- "Upload LOCAL path to REMOTE and LOCAL-ROOT via tramp."
+(defun ssh-deploy--upload-via-tramp-async (local remote local-root)
+ "Upload LOCAL path to REMOTE and LOCAL-ROOT via tramp asynchrously."
(if (fboundp 'async-start)
- (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
- (file-or-directory (file-regular-p local)))
- (if file-or-directory
+ (progn
+ (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
+ (file-or-directory (file-regular-p local)))
+ (if file-or-directory
+ (progn
+ (message "Uploading file '%s' to '%s' via tramp
asynchrously.." local remote-path)
+ (async-start
+ `(lambda()
+ (copy-file ,local ,remote-path t t)
+ ,local)
+ (lambda(return-path)
+ (message "Upload '%s' finished" return-path))))
(progn
- (message "Uploading file '%s' to '%s' via TRAMP.." local
remote-path)
+ (message "Uploading directory '%s' to '%s' via tramp
asynchrously.." local remote-path)
(async-start
`(lambda()
- (copy-file ,local ,remote-path t t)
+ (copy-directory ,local ,(file-name-directory
(directory-file-name remote-path)) t t)
,local)
(lambda(return-path)
- (message "Upload '%s' finished" return-path))))
- (progn
- (message "Uploading directory '%s' to '%s' via TRAMP.." local
remote-path)
- (async-start
- `(lambda()
- (copy-directory ,local ,(file-name-directory
(directory-file-name remote-path)) t t)
- ,local)
- (lambda(return-path)
- (message "Upload '%s' finished" return-path))))))
+ (message "Upload '%s' finished" return-path)))))))
(message "async.el is not installed")))
-(defun ssh-deploy--download-via-tramp (remote local local-root)
- "Download REMOTE path to LOCAL and LOCAL-ROOT via tramp."
+(defun ssh-deploy--upload-via-tramp (local remote local-root)
+ "Upload LOCAL path to REMOTE and LOCAL-ROOT via tramp synchrously."
+ (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
+ (file-or-directory (file-regular-p local)))
+ (if file-or-directory
+ (progn
+ (message "Uploading file '%s' to '%s' via tramp synchrously.." local
remote-path)
+ (copy-file local remote-path t t)
+ (message "Upload '%s' finished" local))
+ (progn
+ (message "Uploading directory '%s' to '%s' via tramp synchrously.."
local remote-path)
+ (copy-directory local (file-name-directory (directory-file-name
remote-path)) t t)
+ (message "Upload '%s' finished" local)))))
+
+(defun ssh-deploy--download-via-tramp-async (remote local local-root)
+ "Download REMOTE path to LOCAL and LOCAL-ROOT via tramp asynchrously."
(if (fboundp 'async-start)
- (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
- (file-or-directory (file-regular-p local)))
- (if file-or-directory
+ (progn
+ (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
+ (file-or-directory (file-regular-p local)))
+ (if file-or-directory
+ (progn
+ (message "Downloading file '%s' to '%s' via tramp
asynchrously.." remote-path local)
+ (async-start
+ `(lambda()
+ (copy-file ,remote-path ,local t t)
+ ,local)
+ (lambda(return-path)
+ (message "Download '%s' finished" return-path))))
(progn
- (message "Downloading file '%s' to '%s' via TRAMP.." remote-path
local)
+ (message "Downloading directory '%s' to '%s' via tramp
asynchrously.." remote-path local)
(async-start
`(lambda()
- (copy-file ,remote-path ,local t t)
+ (copy-directory ,remote-path ,(file-name-directory
(directory-file-name local)) t t)
,local)
(lambda(return-path)
- (message "Download '%s' finished" return-path))))
- (progn
- (message "Downloading directory '%s' to '%s' via TRAMP.."
remote-path local)
- (async-start
- `(lambda()
- (copy-directory ,remote-path ,(file-name-directory
(directory-file-name local)) t t)
- ,local)
- (lambda(return-path)
- (message "Download '%s' finished" return-path))))))
+ (message "Download '%s' finished" return-path)))))))
(message "async.el is not installed")))
+(defun ssh-deploy--download-via-tramp (remote local local-root)
+ "Download REMOTE path to LOCAL and LOCAL-ROOT via tramp synchrously."
+ (let ((remote-path (concat "/" (alist-get 'protocol remote) ":"
(shell-quote-argument (alist-get 'username remote)) "@" (shell-quote-argument
(alist-get 'server remote)) ":" (shell-quote-argument (alist-get 'path
remote))))
+ (file-or-directory (file-regular-p local)))
+ (if file-or-directory
+ (progn
+ (message "Downloading file '%s' to '%s' via tramp synchrously.."
remote-path local)
+ (copy-file remote-path local t t)
+ (message "Download '%s' finished" local))
+ (progn
+ (message "Downloading directory '%s' to '%s' via tramp synchrously.."
remote-path local)
+ (copy-directory remote-path (file-name-directory (directory-file-name
local)) t t)
+ (message "Download '%s' finished" local)))))
+
(defun ssh-deploy--upload (local remote local-root)
"Upload LOCAL to REMOTE and LOCAL-ROOT via tramp."
- (ssh-deploy--upload-via-tramp local remote local-root))
+ (if (and ssh-deploy-async (fboundp 'async-start))
+ (ssh-deploy--upload-via-tramp-async local remote local-root)
+ (ssh-deploy--upload-via-tramp local remote local-root)))
(defun ssh-deploy (local-root remote-root upload-or-download path)
"Upload/Download file or directory relative to the roots LOCAL-ROOT with
REMOTE-ROOT via ssh or ftp according to UPLOAD-OR-DOWNLOAD and the path PATH."
- [elpa] externals/ssh-deploy e94c9e7 035/173: Updated title of README.md, (continued)
- [elpa] externals/ssh-deploy e94c9e7 035/173: Updated title of README.md, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 959aa79 036/173: Fixed a log message., Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy f0eb826 030/173: Fixed a bug in protocol definition and started with support for multiple protocols., Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 4e70a41 041/173: Now uses TRAMP via async.el for SSH transfers, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 8253251 044/173: Improved README a bit, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 94fc9e6 051/173: Updated readme, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 56da852 066/173: Fixed bug where plug-in reported external changes even though remote, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy a627c90 057/173: Updated readme, spelling and grammar fixes, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 0e32ab3 056/173: Added support for detection of external changes in FTP and improved async signals, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 109dbb1 034/173: FTP support and refactoring completed, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 14e7700 043/173: Now uses asynchrous tranfers progressively,
Stefan Monnier <=
- [elpa] externals/ssh-deploy 97d803d 004/173: Updated comments and changed license in preparation for MELPA submission., Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy de8eadd 067/173: Remote path is not shell escaped on upload and download because it, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 6d1c10c 069/173: Improved documentation, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy ec46610 075/173: Fixed a typo and improved documentation, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy c8b322a 074/173: Fixed markdown syntax, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 5e86b22 072/173: Bug fix for automatically creating missing remote directories on upload, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 4fbe568 084/173: Updated hydra example to prevent lazy loading of package, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 4c35ab7 055/173: Fixed syntax bug in MELPA description, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy d324b9f 046/173: Cleaned up code structure and isolated functions, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 404aa7e 042/173: Transfers now use TRAMP asynchrously, Stefan Monnier, 2018/10/20