branch: externals/ssh-deploy
commit 810106accb6e68f14044b9b8c7c81366e4bfd58f
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Added feature to diff directories and fixed a bug
---
README.md | 34 +++++--
ssh-deploy.el | 279 ++++++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 254 insertions(+), 59 deletions(-)
diff --git a/README.md b/README.md
index a7ddd2b..e6ee554 100644
--- a/README.md
+++ b/README.md
@@ -6,10 +6,10 @@ The `ssh-deploy` plug-in for Emacs makes it possible to
effortlessly deploy loca
* Define syncing configuration per directory or per file (using
`DirectoryVariables` or `File Variables`)
* Control whether uploads of files should be automatic on save
* Manual downloads and uploads of directories and files
-* Automatic and manual detection of remote changes of files using revisions
+* Automatic and manual detection of remote changes of files using local
revisions
* Launch remote `eshell` terminals in base or relative directory
-* Launch remote `dired-mode` browsing in base or relative directory
-* Launch difference sessions using `ediff-mode`
+* Launch remote `dired` browsing in base or relative directory
+* Launch difference sessions for files and directories using `ediff-mode`
* Supports asynchronous operations if `async.el` is installed. (You need to
setup an automatic authorization for this, i.e. `~/.netrc` or key-based
password-less authorization)
* Supports renaming and deletion of files and directories on local host and
mirrored on remote
@@ -35,6 +35,8 @@ Here is a list of other variables you can set globally or per
directory:
* Download ssh-deploy and place it at `~/.emacs.d/ssh-deploy/` or install via
`package.el` (`M-x list-packages`) from the `MELPA` repository.
* So if you want to deploy `/Users/username/Web/MySite/` to create this
`DirectoryVariables` file in your project root at
`/Users/username/Web/MySite/.dir-locals.el`.
+You really need to research how you connect via different protocols using
TRAMP on your operating system, I think Windows users should use `plink` for
most protocols.
+
### SSH/SFTP
``` emacs-lisp
@@ -45,6 +47,29 @@ Here is a list of other variables you can set globally or
per directory:
)))
```
+NOTE: I'm not sure how to get pure `sftp` working on macOS, but this should
work on other *NIX systems:
+
+``` emacs-lisp
+((nil . (
+ (ssh-deploy-root-local . "/Users/username/Web/MySite/")
+ (ssh-deploy-root-remote . "/sftp:myu...@myserver.com:/var/www/MySite/")
+ (ssh-deploy-on-explicit-save . t)
+)))
+```
+
+You can pipe remote connections as well like this:
+
+``` emacs-lisp
+((nil . (
+ (ssh-deploy-root-local . "/Users/username/Web/MySite/")
+ (ssh-deploy-root-remote .
"/ssh:myu...@myserver.com|sudo:w...@myserver.com:/var/www/MySite/")
+ (ssh-deploy-async . nil)
+ (ssh-deploy-on-explicit-save . t)
+)))
+```
+
+If you have a password-less sudo on your remote host you should be to enable
`async`.
+
### FTP
``` emacs-lisp
@@ -112,7 +137,6 @@ Set your user and group as owner and file permissions to
`600`. Emacs should now
:demand
:bind (("C-c C-z" . hydra-ssh-deploy/body))
:config
- (setq ssh-deploy-debug t)
(add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save
(ssh-deploy-upload-handler)) ))
(add-hook 'find-file-hook (lambda() (if
ssh-deploy-automatically-detect-remote-changes
(ssh-deploy-remote-changes-handler)) ))
(defhydra hydra-ssh-deploy (:color red :hint nil)
@@ -146,7 +170,7 @@ You can remove the `add-to-list` line if you installed via
`MELPA` repository.
## Usage
* Now when you save a file somewhere under the directory
`/Users/username/Web/MySite/`, the script will launch and deploy the file with
the remote server.
-* If you press `C-c C-z x` and the current buffer is a file, you will launch a
`ediff` session showing differences between local file and remote file via
`tramp`, or if current buffer is a directory it will show a error that
directories are not yet supported for differences.
+* If you press `C-c C-z x` and the current buffer is a file, you will launch a
`ediff` session showing differences between local file and remote file via
`tramp`, or if current buffer is a directory it will open a buffer showing
directory differences
* If you press `C-c C-z f` you will **force** upload local file or directory
to remote host even if they have external changes.
* If you press `C-c C-z u` you will upload local file or directory to remote
host.
* If you press `C-c C-z d` you will download the current file or directory
from remote host and then reload current buffer.
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 785ab21..18ede8d 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -1,10 +1,10 @@
-;;; ssh-deploy.el --- Deployment via SSH or FTP, global or per directory.
+;;; ssh-deploy.el --- Deployment via TRAMP, global or per directory.
;; Author: Christian Johansson <github.com/cjohansson>
;; Maintainer: Christian Johansson <github.com/cjohansson>
;; Created: 5 Jul 2016
-;; Modified: 30 Oct 2017
-;; Version: 1.68
+;; Modified: 20 Nov 2017
+;; Version: 1.69
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
@@ -135,7 +135,7 @@
:type 'boolean
:group 'ssh-deploy)
-(defcustom ssh-deploy-exclude-list '("/.git/" ".dir-locals.el")
+(defcustom ssh-deploy-exclude-list '(".git/" ".dir-locals.el")
"List of strings that if found in paths will exclude paths from sync,
'(\"/.git\"/' \".dir-locals.el\") by default."
:type 'list
:group 'ssh-deploy)
@@ -146,6 +146,10 @@
;; these functions are only used internally and should be of no value to
outside public and handler functions.
;; these functions MUST not use module variables.
+(defun ssh-deploy--insert-keyword (text)
+ "Insert TEXT as bold text."
+ (put-text-property 0 (length text) 'face 'font-lock-keyword-face text)
+ (insert text))
(defun ssh-deploy--get-revision-path (path root)
"Generate revision-path for PATH in ROOT."
@@ -198,7 +202,7 @@
(copy-file ,path-local ,revision-path t t t
t)
(list 0 (format "Upload '%s' completed."
,path-remote)))
(list 1 (format "Remote file '%s' has changed,
please download or diff." ,path-remote))))
- (list 1 "Function ediff-same-file-contents is
missing.")))
+ (list 1 "Function 'ediff-same-file-contents' is
missing.")))
(lambda(return)
(if (= (nth 0 return) 0)
(message (nth 1 return))
@@ -213,21 +217,26 @@
(message "Upload '%s' finished." return-path)))))))
(message "async.el is not installed")))
-;; TODO Fix "bug" where this does not detect remote changes
(defun ssh-deploy--upload-via-tramp (path-local path-remote force
revision-folder)
"Upload PATH-LOCAL to PATH-REMOTE via TRAMP synchronously and FORCE despite
remote change compared with copy in REVISION-FOLDER."
- (let ((file-or-directory (file-regular-p path-local)))
+ (let ((file-or-directory (file-regular-p path-local))
+ (revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
(if file-or-directory
(progn
- (if (or (boundp 'force) (not (ssh-deploy--remote-has-changed
path-local path-remote revision-folder)))
- (progn
- (message "Uploading file '%s' to '%s' via TRAMP
synchronously.." path-local path-remote)
- (if (not (file-directory-p (file-name-directory path-remote)))
- (make-directory (file-name-directory path-remote) t))
- (copy-file path-local path-remote t t t t)
- (message "Upload '%s' finished" path-local)
- (ssh-deploy-store-revision path-local revision-folder))
- (display-warning "ssh-deploy" "Remote contents has changed or no
base revision exists, please download or diff." :warning)))
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (if (or (eq t force)
+ (not (file-exists-p path-remote))
+ (and (file-exists-p revision-path)
(ediff-same-file-contents revision-path path-remote)))
+ (progn
+ (message "Uploading file '%s' to '%s' via TRAMP
synchronously.." path-local path-remote)
+ (if (not (file-directory-p (file-name-directory
path-remote)))
+ (make-directory (file-name-directory path-remote) t))
+ (copy-file path-local path-remote t t t t)
+ (message "Upload '%s' completed." path-local)
+ (ssh-deploy-store-revision path-local revision-folder))
+ (display-warning "ssh-deploy" (format "Remote file '%s' has
changed, please download or diff." path-remote) :warning))
+ (display-warning "ssh-deploy" "Function 'ediff-same-file-contents'
is missing." :warning)))
(progn
(message "Uploading directory '%s' to '%s' via TRAMP synchronously.."
path-local path-remote)
(copy-directory path-local path-remote t t t)
@@ -273,24 +282,158 @@
(copy-directory path-remote path-local t t t)
(message "Download '%s' finished." path-local)))))
-(defun ssh-deploy--remote-has-changed (path-local path-remote revision-folder)
- "Synchronously check if last stored revision of PATH-LOCAL exists or has
changed at PATH-REMOTE that is stored in REVISION-FOLDER."
- (let ((revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
- (if (file-exists-p path-remote)
+(defun ssh-deploy--diff-directories-data (directory-a directory-b exclude-list)
+ "Find difference between DIRECTORY-A and DIRECTORY-B but exclude paths
matching EXCLUDE-LIST."
+ ;; (message "Comparing a: %s to b: %s" directory-a directory-b)
+ (require 'subr-x)
+ (if (fboundp 'string-remove-prefix)
+ (let ((files-a (directory-files-recursively directory-a ""))
+ (files-b (directory-files-recursively directory-b ""))
+ (files-a-only (list))
+ (files-b-only (list))
+ (files-both (list))
+ (files-both-equals (list))
+ (files-both-differs (list))
+ (files-a-relative-list (list))
+ (files-b-relative-list (list))
+ (files-a-relative-hash (make-hash-table :test 'equal))
+ (files-b-relative-hash (make-hash-table :test 'equal)))
+
+ ;; Collected included files in directory a with relative paths
+ (mapc
+ (lambda (file-a-tmp)
+ (let ((file-a (file-truename file-a-tmp)))
+ (let ((relative-path (string-remove-prefix directory-a file-a))
+ (included t))
+
+ ;; Check if file is excluded
+ (dolist (element exclude-list)
+ (if (and (not (null element))
+ (not (null (string-match element relative-path))))
+ (setq included nil)))
+
+ (if included
+ (progn
+ (puthash relative-path file-a files-a-relative-hash)
+ (if (equal files-a-relative-list nil)
+ (setq files-a-relative-list (list relative-path))
+ (push relative-path files-a-relative-list)))))))
+ files-a)
+
+ ;; (message "A-hashes:")
+ ;; (maphash (lambda (key value) (message (format "%s:%s" key value)))
files-a-relative-hash)
+
+ ;; Collected included files in directory b with relative paths
+ (mapc
+ (lambda (file-b-tmp)
+ ;; (message "file-b-tmp: %s %s" file-b-tmp (file-truename
file-b-tmp))
+ (let ((file-b (file-truename file-b-tmp)))
+ (let ((relative-path (string-remove-prefix directory-b file-b))
+ (included t))
+
+ ;; Check if file is excluded
+ (dolist (element exclude-list)
+ (if (and (not (null element))
+ (not (null (string-match element relative-path))))
+ (setq included nil)))
+
+ (if included
+ (progn
+ (puthash relative-path file-b files-b-relative-hash)
+ (if (equal files-b-relative-list nil)
+ (setq files-b-relative-list (list relative-path))
+ (push relative-path files-b-relative-list)))))))
+ files-b)
+
+ ;; (message "B-hashes:")
+ ;; (maphash (lambda (key value) (message (format "%s:%s" key value)))
files-b-relative-hash)
+
+ ;; Collect files that only exists in directory a and files that exist
in both directory a and b
+ (mapc
+ (lambda (file-a)
+ (if (not (equal (gethash file-a files-b-relative-hash) nil))
+ (if (equal files-both nil)
+ (setq files-both (list file-a))
+ (push file-a files-both))
+ (if (equal files-a-only nil)
+ (setq files-a-only (list file-a))
+ (push file-a files-a-only))))
+ files-a-relative-list)
+
+ ;; Collect files that only exists in directory b
+ (mapc
+ (lambda (file-b)
+ (if (equal (gethash file-b files-a-relative-hash) nil)
+ (progn
+ ;; (message "%s did not exist in hash-a" file-b)
+ (if (equal files-b-only nil)
+ (setq files-b-only (list file-b))
+ (push file-b files-b-only)))))
+ files-b-relative-list)
+
+ ;; Collect files that differ in contents and have equal contents
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (mapc
+ (lambda (file)
+ (let ((file-a (gethash file files-a-relative-hash))
+ (file-b (gethash file files-b-relative-hash)))
+ (if (ediff-same-file-contents file-a file-b)
+ (if (equal files-both-equals nil)
+ (setq files-both-equals (list file))
+ (push file files-both-equals))
+ (if (equal files-both-differs nil)
+ (setq files-both-differs (list file))
+ (push file files-both-differs)))))
+ files-both))
+
+ (list directory-a directory-b exclude-list files-both files-a-only
files-b-only files-both-equals files-both-differs))
+ (display-warning "ssh-deploy" "Function 'string-remove-prefix' is
missing.")))
+
+;; TODO Make this function interactive
+(defun ssh-deploy--diff-directories-present (diff)
+ "Present difference data for directories from DIFF."
+ (let ((buffer (generate-new-buffer "ssh-deploy diff")))
+ (switch-to-buffer buffer)
+
+ (ssh-deploy--insert-keyword "Directory A: ")
+ (insert (nth 0 diff) "\n")
+
+ (ssh-deploy--insert-keyword "Directory B: ")
+ (insert (nth 1 diff) "\n")
+
+ (if (length (nth 2 diff))
(progn
- (if (file-exists-p revision-path)
- (progn
- (require 'ediff)
- (if (fboundp 'ediff-same-file-contents)
- (progn
- (if (not (ediff-same-file-contents revision-path
path-remote))
- t
- nil))
- (progn
- (message "Function ediff-same-file-contents is missing.")
- nil)))
- t))
- nil)))
+ (insert "\n")
+ (ssh-deploy--insert-keyword (format "Exclude-list (%d)" (length (nth
2 diff))))
+ (dolist (element (nth 2 diff))
+ (insert "\n" element))
+ (insert "\n")))
+
+ (insert "\n")
+
+ (if (length (nth 4 diff))
+ (progn
+ (ssh-deploy--insert-keyword (format "Files only in A (%d)" (length
(nth 4 diff))))
+ (dolist (element (nth 4 diff))
+ (insert "\n" element))
+ (insert "\n\n")))
+
+ (if (length (nth 5 diff))
+ (progn
+ (ssh-deploy--insert-keyword (format "Files only in B (%d)" (length
(nth 5 diff))))
+ (dolist (element (nth 5 diff))
+ (insert "\n" element))
+ (insert "\n\n")))
+
+ (if (length (nth 7 diff))
+ (progn
+ (ssh-deploy--insert-keyword (format "Files in both but differs (%d)"
(length (nth 7 diff))))
+ (dolist (element (nth 7 diff))
+ (insert "\n" element))
+ (insert "\n\n")))
+
+ (read-only-mode)))
;; PUBLIC functions
@@ -300,6 +443,41 @@
;;;### autoload
+(defun ssh-deploy-diff-files (file-a file-b)
+ "Find difference between FILE-A and FILE-B."
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (message "Comparing file '%s' to '%s'.." file-a file-b)
+ (if (ediff-same-file-contents file-a file-b)
+ (message "Files have identical contents.")
+ (ediff file-a file-b)))
+ (display-warning "ssh-deploy" "Function 'ediff-same-file-contents' is
missing." :warning)))
+
+;;;### autoload
+(defun ssh-deploy-diff-directories (directory-a directory-b &optional
exclude-list async)
+ "Find difference between DIRECTORY-A and DIRECTORY-B but exclude paths
matching EXCLUDE-LIST, do it asynchronously is ASYNC is true."
+ (if (not (boundp 'async))
+ (setq async ssh-deploy-async))
+ (if (not (boundp 'exclude-list))
+ (setq exclude-list ssh-deploy-exclude-list))
+ (if (and async (fboundp 'async-start))
+ (let ((script-filename (file-name-directory (symbol-file
'ssh-deploy-diff-directories))))
+ (message "Generating differences between directory '%s' and '%s'
asynchronously from '%s'.." directory-a directory-b script-filename)
+ (async-start
+ `(lambda()
+ (add-to-list 'load-path ,script-filename)
+ (require 'ssh-deploy)
+ (ssh-deploy--diff-directories-data ,directory-a ,directory-b (list
,@exclude-list)))
+ (lambda(diff)
+ (message "Returned from async")
+ (ssh-deploy--diff-directories-present diff))))
+ (progn
+ (message "Generating differences between directory '%s' and '%s'
synchronously.." directory-a directory-b)
+ (let ((diff (ssh-deploy--diff-directories-data directory-a directory-b
exclude-list)))
+ (ssh-deploy--diff-directories-present diff)))))
+
+;;;### autoload
(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote
async revision-folder exclude-list)
"Check if a local revision for PATH-LOCAL on ROOT-LOCAL and if remote file
has changed on ROOT-REMOTE, do it optionally asynchronously if ASYNC is true,
check for copies in REVISION-FOLDER and skip if path is in EXCLUDE-LIST."
(let ((root-local (or root-local ssh-deploy-root-local))
@@ -329,7 +507,7 @@
(copy-file ,path-local
,revision-path t t t t)
(list 0 (format "Remote file
'%s' is identical to local file '%s' but different to local revision. Updated
local revision." ,path-remote ,path-local)))
(list 1 (format "Remote file
'%s' has changed, please download or diff." ,path-remote))))))
- (list 1 "Function ediff-same-file-contents
is missing.")))
+ (list 1 "Function
'ediff-same-file-contents' is missing.")))
(list 0 (format "Remote file '%s' doesn't
exist." ,path-remote))))
(lambda(return)
(if (= (nth 0 return) 0)
@@ -344,7 +522,7 @@
(if (ediff-same-file-contents revision-path
path-remote)
(message "Remote file '%s' has not
changed." path-remote)
(display-warning "ssh-deploy" (format
"Remote file '%s' has changed, please download or diff." path-remote)
:warning)))
- (display-warning "ssh-deploy" "Function
ediff-same-file-contents is missing." :warning)))
+ (display-warning "ssh-deploy" "Function
'ediff-same-file-contents' is missing." :warning)))
(message "Remote file '%s' doesn't exist."
path-remote))))
(if (and async (fboundp 'async-start))
(async-start
@@ -374,7 +552,7 @@
(copy-file path-local revision-path t t t t)
(message "Remote file '%s' has not changed,
created base revision." path-remote))
(display-warning "ssh-deploy" (format "Remote file
'%s' has changed, please download or diff." path-remote) :warning))
- (display-warning "ssh-deploy" "Function
ediff-same-file-contents is missing." :warning)))
+ (display-warning "ssh-deploy" "Function
'ediff-same-file-contents' is missing." :warning)))
(message "Remote file '%s' doesn't exist." path-remote)))
(message "Directory differences not implemented yet"))))))
@@ -451,8 +629,8 @@
(progn
(rename-file old-path-remote new-path-remote t)
(message "Synchronously renamed '%s' to '%s'."
old-path-remote new-path-remote)))))))
- (if debug
- (message "Path '%s' or '%s' is not in the root '%s' or is
excluded from it." old-path-local new-path-local root-local)))))
+ (if debug
+ (message "Path '%s' or '%s' is not in the root '%s' or is excluded
from it." old-path-local new-path-local root-local)))))
;;;### autoload
(defun ssh-deploy-browse-remote (path-local &optional root-local root-remote
exclude-list)
@@ -502,29 +680,22 @@
(copy-file path revision-path t t t t))))
;;;### autoload
-(defun ssh-deploy-diff (path-local path-remote &optional root-local debug
exclude-list)
- "Find differences between PATH-LOCAL and PATH-REMOTE, where PATH-LOCAL is
inside ROOT-LOCAL. DEBUG enables feedback message, check if PATH-LOCAL is not
in EXCLUDE-LIST."
+(defun ssh-deploy-diff (path-local path-remote &optional root-local debug
exclude-list async)
+ "Find differences between PATH-LOCAL and PATH-REMOTE, where PATH-LOCAL is
inside ROOT-LOCAL. DEBUG enables feedback message, check if PATH-LOCAL is not
in EXCLUDE-LIST. ASYNC make the process work asynchronously."
(let ((file-or-directory (file-regular-p path-local))
(exclude-list (or exclude-list ssh-deploy-exclude-list)))
(if (not (boundp 'root-local))
(setq root-local ssh-deploy-root-local))
(if (not (boundp 'debug))
(setq debug ssh-deploy-debug))
+ (if (not (boundp 'async))
+ (setq async ssh-deploy-async))
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
(progn
(if file-or-directory
- (progn
- (require 'ediff)
- (if (fboundp 'ediff-same-file-contents)
- (progn
- (message "Comparing file '%s' to '%s'.." path-local
path-remote)
- (if (ediff-same-file-contents path-local path-remote)
- (message "Files have identical contents.")
- (ediff path-local path-remote)))
- (message "Function ediff-same-file-contents is missing.")))
- (progn
- (message "Unfortunately directory differences are not yet
implemented."))))
+ (ssh-deploy-diff-files path-local path-remote)
+ (ssh-deploy-diff-directories path-local path-remote exclude-list
async)))
(if debug
(message "Path '%s' is not in the root '%s' or is excluded from it."
path-local root-local)))))
@@ -594,7 +765,7 @@
(if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local)
(ssh-deploy--is-not-empty-string ssh-deploy-root-remote)
(ssh-deploy--is-not-empty-string buffer-file-name))
- (ssh-deploy-remote-changes (file-truename buffer-file-name)
(file-truename ssh-deploy-root-local) ssh-deploy-root-remote ssh-deploy-async
ssh-deploy-revision-folder ssh-deploy-exclude-list)))
+ (ssh-deploy-remote-changes (file-truename buffer-file-name)
(file-truename ssh-deploy-root-local) ssh-deploy-root-remote ssh-deploy-async
ssh-deploy-revision-folder ssh-deploy-exclude-list)))
;;;### autoload
(defun ssh-deploy-download-handler ()
@@ -629,13 +800,13 @@
(let* ((path-local (file-truename buffer-file-name))
(root-local (file-truename ssh-deploy-root-local))
(path-remote (concat ssh-deploy-root-remote
(ssh-deploy--get-relative-path root-local path-local))))
- (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list))
+ (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async))
(if (and (ssh-deploy--is-not-empty-string default-directory)
(file-exists-p default-directory))
(let* ((path-local (file-truename default-directory))
(root-local (file-truename ssh-deploy-root-local))
(path-remote (concat ssh-deploy-root-remote
(ssh-deploy--get-relative-path root-local path-local))))
- (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list))))))
+ (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async))))))
;;;### autoload
(defun ssh-deploy-delete-handler ()
