all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Michael Albinus <michael.albinus@gmx.de>
To: Manuel Giraud <manuel@ledu-giraud.fr>
Cc: help-gnu-emacs@gnu.org, Tomas Hlavaty <tom@logand.com>,
	Tassilo Horn <tsdh@gnu.org>
Subject: Re: Dired command on same host
Date: Fri, 07 Jan 2022 16:50:00 +0100	[thread overview]
Message-ID: <87bl0n8s0n.fsf@gmx.de> (raw)
In-Reply-To: <87ee5l5drh.fsf@gmx.de> (Michael Albinus's message of "Thu, 06 Jan 2022 12:01:38 +0100")

[-- Attachment #1: Type: text/plain, Size: 1061 bytes --]

Michael Albinus <michael.albinus@gmx.de> writes:

Hi everybody,

>> ssh is able to identify the host using host keys:
>>
>> /etc/ssh/ssh_host_ed25519_key.pub
>> /etc/ssh/ssh_host_rsa_key.pub
>
> Thanks, these can be accessed via ssh-keyscan. Will use it in Tramp.

I've implemented a proof-of-concept, see appended patch to
tramp-sh.el. It is towards Emacs 29.0.50, but might also apply for Emacs
28.0.90 (for testing). After loading Tramp, there is a new user option
tramp-use-scp-direct-remote-copying which must be set to non-nil.

Direct scp copying between two remote servers shall happen then. Could
people test it? Setting tramp-verbose to 6 shall show the scp command in
the debug buffer, like in my case

--8<---------------cut here---------------start------------->8---
16:41:38.755570 tramp-do-copy-or-rename-file-out-of-band (6) # scp -p -T -R -q -r gandalf:/home/albinus/Downloads/CentOS-8.4.2105-x86_64-dvd1.iso detlef:/tmp/CentOS-8.4.2105-x86_64-dvd1.iso
--8<---------------cut here---------------end--------------->8---

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 14789 bytes --]

*** /tmp/ediffuxUjdM	2022-01-07 16:33:41.019095060 +0100
--- /home/albinus/src/tramp/lisp/tramp-sh.el	2022-01-07 16:26:54.686931060 +0100
***************
*** 136,141 ****
--- 136,157 ----

  The string is used in `tramp-methods'.")

+ (defcustom tramp-use-scp-direct-remote-copying nil
+   "Whether to use direct copying between two remote hosts."
+   :group 'tramp
+   :version "29.1"
+   :type 'boolean)
+
+ (defvar tramp-scp-direct-remote-copying nil
+   "Which scp direct remote copying argument to use.
+
+ It is the string \"-R\" if supported by the local scp (since
+ release 8.7), otherwise the string \"\".  If it is nil, it will
+ be auto-detected by Tramp, if
+ `tramp-use-scp-direct-remote-copying' is non-nil..
+
+ The string is used in `tramp-methods'.")
+
  ;; Initialize `tramp-methods' with the supported methods.
  ;;;###tramp-autoload
  (tramp--with-startup
***************
*** 172,178 ****
                  (tramp-remote-shell-args    ("-c"))
                  (tramp-copy-program         "scp")
                  (tramp-copy-args            (("-P" "%p") ("-p" "%k")
! 					     ("%x") ("-q") ("-r") ("%c")))
                  (tramp-copy-keep-date       t)
                  (tramp-copy-recursive       t)))
   (add-to-list 'tramp-methods
--- 188,194 ----
                  (tramp-remote-shell-args    ("-c"))
                  (tramp-copy-program         "scp")
                  (tramp-copy-args            (("-P" "%p") ("-p" "%k")
! 					     ("%x") ("%y") ("-q") ("-r") ("%c")))
                  (tramp-copy-keep-date       t)
                  (tramp-copy-recursive       t)))
   (add-to-list 'tramp-methods
***************
*** 188,194 ****
                  (tramp-remote-shell-args    ("-c"))
                  (tramp-copy-program         "scp")
                  (tramp-copy-args            (("-P" "%p") ("-p" "%k")
! 				             ("%x") ("-q") ("-r") ("%c")))
                  (tramp-copy-keep-date       t)
                  (tramp-copy-recursive       t)))
   (add-to-list 'tramp-methods
--- 204,210 ----
                  (tramp-remote-shell-args    ("-c"))
                  (tramp-copy-program         "scp")
                  (tramp-copy-args            (("-P" "%p") ("-p" "%k")
! 				             ("%x") ("%y") ("-q") ("-r") ("%c")))
                  (tramp-copy-keep-date       t)
                  (tramp-copy-recursive       t)))
   (add-to-list 'tramp-methods
***************
*** 2241,2259 ****
      (op filename newname ok-if-already-exists keep-date)
    "Invoke `scp' program to copy.
  The method used must be an out-of-band method."
!   (let* ((t1 (tramp-tramp-file-p filename))
! 	 (t2 (tramp-tramp-file-p newname))
! 	 (orig-vec (tramp-dissect-file-name (if t1 filename newname)))
  	 copy-program copy-args copy-env copy-keep-date listener spec
  	 options source target remote-copy-program remote-copy-args p)

!     (with-parsed-tramp-file-name (if t1 filename newname) nil
!       (if (and t1 t2)

! 	  ;; Both are Tramp files.  We shall optimize it when the
! 	  ;; methods for FILENAME and NEWNAME are the same.
  	  (let* ((dir-flag (file-directory-p filename))
! 		 (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
  	    (if dir-flag
  		(setq tmpfile
  		      (expand-file-name
--- 2257,2277 ----
      (op filename newname ok-if-already-exists keep-date)
    "Invoke `scp' program to copy.
  The method used must be an out-of-band method."
!   (let* ((v1 (and (tramp-tramp-file-p filename)
! 		  (tramp-dissect-file-name filename)))
! 	 (v2 (and (tramp-tramp-file-p newname)
! 		  (tramp-dissect-file-name newname)))
! 	 (v (or v1 v2))
  	 copy-program copy-args copy-env copy-keep-date listener spec
  	 options source target remote-copy-program remote-copy-args p)

! ;    (with-parsed-tramp-file-name (if v1 filename newname) nil
!       (if (and v1 v2 (not (tramp-scp-direct-remote-copying-p v1 v2)))

! 	  ;; Both are Tramp files.  We cannot use direct remote copying.
  	  (let* ((dir-flag (file-directory-p filename))
! 		 (tmpfile (tramp-compat-make-temp-file
! 			   (tramp-file-name-localname v1) dir-flag)))
  	    (if dir-flag
  		(setq tmpfile
  		      (expand-file-name
***************
*** 2273,2299 ****

  	;; Check which ones of source and target are Tramp files.
  	(setq source (funcall
! 		      (if (and (string-equal method "rsync")
  			       (file-directory-p filename)
  			       (not (file-exists-p newname)))
  			  #'file-name-as-directory
  			#'identity)
! 		      (if t1
! 			  (tramp-make-copy-program-file-name v)
  			(tramp-compat-file-name-unquote filename)))
! 	      target (if t2
! 			 (tramp-make-copy-program-file-name v)
  		       (tramp-compat-file-name-unquote newname)))

  	;; Check for user.  There might be an interactive setting.
! 	(setq user (or (tramp-file-name-user v)
! 		       (tramp-get-connection-property v "login-as" nil)))

  	;; Check for listener port.
  	(when (tramp-get-method-parameter v 'tramp-remote-copy-args)
  	  (setq listener (number-to-string (+ 50000 (random 10000))))
  	  (while
! 	      (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
  	    (setq listener (number-to-string (+ 50000 (random 10000))))))

  	;; Compose copy command.
--- 2291,2318 ----

  	;; Check which ones of source and target are Tramp files.
  	(setq source (funcall
! 		      (if (and (string-equal (tramp-file-name-method v) "rsync")
  			       (file-directory-p filename)
  			       (not (file-exists-p newname)))
  			  #'file-name-as-directory
  			#'identity)
! 		      (if v1
! 			  (tramp-make-copy-program-file-name v1)
  			(tramp-compat-file-name-unquote filename)))
! 	      target (if v2
! 			 (tramp-make-copy-program-file-name v2)
  		       (tramp-compat-file-name-unquote newname)))

  	;; Check for user.  There might be an interactive setting.
! ;	(setq user (or (tramp-file-name-user v)
! ;		       (tramp-get-connection-property v "login-as" nil)))

  	;; Check for listener port.
  	(when (tramp-get-method-parameter v 'tramp-remote-copy-args)
  	  (setq listener (number-to-string (+ 50000 (random 10000))))
  	  (while
! 	      (zerop (tramp-call-process
! 		      v "nc" nil nil nil "-z" (tramp-file-name-host v) listener))
  	    (setq listener (number-to-string (+ 50000 (random 10000))))))

  	;; Compose copy command.
***************
*** 2304,2313 ****
  		?t (tramp-get-connection-property
  		    (tramp-get-connection-process v) "temp-file" "")))
  	      spec (list
! 		    ?h (or host "") ?u (or user "") ?p (or port "")
  		    ?r listener ?c options ?k (if keep-date " " "")
                      ?n (concat "2>" (tramp-get-remote-null-device v))
! 		    ?x (tramp-scp-strict-file-name-checking v))
  	      copy-program (tramp-get-method-parameter v 'tramp-copy-program)
  	      copy-keep-date (tramp-get-method-parameter
  			      v 'tramp-copy-keep-date)
--- 2323,2335 ----
  		?t (tramp-get-connection-property
  		    (tramp-get-connection-process v) "temp-file" "")))
  	      spec (list
! 		    ?h (or (tramp-file-name-host v) "")
! 		    ?u (or (tramp-file-name-user v) "")
! 		    ?p (or (tramp-file-name-port v) "")
  		    ?r listener ?c options ?k (if keep-date " " "")
                      ?n (concat "2>" (tramp-get-remote-null-device v))
! 		    ?x (tramp-scp-strict-file-name-checking v)
! 		    ?y (tramp-scp-direct-remote-copying v))
  	      copy-program (tramp-get-method-parameter v 'tramp-copy-program)
  	      copy-keep-date (tramp-get-method-parameter
  			      v 'tramp-copy-keep-date)
***************
*** 2350,2356 ****
  		 #'identity
  		 (append
  		  (list remote-copy-program) remote-copy-args
! 		  (list (if t1 (concat "<" source) (concat ">" target)) "&"))
  		 " "))
  	  (tramp-send-command v remote-copy-program)
  	  (with-timeout
--- 2372,2378 ----
  		 #'identity
  		 (append
  		  (list remote-copy-program) remote-copy-args
! 		  (list (if v1 (concat "<" source) (concat ">" target)) "&"))
  		 " "))
  	  (tramp-send-command v remote-copy-program)
  	  (with-timeout
***************
*** 2367,2373 ****
  	  (unwind-protect
  	      ;; The default directory must be remote.
  	      (let ((default-directory
! 		      (file-name-directory (if t1 filename newname)))
  		    (process-environment (copy-sequence process-environment)))
  		;; Set the transfer process properties.
  		(tramp-set-connection-property
--- 2389,2395 ----
  	  (unwind-protect
  	      ;; The default directory must be remote.
  	      (let ((default-directory
! 		     (file-name-directory (if v1 filename newname)))
  		    (process-environment (copy-sequence process-environment)))
  		;; Set the transfer process properties.
  		(tramp-set-connection-property
***************
*** 2376,2382 ****
  		 v "process-buffer" (current-buffer))
  		(when copy-env
  		  (tramp-message
! 		   orig-vec 6 "%s=\"%s\""
  		   (car copy-env) (string-join (cdr copy-env) " "))
  		  (setenv (car copy-env) (string-join (cdr copy-env) " ")))
  		(setq
--- 2398,2404 ----
  		 v "process-buffer" (current-buffer))
  		(when copy-env
  		  (tramp-message
! 		   v 6 "%s=\"%s\""
  		   (car copy-env) (string-join (cdr copy-env) " "))
  		  (setenv (car copy-env) (string-join (cdr copy-env) " ")))
  		(setq
***************
*** 2384,2403 ****
  		 (append
  		  copy-args
  		  (if remote-copy-program
! 		      (list (if t1 (concat ">" target) (concat "<" source)))
  		    (list source target)))
  		 ;; Use an asynchronous process.  By this, password
  		 ;; can be handled.  We don't set a timeout, because
  		 ;; the copying of large files can last longer than 60
  		 ;; secs.
! 		 p (let ((default-directory tramp-compat-temporary-file-directory))
  		     (apply
  		      #'start-process
  		      (tramp-get-connection-name v)
  		      (tramp-get-connection-buffer v)
  		      copy-program copy-args)))
! 		(tramp-message orig-vec 6 "%s" (string-join (process-command p) " "))
! 		(process-put p 'vector orig-vec)
  		(process-put p 'adjust-window-size-function #'ignore)
  		(set-process-query-on-exit-flag p nil)

--- 2406,2426 ----
  		 (append
  		  copy-args
  		  (if remote-copy-program
! 		      (list (if v1 (concat ">" target) (concat "<" source)))
  		    (list source target)))
  		 ;; Use an asynchronous process.  By this, password
  		 ;; can be handled.  We don't set a timeout, because
  		 ;; the copying of large files can last longer than 60
  		 ;; secs.
! 		 p (let ((default-directory
! 			  tramp-compat-temporary-file-directory))
  		     (apply
  		      #'start-process
  		      (tramp-get-connection-name v)
  		      (tramp-get-connection-buffer v)
  		      copy-program copy-args)))
! 		(tramp-message v 6 "%s" (string-join (process-command p) " "))
! 		(process-put p 'vector v)
  		(process-put p 'adjust-window-size-function #'ignore)
  		(set-process-query-on-exit-flag p nil)

***************
*** 2434,2440 ****
        (unless (eq op 'copy)
  	(if (file-regular-p filename)
  	    (delete-file filename)
! 	  (delete-directory filename 'recursive))))))

  (defun tramp-sh-handle-make-directory (dir &optional parents)
    "Like `make-directory' for Tramp files."
--- 2457,2463 ----
        (unless (eq op 'copy)
  	(if (file-regular-p filename)
  	    (delete-file filename)
! 	  (delete-directory filename 'recursive)))));)

  (defun tramp-sh-handle-make-directory (dir &optional parents)
    "Like `make-directory' for Tramp files."
***************
*** 4824,4829 ****
--- 4847,4912 ----
  		  (setq tramp-scp-strict-file-name-checking "-T")))))))
        tramp-scp-strict-file-name-checking)))

+ (defun tramp-scp-direct-remote-copying-p (vec1 vec2)
+   "Check, whether direct remote copying between VEC1 and VEC2 is possible."
+   (and tramp-use-scp-direct-remote-copying
+        (assoc "%y" (tramp-get-method-parameter vec1 'tramp-copy-args))
+        (assoc "%y" (tramp-get-method-parameter vec2 'tramp-copy-args))
+        (with-tramp-connection-property
+ 	   (tramp-get-process vec1)
+ 	   (concat "direct-remote-copying-"
+ 		   (tramp-make-tramp-file-name vec2 'local 'hop))
+ 	 (let ((command
+ 		(if (tramp-file-name-port vec2)
+ 		    `("ssh-keyscan" ,(tramp-file-name-host vec2)
+ 		      "-p" ,(tramp-file-name-port vec2))
+ 		  `("ssh-keyscan" ,(tramp-file-name-host vec2))))
+ 	       found string)
+ 	   (with-temp-buffer
+ 	     ;; Check hostkey of VEC2, seen from VEC1.
+ 	     (tramp-send-command vec1 (mapconcat #'identity command " "))
+ 	     ;; Check hostkey of VEC2, seen locally.
+ 	     (apply
+ 	      #'tramp-call-process vec1 (car command) nil t nil (cdr command))
+ 	     (goto-char (point-min))
+ 	     (while (and (not found) (not (eobp)))
+ 	       (setq string (buffer-substring
+ 			     (line-beginning-position) (line-end-position))
+ 		     found (and (not (string-match-p "^#" string))
+ 				(with-current-buffer (tramp-get-buffer vec1)
+ 				  (goto-char (point-min))
+ 				  (search-forward string nil 'noerror))))
+ 	       (forward-line))
+ 	     ;; Result.
+ 	     found)))))
+
+ (defun tramp-scp-direct-remote-copying (vec)
+   "Return the direct remote copying argument of the local scp."
+   (cond
+    ;; No options to be computed.
+    ((null (assoc "%y" (tramp-get-method-parameter vec 'tramp-copy-args)))
+     "")
+
+    ;; There is already a value to be used.
+    ((stringp tramp-scp-direct-remote-copying)
+     tramp-scp-direct-remote-copying)
+
+    ;; Determine the options.
+    (t (setq tramp-scp-direct-remote-copying "")
+       (let ((case-fold-search t))
+ 	(ignore-errors
+ 	  (when (executable-find "scp")
+ 	    (with-tramp-progress-reporter
+ 		vec 4 "Computing direct remote copying argument"
+ 	      (with-temp-buffer
+ 		(tramp-call-process vec "scp" nil t nil "-R")
+ 		(goto-char (point-min))
+ 		(unless
+                     (search-forward-regexp
+                      "\\(illegal\\|unknown\\) option -- R" nil t)
+ 		  (setq tramp-scp-strict-file-name-checking "-R")))))))
+       tramp-scp-strict-file-name-checking)))
+
  (defun tramp-timeout-session (vec)
    "Close the connection VEC after a session timeout.
  If there is just some editing, retry it after 5 seconds."
***************
*** 5977,5985 ****
  ;;
  ;; * Use lsh instead of ssh.  (Alfred M. Szmidt)
  ;;
- ;; * Optimize out-of-band copying when both methods are scp-like (not
- ;;   rsync).
- ;;
  ;; * Keep a second connection open for out-of-band methods like scp or
  ;;   rsync.
  ;;
--- 6060,6065 ----

  reply	other threads:[~2022-01-07 15:50 UTC|newest]

Thread overview: 28+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-01-04 10:24 Dired command on same host Manuel Giraud
2022-01-04 12:56 ` Michael Albinus
2022-01-04 16:25   ` Manuel Giraud
2022-01-04 18:33     ` Michael Albinus
2022-01-04 19:35       ` Tassilo Horn
2022-01-05  9:35         ` Manuel Giraud
2022-01-05 21:07           ` Tomas Hlavaty
2022-01-06 11:01             ` Michael Albinus
2022-01-07 15:50               ` Michael Albinus [this message]
2022-01-10  9:33                 ` Manuel Giraud
2022-01-10 12:56                   ` Michael Albinus
2022-01-10 14:07                     ` Manuel Giraud
2022-01-10 15:00                       ` Michael Albinus
2022-01-10 16:16                         ` Manuel Giraud
2022-01-11  8:25                           ` Michael Albinus
2022-01-11  8:59                             ` Manuel Giraud
2022-01-11  9:10                               ` Michael Albinus
2022-01-10 17:21                         ` Yuri Khan
2022-01-11  8:29                           ` Michael Albinus
2022-01-05 10:34         ` Michael Albinus
2022-01-05 13:02           ` Manuel Giraud
2022-01-05 14:37             ` Michael Albinus
2022-01-05 18:23               ` Manuel Giraud
2022-01-05  9:44       ` Manuel Giraud
2022-01-05 10:40         ` Michael Albinus
2022-01-05 11:08           ` Yuri Khan
2022-01-05 11:46             ` Michael Albinus
2022-01-05 19:55           ` Tassilo Horn

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87bl0n8s0n.fsf@gmx.de \
    --to=michael.albinus@gmx.de \
    --cc=help-gnu-emacs@gnu.org \
    --cc=manuel@ledu-giraud.fr \
    --cc=tom@logand.com \
    --cc=tsdh@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.