branch: elpa/dirvish commit 2eb0118681dd65836bfa7e3442f5ed152615b533 Author: Alex Lu <hellosimon1...@hotmail.com> Commit: Alex Lu <hellosimon1...@hotmail.com>
refactor(rsync): extract rsync code to `dirvish-rsync.el` --- dirvish.el | 1 + docs/EXTENSIONS.org | 14 +- extensions/dirvish-rsync.el | 379 ++++++++++++++++++++++++++++++++++++++++ extensions/dirvish-yank.el | 410 ++++---------------------------------------- 4 files changed, 429 insertions(+), 375 deletions(-) diff --git a/dirvish.el b/dirvish.el index a23c17a67a..121e1397f7 100644 --- a/dirvish.el +++ b/dirvish.el @@ -23,6 +23,7 @@ (require 'dired) (require 'transient) +(eval-when-compile (require 'subr-x)) (declare-function ansi-color-apply-on-region "ansi-color") (declare-function dirvish-fd-find "dirvish-fd") (declare-function dirvish-tramp-noselect "dirvish-tramp") diff --git a/docs/EXTENSIONS.org b/docs/EXTENSIONS.org index 8e53efc111..6bcef682cf 100644 --- a/docs/EXTENSIONS.org +++ b/docs/EXTENSIONS.org @@ -44,6 +44,14 @@ B, and paste them with ~dirvish-yank/move/symlink/hardlink~. See also: [[https://github.com/alexluigit/dirvish/blob/main/docs/FAQ.org#dired-ranger][comparison with dired-ranger]] +* Integration with *rsync* command (dirvish-rsync.el) + +This extension introduces =dirvish-rsync=, which requires [[https://github.com/RsyncProject/rsync][rsync]] executable, +mirroring the functionality of Alex Bennée's =dired-rsync=. Uniquely, +=dirvish-rsync= gathers marked files from multiple Dired buffers. It also +provides a transient menu =dirvish-rsync-menu=, for temporary adjustments to +=dirvish-rsync-args=. + * Group files with custom filter stack (dirvish-emerge.el) This extension lets you split the file list into different groups by various @@ -87,7 +95,7 @@ of the peek window. ~dirvish-peek-mode~ currently supports =vertico=, =selectrum=, =ivy= and =icomplete[-vertical]=. -* Version-control (git) integration (dirvish-vc.el) +* Version-control (*git*) integration (dirvish-vc.el) This extension gives Dirvish the ablity to display version-control data in different ways. For now we have: @@ -149,7 +157,7 @@ breeze. No manual editing anymore! *Figure 3*. left: ~dirvish-quicksort~ right: ~dirvish-ls-switches-menu~ -* Dirvish as the interface of fd (dirvish-fd.el) +* Dirvish as the interface of *fd* command (dirvish-fd.el) This is the BEST =fd= frontend, period. @@ -188,7 +196,7 @@ You can use ~dirvish-subtree-toggle~ to toggle the directory under the cursor as subtree. Add ~subtree-state~ to ~dirvish-attributes~ gives you an indicator about whether the directory is expanded or not. -* History navigation commands (dirvish-history.el) +* History navigation (dirvish-history.el) |-----------------------------+---------------------------------------| | Command | Description | diff --git a/extensions/dirvish-rsync.el b/extensions/dirvish-rsync.el new file mode 100644 index 0000000000..8b54a92060 --- /dev/null +++ b/extensions/dirvish-rsync.el @@ -0,0 +1,379 @@ +;;; dirvish-rsync.el --- Rsync integration for Dirvish -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2025 Alex Lu +;; Author : Alex Lu <https://github.com/alexluigit> +;; Version: 2.0.53 +;; Keywords: files, convenience +;; Homepage: https://github.com/alexluigit/dirvish +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; This extension introduces `dirvish-rsync' command (which requires `rsync' +;; executable), mirroring the functionality of Alex Bennée's `dired-rsync'. +;; Uniquely, `dirvish-rsync' gathers marked files from multiple Dired buffers. +;; It also provides a transient menu `dirvish-rsync-menu', for temporary +;; adjustments to `dirvish-rsync-args'. + +;;; Code: + +(require 'dirvish-yank) +(require 'tramp) + +(define-obsolete-variable-alias 'dirvish-yank-rsync-program 'dirvish-rsync-program "Fed 9, 2025") +(defcustom dirvish-rsync-program "rsync" + "The rsync binary that we are going to use." + :type 'string :group 'dirvish) + +(define-obsolete-variable-alias 'dirvish-yank-rsync-args 'dirvish-rsync-args "Fed 9, 2025") +(defcustom dirvish-rsync-args + '("--archive" "--verbose" "--compress" "--info=progress2") + "The default options for the rsync command." + :type '(repeat string) :group 'dirvish) + +(defcustom dirvish-rsync-r2r-ssh-port "22" + "Default ssh port of receiver when yanking in remote to remote scenario. +In this scenario rsync will be run on remote host, so it has no access +to your ~/.ssh/config file. If you have some settings there you have to +specify them somehow. One way is to set global default values and other +way is to set them locally before copying, using rsync-transient menu." + :type 'string :group 'dirvish) + +(defcustom dirvish-rsync-r2r-ssh-user nil + "Default ssh user of receiver when yanking in remote to remote scenario. +When it is nil, do not specify any user. See +`dirvish-rsync-r2r-ssh-port' for more details." + :type '(choice string (const nil)) :group 'dirvish) + +(defcustom dirvish-rsync-r2r-use-direct-connection nil + "When t, copy data directly from host1 to host2. +If this is not possible, for example when host2 is not reacheable from +host1 set this option to nil. When it is nil the tunnel will be created +between host1 and host2, using running machine as proxy. For both cases +make sure that you have passwordless access to both hosts and that +ssh-agent is properly set-up. For checking that, everything works try +to execute a command \"ssh -A host1 ssh -o StrictHostKeyChecking=no +host2 hostname\". Also make sure that ssh-agent Environment variables +are propagated to Emacs." + :type 'boolean :group 'dirvish) + +(defcustom dirvish-rsync-shortcut-key-for-yank-menu "R" + "A shortcut key added to `dirvish-yank-menu'." + :type 'string :group 'dirvish) + +(defcustom dirvish-rsync-use-yank-menu t + "When t, append a shortcut to invoke `dirvish-rsync' in `dirvish-yank-menu'. +The shortcut key is denoted by `dirvish-rsync-shortcut-key-for-yank-menu'." + :type 'boolean :group 'dirvish + :set (lambda (k v) + (set k v) + (if v (dirvish-yank--menu-setter + nil (append dirvish-yank-keys + `((,dirvish-rsync-shortcut-key-for-yank-menu + "Rsync here" dirvish-rsync)))) + (dirvish-yank--menu-setter nil dirvish-yank-keys)))) + +(defvar dirvish-rsync--remote-ssh-args + "-o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null" + "These args will be used for invoking ssh on remote host (in r2r case).") +(defvar dirvish-rsync--transient-input-history nil + "History list of rsync transient input in the minibuffer.") +(defvar crm-separator) + +(defvar-local dirvish-rsync--r2r-direct-conn nil + "Local value for enabling direct copy in r2r case.") +(defvar-local dirvish-rsync--r2r-ssh-recv-host nil + "Local value of r2r receiver host.") +(defvar-local dirvish-rsync--r2r-ssh-recv-port nil + "Local value of r2r receiver port.") +(defvar-local dirvish-rsync--r2r-ssh-recv-user nil + "Local value of r2r receiver user.") + +(defun dirvish-rsync--get-remote-host () + "Return the remote port we shall use for the reverse port-forward." + (+ 50000 (length dirvish-yank-log-buffers))) + +(defun dirvish-rsync--filename (file) + "Reformat a tramp FILE to one usable for rsync." + (if (tramp-tramp-file-p file) + (with-parsed-tramp-file-name file tfop + (format "%s%s:%s" (if tfop-user (format "%s@" tfop-user) "") tfop-host + (shell-quote-argument tfop-localname))) + (shell-quote-argument file))) + +(defun dirvish-rsync--compose-command () + "Compose rsync command and args into the string. +Retrieve rsync args from current session or `dirvish-rsync-args'." + (format "%s %s" + dirvish-rsync-program + (string-join + (or (dirvish-prop :rsync-switches) dirvish-rsync-args) " "))) + +(defun dirvish-rsync--local-ssh-args (host-info) + "Compose ssh args used for sshing to source host. +HOST-INFO is a list of host/user/port parsed from the tramp string." + (let* ((port (cl-third host-info)) + (port-str (if port (concat "-p" port) "")) + (user (cl-second host-info)) + (user-str (if user (concat user "@") ""))) + (concat port-str " " user-str (cl-first host-info)))) + +(defun dirvish-rsync--r2r-escape-single-quote (str) + "Properly escape all single quotes in STR. +STR should be processed by `shell-quote-argument' already. Single +quotes require special care since we wrap remote command with them. +Bash doesn't allow nesting of single quotes (even escaped ones), so we +need to turn string into multiple concatenated strings." + ;; use string-replace from emacs-28.1 when support of older versions is dropped + (replace-regexp-in-string "'" "'\"'\"'" str t t)) + +;; Thanks to `dired-rsync.el' +;; also see: https://unix.stackexchange.com/questions/183504/how-to-rsync-files-between-two-remotes +(defun dirvish-rsync--r2r-handler (srcs shost-info dhost-info) + "Construct and trigger an rsync run for remote copy. +This command sync SRCS on SHOST to DEST on DHOST. SHOST-INFO and +DHOST-INFO are lists containing host,user,port,localname extracted from +the tramp string." + (let* ((srcs (mapcar (lambda (x) + (thread-last x file-local-name shell-quote-argument + dirvish-rsync--r2r-escape-single-quote)) + srcs)) + (src-str (string-join srcs " ")) + (shost (cl-first shost-info)) + (dhost (cl-first dhost-info)) + (dhost-real (or dirvish-rsync--r2r-ssh-recv-host + (cl-first dhost-info))) + (duser (or dirvish-rsync--r2r-ssh-recv-user + (cl-second dhost-info) + dirvish-rsync-r2r-ssh-user)) + (dport (or dirvish-rsync--r2r-ssh-recv-port + (cl-third dhost-info) + dirvish-rsync-r2r-ssh-port)) + (dest (thread-last (cl-fourth dhost-info) + shell-quote-argument + dirvish-rsync--r2r-escape-single-quote)) + ;; 1. dhost == shost + ;; ssh [-p dport] [duser@]dhost 'rsync <rsync-args> <srcs> <dest>' + ;; 2. dhost != shost and `dirvish-rsync-r2r-use-direct-connection' == t + ;; ssh -A [-p sport] [suser@]shost 'rsync <rsync-args> -e "ssh <ssh-remote-opts> [-p dport]" <srcs> [duser@]dhost:<dest> ' + ;; 3. dhost != shost and `dirvish-rsync-r2r-use-direct-connection' == nil + ;; ssh -A -R <bind-addr> [-p sport] [suser@]shost 'rsync <rsync-args> -e "ssh <ssh-remote-opts> -p <tunnel_port>" <srcs> [duser@]localhost:<dest>' + (cmd (cond ((equal shost dhost) + (string-join + (list "ssh" + (dirvish-rsync--local-ssh-args dhost-info) + "'" + (dirvish-rsync--compose-command) + src-str dest "'") + " ")) + ((if dirvish-rsync--r2r-direct-conn + (equal dirvish-rsync--r2r-direct-conn "yes") + dirvish-rsync-r2r-use-direct-connection) + (string-join + (list "ssh -A " + (dirvish-rsync--local-ssh-args shost-info) + " '" (dirvish-rsync--compose-command) + (format " -e \"ssh %s %s\" " + (if dport (concat "-p" dport) "") + dirvish-rsync--remote-ssh-args) + src-str " " + (if duser + (format "%s@%s" duser dhost-real) + dhost-real) + ":" dest "'"))) + (t (let* ((port (dirvish-rsync--get-remote-host)) + (bind-addr (format "localhost:%d:%s:%s" + port dhost-real dport))) + (string-join + (list "ssh -A -R " bind-addr " " + (dirvish-rsync--local-ssh-args shost-info) + " '" (dirvish-rsync--compose-command) + (format " -e \"ssh -p %s %s\" " + port dirvish-rsync--remote-ssh-args) + src-str + " " + (if duser + (format "%s@localhost" duser) + "localhost") + ":" dest "'"))))))) + (dirvish-yank--execute cmd (list (current-buffer) srcs dest 'rsync)))) + +(defun dirvish-rsync--l2fr-handler (srcs dest) + "Execute a local to/from remote rsync command for SRCS and DEST." + (let* ((srcs (mapcar #'dirvish-rsync--filename srcs)) + (dest (dirvish-rsync--filename dest)) + (rsync-cmd (flatten-tree (list (dirvish-rsync--compose-command) + srcs dest))) + (cmd (string-join rsync-cmd " "))) + (dirvish-yank--execute cmd (list (current-buffer) srcs dest 'rsync)))) + +;; copied from `dired-rsync' +(defun dirvish-rsync--extract-host-from-tramp (file-or-path) + "Extract the tramp host part of FILE-OR-PATH. +Returns list that contains (host user port localname)." + (with-parsed-tramp-file-name file-or-path tfop + (when tfop-hop + (user-error "DIRVISH[rsync]: Paths with hop are not supported!")) + (list tfop-host tfop-user tfop-port tfop-localname))) + +(defun dirvish-rsync--extract-remote (files) + "Get string identifying the remote connection of FILES." + (cl-loop with hosts = () for f in files for h = (file-remote-p f) + do (cl-pushnew h hosts :test #'equal) + when (> (length hosts) 1) + do (user-error "DIRVISH[rsync]: SOURCEs need to be in the same host") + finally return (car hosts))) + +;;;###autoload +(defun dirvish-rsync (dest) + "Rsync marked files to DEST, prompt for DEST if not called with. +If either the sources or the DEST is located in a remote host, the +`dirvish-rsync-program' and `dirvish-rsync-args' are used to transfer +the files. + +This command requires proper ssh authentication setup to work correctly +for file transfer involving remote hosts, because rsync command is +always run locally, the password prompts may lead to unexpected errors." + (interactive (dirvish-yank--read-dest 'rsync)) + (setq dest (expand-file-name (or dest (dired-current-directory)))) + (let* ((dvec (and (tramp-tramp-file-p dest) (tramp-dissect-file-name dest))) + (srcs (or (and (functionp dirvish-yank-sources) + (funcall dirvish-yank-sources)) + (dirvish-yank--get-srcs dirvish-yank-sources) + (user-error "DIRVISH[rsync]: no marked files"))) + (src-0 (prog1 (car srcs) (dirvish-rsync--extract-remote srcs))) + (svec (and (tramp-tramp-file-p src-0) (tramp-dissect-file-name src-0)))) + (cond + ;; shost and dhost are different remote hosts + ((and svec dvec (not (tramp-local-host-p svec)) + (not (tramp-local-host-p dvec))) + (dirvish-rsync--r2r-handler + srcs (dirvish-rsync--extract-host-from-tramp src-0) + (dirvish-rsync--extract-host-from-tramp dest))) + ;; either shost, dhost or both are localhost + (t (dirvish-rsync--l2fr-handler srcs dest))))) + +(defun dirvish-rsync--transient-init-rsync-switches (obj) + "Select initial values for transient suffixes, possibly from OBJ. +Use values from the local session or Emacs session or saved transient +values." + (or (dirvish-prop :rsync-switches) + ;; don't touch if it is alreday set + (if (and (slot-boundp obj 'value) (oref obj value)) + (oref obj value) + ;; check saved values + (if-let* ((saved (assq (oref obj command) transient-values))) + (cdr saved) + ;; use default value at last resort + dirvish-rsync-args)))) + +(transient-define-infix dirvish-rsync--r2r-ssh-host () + "Set ssh host of receiver in remote to remote case." + :description "Ssh host of receiver" + :class 'transient-lisp-variable + :variable 'dirvish-rsync--r2r-ssh-recv-host + :reader (lambda (_prompt _init _hist) + (completing-read + "Ssh receiver host: " + nil nil nil dirvish-rsync--transient-input-history))) + +(transient-define-infix dirvish-rsync--r2r-ssh-port () + "Set ssh port of receiver in remote to remote case." + :description "Ssh port of receiver" + :class 'transient-lisp-variable + :variable 'dirvish-rsync--r2r-ssh-recv-port + :reader (lambda (_prompt _init _hist) + (completing-read + "Ssh receiver port: " + nil nil nil dirvish-rsync--transient-input-history))) + +(transient-define-infix dirvish-rsync--r2r-ssh-user () + "Set ssh user of receiver in remote to remote case." + :description "Ssh user of receiver" + :class 'transient-lisp-variable + :variable 'dirvish-rsync--r2r-ssh-recv-user + :reader (lambda (_prompt _init _hist) + (completing-read + "Ssh receiver user: " + nil nil nil dirvish-rsync--transient-input-history))) + +(transient-define-infix dirvish-rsync--r2r-direct-conn () + :class 'transient-lisp-variable + :variable 'dirvish-rsync--r2r-direct-conn + :reader (lambda (_prompt _init _hist) + (completing-read "direct: " '(yes no) nil t))) + +(transient-define-prefix dirvish-rsync-transient-configure () + "Configure variables for `dirvish-rsync'." + ["Remote to remote" + ("rh" "Receiver host" dirvish-rsync--r2r-ssh-host) + ("rp" "Receiver port" dirvish-rsync--r2r-ssh-port) + ("ru" "Receiver user" dirvish-rsync--r2r-ssh-user) + ("rd" "Direct connection" dirvish-rsync--r2r-direct-conn)]) + +;; inspired by `dired-rsync-transient' +(define-obsolete-function-alias 'dirvish-rsync-transient #'dirvish-rsync-menu "Feb 09, 2025") +;;;###autoload (autoload 'dirvish-rsync-menu "dirvish-rsync" nil t) +(transient-define-prefix dirvish-rsync-menu () + "Transient command for `dirvish-rsync'." + :init-value (lambda (o) + (oset o value (dirvish-rsync--transient-init-rsync-switches o))) + ["Common Arguments" + ("-a" "archive mode; equals to -rlptgoD" ("-a" "--archive")) + ("-s" "no space-splitting; useful when remote filenames contain spaces" ("-s" "--protect-args") :level 4) + ("-r" "recurse into directories" ("-r" "--recursive") :level 5) + ("-z" "compress file data during the transfer" ("-z" "--compress"))] + ["Files selection args" + ("-C" "auto-ignore files in the same way CVS does" ("-C" "--cvs-exclude") :level 4) + ("=e" "exclude files matching PATTERN" "--exclude=" + :multi-value repeat :reader dirvish-rsync--transient-read-multiple + :prompt "exclude (e.g. ‘*.git’ or ‘*.bin,*.elc’): ") + ("=i" "include files matching PATTERN" "--include=" + :multi-value repeat :reader dirvish-rsync--transient-read-multiple + :prompt "include (e.g. ‘*.pdf’ or ‘*.org,*.el’): " :level 5)] + ["Sender specific args" + ("-L" "transform symlink into referent file/dir" ("-L" "--copy-links") :level 4) + ("-x" "don't cross filesystem boundaries" ("-x" "--one-file-system") :level 5) + ("-l" "copy symlinks as symlinks" ("-l" "--links") :level 5) + ("-c" "skip based on checksum, not mod-time & size" ("-c" "--checksum") :level 6) + ("-m" "prune empty directory chains from file-list" ("-m" "--prune-empty-dirs") :level 6) + ("--size-only" "skip files that match in size" "--size-only" :level 6)] + ["Receiver specific args" + ("-R" "use relative path names" ("-R" "--relative") :level 4) + ("-u" "skip files that are newer on the receiver" ("-u" "--update") :level 4) + ("=d" "delete extraneous files from dest dirs" "--delete" :level 4) + ("-b" "make backups" ("-b" "--backup") :level 5) + ("=bs" "backup suffix" "--suffix=" + :prompt "backup suffix: " + :reader (lambda (prompt &optional _initial-input history) + (completing-read prompt nil nil nil nil history)) + :level 5) + ("-num" "don't map uid/gid values by user/group name" "--numeric-ids" :level 5) + ("-ex" "skip creating new files on receiver" "--existing" :level 6) + ("-K" "treat symlinked dir on receiver as dir" ("-K" "--keep-dirlinks") :level 6)] + ["Information output" + ("-v" "increase verbosity" ("-v" "--verbose")) + ("-i" "output a change-summary for all updates" "-i" :level 5) + ("-h" "output numbers in a human-readable format" "-h" :level 5) + ("=I" "per-file (1) or total transfer (2) progress" "--info=" + :choices ("progress1" "progress2") :level 4)] + ["Configure" + ("C" "Set variables..." dirvish-rsync-transient-configure)] + ["Action" + [("RET" "Apply switches and copy" dirvish-rsync--apply-switches-and-copy)]]) + +(defun dirvish-rsync--transient-read-multiple + (prompt &optional _initial-input _history) + "Read multiple values after PROMPT with optional INITIAL_INPUT and HISTORY." + (let ((crm-separator ",")) + (completing-read-multiple + prompt nil nil nil nil dirvish-rsync--transient-input-history))) + +(defun dirvish-rsync--apply-switches-and-copy (args) + "Execute rsync command generated by transient ARGS." + (interactive (list (transient-args transient-current-command))) + (dirvish-prop :rsync-switches args) + (call-interactively #'dirvish-rsync)) + +(provide 'dirvish-rsync) +;;; dirvish-rsync.el ends here diff --git a/extensions/dirvish-yank.el b/extensions/dirvish-yank.el index 94d859f8b5..1197fa5361 100644 --- a/extensions/dirvish-yank.el +++ b/extensions/dirvish-yank.el @@ -22,14 +22,11 @@ ;; - `dirvish-symlink' ;; - `dirvish-relative-symlink' ;; - `dirvish-hardlink' -;; - `dirvish-rsync' (requires 'rsync' executable) -;; - `dirvish-rsync-transient' (requires 'rsync' executable) ;;; Code: (require 'dired-aux) (require 'dirvish) -(require 'tramp) (defcustom dirvish-yank-sources 'all "The way to collect source files. @@ -59,20 +56,26 @@ The value can be a symbol or a function that returns a fileset." (const :tag "append INDEX~ to file name" append-to-filename) (const :tag "prepend INDEX~ to file name" prepend-to-filename))) -(defcustom dirvish-yank-rsync-program "rsync" - "The rsync binary that we are going to use." - :type 'string :group 'dirvish) - -(defcustom dirvish-yank-rsync-args '("--archive" "--verbose" "--compress" "--info=progress2") - "The default options for the rsync command." - :type '(repeat string) :group 'dirvish) - (defcustom dirvish-yank-keep-success-log t "If non-nil then keep logs of all completed yanks. -By default only logs for yanks that finished with an error are -kept alive." +By default only keep the log buffer alive for failed tasks." :type 'boolean :group 'dirvish) +(defun dirvish-yank--menu-setter (symbol pairs) + "Set key-command PAIRS for SYMBOL `dirvish-yank-menu'." + (when symbol (set symbol pairs)) + (eval + `(transient-define-prefix dirvish-yank-menu () + "Yank commands menu." + [:description + (lambda () (dirvish--format-menu-heading + "Select yank operation on marked files:")) + ,@pairs] + (interactive) + (if (derived-mode-p 'dired-mode) + (transient-setup 'dirvish-yank-menu) + (user-error "Not in a Dirvish buffer"))))) + ;;;###autoload (autoload 'dirvish-yank-menu "dirvish-yank" nil t) (defcustom dirvish-yank-keys '(("y" "Yank (paste) here" dirvish-yank) @@ -83,47 +86,7 @@ kept alive." "YANK-KEYs for command `dirvish-yank-menu'. A YANK-KEY is a (KEY DOC CMD) alist where KEY is the key to invoke the CMD, DOC is the documentation string." - :group 'dirvish :type 'alist - :set - (lambda (k v) - (set k v) - (eval - `(transient-define-prefix dirvish-yank-menu () - "Yank commands menu." - [:description - (lambda () (dirvish--format-menu-heading "Select yank operation on marked files:")) - ,@v] - (interactive) - (if (derived-mode-p 'dired-mode) - (transient-setup 'dirvish-yank-menu) - (user-error "Not in a Dirvish buffer")))))) - - -(defcustom dirvish-yank-ssh-r2r-default-port "22" - "Default ssh port of receiver when yanking in remote to remote scenario. -In this scenario rsync will be run on remote host, so it has no access -to your ~/.ssh/config file. If you have some settings there you have to -specify them somehow. One way is to set global default values and other -way is to set them locally before copying, using rsync-transient menu." - :type 'string :group 'dirvish) - -(defcustom dirvish-yank-ssh-r2r-default-user nil - "Default ssh user of receiver when yanking in remote to remote scenario. -When nil do not specify any user. See -`dirvish-yank-ssh-r2r-default-port' for more details." - :type 'string :group 'dirvish) - -(defcustom dirvish-yank-r2r-default-direct-conn nil - "When t copy data directly from host1 to host2. -If this is not possible, for example when host2 is not reacheable from -host1 set this option to nil. When it is nil the tunnel will be created -between host1 and host2, using running machine as proxy. For both cases -make sure that you have passwordless access to both hosts and that -ssh-agent is properly set-up. For checking that, everything works try -to execute a command \"ssh -A host1 ssh -o StrictHostKeyChecking=no -host2 hostname\". Also make sure that ssh-agent Environment variables -are propagated to Emacs." - :type 'string :group 'dirvish) + :group 'dirvish :type 'alist :set #'dirvish-yank--menu-setter) (defconst dirvish-yank-fn-string '((dired-copy-file . "Copying") @@ -138,27 +101,12 @@ are propagated to Emacs." "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*" "Variables matching this regexp will be loaded on Child Emacs.") ;; matches "Enter passphrase for key ..." (ssh) and "password for ..." (samba) -(defvar dirvish-passphrase-stall-regex +(defvar dirvish-yank-passphrase-stall-regex "\\(Enter \\)?[Pp]ass\\(word\\|phrase\\) for\\( key\\)?" "A regex to detect passphrase prompts.") -(defvar dirvish-percent-complete-regex "[[:digit:]]\\{1,3\\}%" +(defvar dirvish-yank-percent-complete-regex "[[:digit:]]\\{1,3\\}%" "A regex to extract the % complete from a file.") -(defvar dirvish-yank--remote-ssh-args - "-o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null" - "These args will be used for invoking ssh on remote host (in r2r case).") - -(defvar dirvish-yank--rsync-transient-input-history nil "History list of rsync transient input in the minibuffer.") - -(defvar-local dirvish-yank--r2r-direct-conn nil "Local value for enabling direct copy in r2r case.") -(defvar-local dirvish-yank--ssh-r2r-receiver-host nil "Local value of r2r receiver host.") -(defvar-local dirvish-yank--ssh-r2r-receiver-port nil "Local value of r2r receiver port.") -(defvar-local dirvish-yank--ssh-r2r-receiver-user nil "Local value of r2r receiver user.") - -(defun dirvish-yank--get-remote-port () - "Return the remote port we shall use for the reverse port-forward." - (+ 50000 (length dirvish-yank-log-buffers))) - (defun dirvish-yank--get-srcs (&optional range) "Get all marked filenames in RANGE. RANGE can be `buffer', `session', `all'." @@ -188,14 +136,6 @@ RANGE can be `buffer', `session', `all'." (dired-dwim-target-directory) nil nil nil 'file-directory-p)))) -(defun dirvish-yank--filename-for-rsync (file) - "Reformat a tramp FILE to one usable for rsync." - (if (tramp-tramp-file-p file) - (with-parsed-tramp-file-name file tfop - (format "%s%s:%s" (if tfop-user (format "%s@" tfop-user) "") tfop-host - (shell-quote-argument tfop-localname))) - (shell-quote-argument file))) - (defun dirvish-yank-proc-sentinel (proc _exit) "Sentinel for yank task PROC." (pcase-let ((proc-buf (process-buffer proc)) @@ -235,7 +175,7 @@ RANGE can be `buffer', `session', `all'." "Filter for yank task PROC's STRING." (let ((proc-buf (process-buffer proc))) ;; check for passphrase prompt - (when (string-match dirvish-passphrase-stall-regex string) + (when (string-match dirvish-yank-passphrase-stall-regex string) (process-send-string proc (concat (read-passwd string) "\n"))) ;; Answer yes for `large file' prompt (when (string-match "File .* is large\\(.*\\), really copy" string) @@ -243,7 +183,7 @@ RANGE can be `buffer', `session', `all'." (let ((old-process-mark (process-mark proc))) (when (buffer-live-p proc-buf) (with-current-buffer proc-buf - (when (string-match dirvish-percent-complete-regex string) + (when (string-match dirvish-yank-percent-complete-regex string) (dirvish-prop :yank-percent (match-string 0 string)) (force-mode-line-update t)) (let ((moving (= (point) old-process-mark))) @@ -326,7 +266,8 @@ File `%s' exists, type one of the following keys to continue. (if (memq method '(dired-make-relative-symlink make-symbolic-link)) (push (cons src (cdr (dirvish-yank--newbase base dfiles dest))) result) - (user-error "Source and target are the same file `%s'" src))) + (user-error + "DIRVISH[yank]: source and target are the same file `%s'" src))) (overwrite (push (cons src dest) result)) ((and backup collision) (push (dirvish-yank--newbase base dfiles dest) to-rename) @@ -347,13 +288,13 @@ File `%s' exists, type one of the following keys to continue. (?B (setq backup t) (push (dirvish-yank--newbase base dfiles dest) to-rename) (push (cons src dest) result)) - ((?q ?\e) (user-error "Dirvish[info]: yank task aborted")))) + ((?q ?\e) (user-error "DIRVISH[yank]: task aborted")))) (t (push (cons src dest) result))) finally return (prog1 result (cl-loop for (from . to) in to-rename do (rename-file from to))))) -(defun dirvish-yank-inject-env (include-regexp) +(defun dirvish-yank--inject-env (include-regexp) "Return a `setq' form that replicates part of the calling environment. It sets the value for every variable matching INCLUDE-REGEXP." `(setq ,@(let (bindings) @@ -370,116 +311,6 @@ It sets the value for every variable matching INCLUDE-REGEXP." bindings (cons sym bindings)))))) bindings))) -;; Thanks to `dired-rsync.el' -;; also see: https://unix.stackexchange.com/questions/183504/how-to-rsync-files-between-two-remotes - -(defun dirvish-yank--rsync-args () - "Retrieve rsync args for current session or default ones." - (or (dirvish-prop :rsync-switches) - dirvish-yank-rsync-args)) - -(defun dirvish-yank--build-rsync-command () - "Compose rsync command and args into the string." - (format "%s %s" dirvish-yank-rsync-program - (string-join (dirvish-yank--rsync-args) " "))) - -(defun dirvish-yank--build-local-ssh-args (host-info) - "Compose ssh args used for sshing to source host. -HOST-INFO is a list of host/user/port parsed from the tramp string." - (let* ((port (cl-third host-info)) - (port-str (if port (concat "-p" port) "")) - (user (cl-second host-info)) - (user-str (if user (concat user "@") ""))) - (concat port-str " " user-str (cl-first host-info)))) - -(defun dirvish-yank--r2r-escape-single-quote (str) - "Properly escape all single quotes in STR. -STR should be processed by `shell-quote-argument' already. Single -quotes require special care since we wrap remote command with them. -Bash doesn't allow nesting of single quotes (even escaped ones), so we -need to turn string into multiple concatenated strings." - ;; use string-replace from emacs-28.1 when support of older versions is dropped - (replace-regexp-in-string "'" "'\"'\"'" str t t)) - -(defun dirvish-yank-r2r-handler (srcs shost-info dhost-info) - "Construct and trigger an rsync run for remote copy. -This command sync SRCS on SHOST to DEST on DHOST. SHOST-INFO and -DHOST-INFO are lists containing host,user,port,localname -extracted from the tramp string." - (let* ((srcs (mapcar (lambda (x) - (thread-last x file-local-name shell-quote-argument - dirvish-yank--r2r-escape-single-quote)) - srcs)) - (src-str (string-join srcs " ")) - (shost (cl-first shost-info)) - (dhost (cl-first dhost-info)) - (dhost-real (or dirvish-yank--ssh-r2r-receiver-host - (cl-first dhost-info))) - (duser (or dirvish-yank--ssh-r2r-receiver-user - (cl-second dhost-info) - dirvish-yank-ssh-r2r-default-user)) - (dport (or dirvish-yank--ssh-r2r-receiver-port - (cl-third dhost-info) - dirvish-yank-ssh-r2r-default-port)) - (dest (thread-last (cl-fourth dhost-info) - shell-quote-argument - dirvish-yank--r2r-escape-single-quote)) - - ;; 1. dhost == shost - ;; ssh [-p dport] [duser@]dhost 'rsync <rsync-args> <srcs> <dest>' - ;; 2. dhost != shost and dirvish-yank-r2r-direct-conn == t - ;; ssh -A [-p sport] [suser@]shost 'rsync <rsync-args> -e "ssh <ssh-remote-opts> [-p dport]" <srcs> [duser@]dhost:<dest> ' - ;; 3. dhost != shost and dirvish-yank-r2r-direct-conn == nil - ;; ssh -A -R <bind-addr> [-p sport] [suser@]shost 'rsync <rsync-args> -e "ssh <ssh-remote-opts> -p <tunnel_port>" <srcs> [duser@]localhost:<dest>' - (cmd (cond ((equal shost dhost) - (string-join - (list "ssh" - (dirvish-yank--build-local-ssh-args dhost-info) - "'" - (dirvish-yank--build-rsync-command) - src-str dest "'") - " ")) - ((if dirvish-yank--r2r-direct-conn - (equal dirvish-yank--r2r-direct-conn "yes") - dirvish-yank-r2r-default-direct-conn) - (string-join - (list "ssh -A " - (dirvish-yank--build-local-ssh-args shost-info) - " '" (dirvish-yank--build-rsync-command) - (format " -e \"ssh %s %s\" " - (if dport (concat "-p" dport) "") - dirvish-yank--remote-ssh-args) - src-str " " - (if duser - (format "%s@%s" duser dhost-real) - dhost-real) - ":" dest "'"))) - (t (let* ((port (dirvish-yank--get-remote-port)) - (bind-addr (format "localhost:%d:%s:%s" - port dhost-real dport))) - (string-join - (list "ssh -A -R " bind-addr " " - (dirvish-yank--build-local-ssh-args shost-info) - " '" (dirvish-yank--build-rsync-command) - (format " -e \"ssh -p %s %s\" " - port dirvish-yank--remote-ssh-args) - src-str - " " - (if duser - (format "%s@localhost" duser) - "localhost") - ":" dest "'"))))))) - (dirvish-yank--execute cmd (list (current-buffer) srcs dest 'rsync)))) - -(defun dirvish-yank-l2fr-handler (srcs dest) - "Execute a local to/from remote rsync command for SRCS and DEST." - (let* ((srcs (mapcar #'dirvish-yank--filename-for-rsync srcs)) - (dest (dirvish-yank--filename-for-rsync dest)) - (rsync-cmd (flatten-tree (list (dirvish-yank--build-rsync-command) - srcs dest))) - (cmd (string-join rsync-cmd " "))) - (dirvish-yank--execute cmd (list (current-buffer) srcs dest 'rsync)))) - (defun dirvish-yank-default-handler (method srcs dest) "Execute yank METHOD on SRCS to DEST." (let* ((pairs (dirvish-yank--filename-pairs method srcs dest)) @@ -487,7 +318,7 @@ extracted from the tramp string." (cmd `(progn (require 'dired-aux) (require 'dired-x) - ,(dirvish-yank-inject-env dirvish-yank-env-variables-regexp) + ,(dirvish-yank--inject-env dirvish-yank-env-variables-regexp) (cl-loop with dired-recursive-copies = 'always with dired-copy-preserve-time = ,dired-copy-preserve-time @@ -507,30 +338,13 @@ extracted from the tramp string." (dirvish-yank--execute (format "%S" cmd) (list (current-buffer) srcs dest method) 'batch))) -;; copied from `dired-rsync' -(defun dirvish-yank--extract-host-from-tramp (file-or-path) - "Extract the tramp host part of FILE-OR-PATH. -Returns list that contains (host user port localname)." - (with-parsed-tramp-file-name file-or-path tfop - (when tfop-hop - (user-error "Dirvish-yank: Paths with hop are not supported!")) - (list tfop-host tfop-user tfop-port tfop-localname))) - -(defun dirvish-yank--extract-remote (files) - "Get string identifying the remote connection of FILES." - (cl-loop with hosts = () for f in files for h = (file-remote-p f) - do (cl-pushnew h hosts :test #'equal) - when (> (length hosts) 1) - do (user-error "Dirvish[error]: SOURCEs need to be in the same host") - finally return (car hosts))) - (defun dirvish-yank--apply (method dest) "Apply yank METHOD to DEST." (setq dest (expand-file-name (or dest (dired-current-directory)))) (let ((srcs (or (and (functionp dirvish-yank-sources) (funcall dirvish-yank-sources)) (dirvish-yank--get-srcs dirvish-yank-sources) - (user-error "Dirvish[error]: no marked files")))) + (user-error "DIRVISH[yank]: no marked files")))) (dirvish-yank-default-handler method srcs dest))) (dirvish-define-mode-line yank @@ -562,197 +376,49 @@ Returns list that contains (host user port localname)." (format " %s %s%s " (propertize (number-to-string number-of-tasks) 'face 'font-lock-keyword-face) - (propertize "running yank task" 'face 'font-lock-doc-face) + (propertize "running tasks" 'face 'font-lock-doc-face) (propertize (if (> number-of-tasks 1) "s" "") 'face 'font-lock-doc-face)))))) ;;;###autoload (defun dirvish-yank (&optional dest) "Paste marked files to DEST. -Prompt for DEST when prefixed with \\[universal-argument], it -defaults to `dired-current-directory.'" +Prompt for DEST when prefixed with \\[universal-argument], it defaults +to `dired-current-directory.'" (interactive (dirvish-yank--read-dest 'yank)) (dirvish-yank--apply 'dired-copy-file dest)) ;;;###autoload (defun dirvish-move (&optional dest) "Move marked files to DEST. -Prompt for DEST when prefixed with \\[universal-argument], it -defaults to `dired-current-directory'." +Prompt for DEST when prefixed with \\[universal-argument], it defaults +to `dired-current-directory'." (interactive (dirvish-yank--read-dest 'move)) (dirvish-yank--apply 'dired-rename-file dest)) ;;;###autoload (defun dirvish-symlink (&optional dest) "Symlink marked files to DEST. -Prompt for DEST when prefixed with \\[universal-argument], it -defaults to `dired-current-directory'." +Prompt for DEST when prefixed with \\[universal-argument], it defaults +to `dired-current-directory'." (interactive (dirvish-yank--read-dest 'symlink)) (dirvish-yank--apply 'make-symbolic-link dest)) ;;;###autoload (defun dirvish-relative-symlink (&optional dest) "Similar to `dirvish-symlink', but link files relatively. -Prompt for DEST when prefixed with \\[universal-argument], it -defaults to `dired-current-directory'." +Prompt for DEST when prefixed with \\[universal-argument], it defaults +to `dired-current-directory'." (interactive (dirvish-yank--read-dest 'relalink)) (dirvish-yank--apply 'dired-make-relative-symlink dest)) ;;;###autoload (defun dirvish-hardlink (&optional dest) "Hardlink marked files to DEST. -Prompt for DEST when prefixed with \\[universal-argument], it -defaults to `dired-current-directory'." +Prompt for DEST when prefixed with \\[universal-argument], it defaults +to `dired-current-directory'." (interactive (dirvish-yank--read-dest 'hardlink)) (dirvish-yank--apply 'dired-hardlink dest)) -;;;###autoload -(defun dirvish-rsync (dest) - "Rsync marked files to DEST, prompt for DEST if not called with. -If either the sources or the DEST is located in a remote host, the -`dirvish-yank-rsync-program' and `dirvish-yank-rsync-args' are used to -transfer the files. - -This command requires proper ssh authentication setup to work correctly -for file transfer involving remote hosts, because rsync command is -always run locally, the password prompts may lead to unexpected errors." - (interactive (dirvish-yank--read-dest 'rsync)) - (setq dest (expand-file-name (or dest (dired-current-directory)))) - (let* ((dvec (and (tramp-tramp-file-p dest) (tramp-dissect-file-name dest))) - (srcs (or (and (functionp dirvish-yank-sources) - (funcall dirvish-yank-sources)) - (dirvish-yank--get-srcs dirvish-yank-sources) - (user-error "Dirvish[error]: no marked files"))) - (src-0 (prog1 (car srcs) (dirvish-yank--extract-remote srcs))) - (svec (and (tramp-tramp-file-p src-0) (tramp-dissect-file-name src-0)))) - (cond - ;; shost and dhost are different remote hosts - ((and svec dvec (not (tramp-local-host-p svec)) - (not (tramp-local-host-p dvec))) - (dirvish-yank-r2r-handler - srcs (dirvish-yank--extract-host-from-tramp src-0) - (dirvish-yank--extract-host-from-tramp dest))) - ;; either shost, dhost or both are localhost - (t (dirvish-yank-l2fr-handler srcs dest))))) - -(defun dirvish-yank--rsync-transient-init-rsync-switches (obj) - "Select initial values for transient suffixes, possibly from OBJ. -Use values from the local session or Emacs session or saved transient -values." - (or (dirvish-prop :rsync-switches) - ;; don't touch if it is alreday set - (if (and (slot-boundp obj 'value) (oref obj value)) - (oref obj value) - ;; check saved values - (if-let* ((saved (assq (oref obj command) transient-values))) - (cdr saved) - ;; use default value at last resort - dirvish-yank-rsync-args)))) - -(transient-define-infix dirvish-yank--r2r-ssh-host () - "Set ssh host of receiver in remote to remote case." - :description "Ssh host of receiver" - :class 'transient-lisp-variable - :variable 'dirvish-yank--ssh-r2r-receiver-host - :reader (lambda (_prompt _init _hist) - (completing-read "Ssh receiver host: " - nil nil nil dirvish-yank--rsync-transient-input-history))) - -(transient-define-infix dirvish-yank--r2r-ssh-port () - "Set ssh port of receiver in remote to remote case." - :description "Ssh port of receiver" - :class 'transient-lisp-variable - :variable 'dirvish-yank--ssh-r2r-receiver-port - :reader (lambda (_prompt _init _hist) - (completing-read "Ssh receiver port: " - nil nil nil dirvish-yank--rsync-transient-input-history))) - -(transient-define-infix dirvish-yank--r2r-ssh-user () - "Set ssh user of receiver in remote to remote case." - :description "Ssh user of receiver" - :class 'transient-lisp-variable - :variable 'dirvish-yank--ssh-r2r-receiver-user - :reader (lambda (_prompt _init _hist) - (completing-read "Ssh receiver user: " - nil nil nil dirvish-yank--rsync-transient-input-history))) - -(transient-define-infix dirvish-yank--r2r-direct-conn () - :class 'transient-lisp-variable - :variable 'dirvish-yank--r2r-direct-conn - :reader (lambda (_prompt _init _hist) (completing-read "direct: " '(yes no) nil t))) - -(transient-define-prefix dirvish-rsync-transient-configure () - "Configure variables for `dirvish-rsync'." - ["Remote to remote" - ("rh" "Receiver host" dirvish-yank--r2r-ssh-host) - ("rp" "Receiver port" dirvish-yank--r2r-ssh-port) - ("ru" "Receiver user" dirvish-yank--r2r-ssh-user) - ("rd" "Direct connection" dirvish-yank--r2r-direct-conn)]) - -;; inspired by `dired-rsync-transient' -;;;###autoload (autoload 'dirvish-rsync-transient "dirvish-yank" nil t) -(transient-define-prefix dirvish-rsync-transient () - "Transient command for `dirvish-rsync'." - :init-value (lambda (o) (oset o value (dirvish-yank--rsync-transient-init-rsync-switches o))) - ["Common Arguments" - ("-a" "archive mode; equals to -rlptgoD" ("-a" "--archive")) - ("-s" "no space-splitting; useful when remote filenames contain spaces" ("-s" "--protect-args") :level 4) - ("-r" "recurse into directories" ("-r" "--recursive") :level 5) - ("-z" "compress file data during the transfer" ("-z" "--compress"))] - - ["Files selection args" - ("-C" "auto-ignore files in the same way CVS does" ("-C" "--cvs-exclude") :level 4) - ("=e" "exclude files matching PATTERN" "--exclude=" - :multi-value repeat :reader dirvish-yank--rsync-transient-read-multiple - :prompt "exclude (e.g. ‘*.git’ or ‘*.bin,*.elc’): ") - ("=i" "include files matching PATTERN" "--include=" - :multi-value repeat :reader dirvish-yank--rsync-transient-read-multiple - :prompt "include (e.g. ‘*.pdf’ or ‘*.org,*.el’): " :level 5)] - - ["Sender specific args" - ("-L" "transform symlink into referent file/dir" ("-L" "--copy-links") :level 4) - ("-x" "don't cross filesystem boundaries" ("-x" "--one-file-system") :level 5) - ("-l" "copy symlinks as symlinks" ("-l" "--links") :level 5) - ("-c" "skip based on checksum, not mod-time & size" ("-c" "--checksum") :level 6) - ("-m" "prune empty directory chains from file-list" ("-m" "--prune-empty-dirs") :level 6) - ("--size-only" "skip files that match in size" "--size-only" :level 6)] - ["Receiver specific args" - ("-R" "use relative path names" ("-R" "--relative") :level 4) - ("-u" "skip files that are newer on the receiver" ("-u" "--update") :level 4) - ("=d" "delete extraneous files from dest dirs" "--delete" :level 4) - ("-b" "make backups" ("-b" "--backup") :level 5) - ("=bs" "backup suffix" "--suffix=" - :prompt "backup suffix: " - :reader (lambda (prompt &optional _initial-input history) - (completing-read prompt nil nil nil nil history)) - :level 5) - ("-num" "don't map uid/gid values by user/group name" "--numeric-ids" :level 5) - ("-ex" "skip creating new files on receiver" "--existing" :level 6) - ("-K" "treat symlinked dir on receiver as dir" ("-K" "--keep-dirlinks") :level 6)] - - ["Information output" - ("-v" "increase verbosity" ("-v" "--verbose")) - ("-i" "output a change-summary for all updates" "-i" :level 5) - ("-h" "output numbers in a human-readable format" "-h" :level 5) - ("=I" "per-file (1) or total transfer (2) progress" "--info=" - :choices ("progress1" "progress2") :level 4)] - ["Configure" - ("C" "Set variables..." dirvish-rsync-transient-configure)] - ["Action" - [("RET" "Apply switches and copy" dirvish-yank--rsync-apply-switches-and-copy)]]) - -(defvar crm-separator) - -(defun dirvish-yank--rsync-transient-read-multiple (prompt &optional _initial-input _history) - "Read multiple values after PROMPT with optional INITIAL_INPUT and HISTORY." - (let ((crm-separator ",")) - (completing-read-multiple prompt nil nil nil nil dirvish-yank--rsync-transient-input-history))) - -(defun dirvish-yank--rsync-apply-switches-and-copy (args) - "Execute rsync command generated by transient ARGS." - (interactive (list (transient-args transient-current-command))) - (dirvish-prop :rsync-switches args) - (call-interactively #'dirvish-rsync)) - (provide 'dirvish-yank) ;;; dirvish-yank.el ends here