diff options
Diffstat (limited to 'lisp/net/tramp-sh.el')
| -rw-r--r-- | lisp/net/tramp-sh.el | 1146 |
1 files changed, 609 insertions, 537 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b0e98a31e11..8f8b81186b3 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -34,8 +34,11 @@ (eval-when-compile (require 'cl-lib)) (require 'tramp) +;; `dired-*' declarations can be removed, starting with Emacs 29.1. +(declare-function dired-compress-file "dired-aux") (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) +;; Added in Emacs 28.1. (defvar process-file-return-signal-string) (defvar vc-handled-backends) (defvar vc-bzr-program) @@ -143,6 +146,12 @@ be auto-detected by Tramp. 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) + ;; Initialize `tramp-methods' with the supported methods. ;;;###tramp-autoload (tramp--with-startup @@ -179,7 +188,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("%y") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("%z") + ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -195,7 +205,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("%x") ("%y") ("-q") ("-r") ("%c"))) + ("%x") ("%y") ("%z") + ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -301,7 +312,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10) - (tramp-session-timeout 300))) + (tramp-session-timeout 300) + (tramp-password-previous-hop t))) (add-to-list 'tramp-methods `("doas" (tramp-login-program "doas") @@ -309,7 +321,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10) - (tramp-session-timeout 300))) + (tramp-session-timeout 300) + (tramp-password-previous-hop t))) (add-to-list 'tramp-methods `("ksu" (tramp-login-program "ksu") @@ -949,7 +962,8 @@ Format specifiers \"%s\" are replaced before the script is used.") ;; New handlers should be added here. ;;;###tramp-autoload (defconst tramp-sh-file-name-handler-alist - '((access-file . tramp-handle-access-file) + '((abbreviate-file-name . tramp-handle-abbreviate-file-name) + (access-file . tramp-handle-access-file) (add-name-to-file . tramp-sh-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-sh-handle-copy-directory) @@ -961,6 +975,8 @@ Format specifiers \"%s\" are replaced before the script is used.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-sh-handle-directory-files-and-attributes) + ;; Starting with Emacs 29.1, `dired-compress-file' performed by + ;; default handler. (dired-compress-file . tramp-sh-handle-dired-compress-file) (dired-uncache . tramp-handle-dired-uncache) (exec-path . tramp-sh-handle-exec-path) @@ -1000,6 +1016,7 @@ Format specifiers \"%s\" are replaced before the script is used.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -1009,6 +1026,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-sh-handle-make-process) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) + (process-attributes . tramp-handle-process-attributes) (process-file . tramp-sh-handle-process-file) (rename-file . tramp-sh-handle-rename-file) (set-file-acl . tramp-sh-handle-set-file-acl) @@ -1020,6 +1038,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-sh-handle-get-home-directory) (tramp-get-remote-gid . tramp-sh-handle-get-remote-gid) (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) @@ -1153,8 +1172,7 @@ component is used as the target of the symlink." (when (file-remote-p result) (setq result (tramp-compat-file-name-quote result 'top))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)) - 'nohop))))) + result))))))) ;; Basic functions. @@ -1349,7 +1367,7 @@ component is used as the target of the symlink." (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (or (tramp-compat-file-attribute-modification-time attr) + (modtime (or (file-attribute-modification-time attr) tramp-time-doesnt-exist))) (setq coding-system-used last-coding-system-used) (if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know)) @@ -1387,7 +1405,7 @@ of." (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (tramp-compat-file-attribute-modification-time attr)) + (modtime (file-attribute-modification-time attr)) (mt (visited-file-modtime))) (cond @@ -1439,7 +1457,7 @@ of." (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) + nil time))) (tramp-send-command-and-check v (format @@ -1451,6 +1469,20 @@ of." (if (eq flag 'nofollow) "-h" "") (tramp-shell-quote-argument localname))))))) +(defun tramp-sh-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (when (tramp-send-command-and-check + vec (format + "echo %s" + (tramp-shell-quote-argument + (concat "~" (or user (tramp-file-name-user vec)))))) + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (buffer-substring (point) (point-at-eol))))) + (defun tramp-sh-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." @@ -1636,14 +1668,14 @@ ID-FORMAT valid values are `string' and `integer'." ;; information would be lost by an (attempted) delete and create. (or (null attributes) (and - (= (tramp-compat-file-attribute-user-id attributes) + (= (file-attribute-user-id attributes) (tramp-get-remote-uid v 'integer)) (or (not group) ;; On BSD-derived systems files always inherit the ;; parent directory's group, so skip the group-gid ;; test. (tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin") - (= (tramp-compat-file-attribute-group-id attributes) + (= (file-attribute-group-id attributes) (tramp-get-remote-gid v 'integer))))))))) ;; Directory listings. @@ -1653,8 +1685,7 @@ ID-FORMAT valid values are `string' and `integer'." "Like `directory-files-and-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) (unless (file-exists-p directory) - (tramp-compat-file-missing - (tramp-dissect-file-name directory) directory)) + (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) (when (file-directory-p directory) (setq directory (expand-file-name directory)) (let* ((temp @@ -1874,7 +1905,7 @@ ID-FORMAT valid values are `string' and `integer'." target) (with-parsed-tramp-file-name (if t1 dirname newname) nil (unless (file-exists-p dirname) - (tramp-compat-file-missing v dirname)) + (tramp-error v 'file-missing dirname)) ;; `copy-directory-create-symlink' exists since Emacs 28.1. (if (and (bound-and-true-p copy-directory-create-symlink) @@ -1968,7 +1999,7 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (length (tramp-compat-file-attribute-size + (length (file-attribute-size (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes (file-extended-attributes filename))) @@ -1976,7 +2007,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-compat-file-missing v filename)) + (tramp-error v 'file-missing filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -2068,7 +2099,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." ;; Check, whether file is too large. Emacs checks in `insert-file-1' ;; and `find-file-noselect', but that's not called here. (abort-if-file-too-large - (tramp-compat-file-attribute-size (file-attributes (file-truename filename))) + (file-attribute-size (file-attributes (file-truename filename))) (symbol-name op) filename) ;; We must disable multibyte, because binary data shall not be ;; converted. We don't want the target file to be compressed, so we @@ -2090,8 +2121,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." (when keep-date (tramp-compat-set-file-times newname - (tramp-compat-file-attribute-modification-time - (file-attributes filename)) + (file-attribute-modification-time (file-attributes filename)) (unless ok-if-already-exists 'nofollow))) ;; Set the mode. (set-file-modes newname (tramp-default-file-modes filename)) @@ -2110,7 +2140,7 @@ as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid from FILENAME." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (file-times (tramp-compat-file-attribute-modification-time + (file-times (file-attribute-modification-time (file-attributes filename))) (file-modes (tramp-default-file-modes filename))) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -2254,202 +2284,211 @@ the uid and gid from FILENAME." (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))) + (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 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 - (file-name-nondirectory newname) tmpfile))) - (unwind-protect - (progn - (tramp-do-copy-or-rename-file-out-of-band - op filename tmpfile ok-if-already-exists keep-date) - (tramp-do-copy-or-rename-file-out-of-band - 'rename tmpfile newname ok-if-already-exists keep-date)) - ;; Save exit. - (ignore-errors - (if dir-flag - (delete-directory - (expand-file-name ".." tmpfile) 'recursive) - (delete-file tmpfile))))) - - ;; 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. - (setq options - (format-spec - (tramp-ssh-controlmaster-options v) - (format-spec-make - ?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) - ?y (tramp-scp-force-scp-protocol v)) - copy-program (tramp-get-method-parameter v 'tramp-copy-program) - copy-keep-date (tramp-get-method-parameter - v 'tramp-copy-keep-date) - copy-args - ;; " " has either been a replacement of "%k" (when - ;; keep-date argument is non-nil), or a replacement for - ;; the whole keep-date sublist. - (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) - ;; `tramp-ssh-controlmaster-options' is a string instead - ;; of a list. Unflatten it. - copy-args - (tramp-compat-flatten-tree - (mapcar - (lambda (x) (if (tramp-compat-string-search " " x) - (split-string x) x)) - copy-args)) - copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) - remote-copy-program - (tramp-get-method-parameter v 'tramp-remote-copy-program) - remote-copy-args - (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) - - ;; Check for local copy program. - (unless (executable-find copy-program) - (tramp-error - v 'file-error "Cannot find local copy program: %s" copy-program)) - - ;; Install listener on the remote side. The prompt must be - ;; consumed later on, when the process does not listen anymore. - (when remote-copy-program - (unless (with-tramp-connection-property - v (concat "remote-copy-program-" remote-copy-program) - (tramp-find-executable - v remote-copy-program (tramp-get-remote-path v))) - (tramp-error - v 'file-error - "Cannot find remote listener: %s" remote-copy-program)) - (setq remote-copy-program - (mapconcat - #'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 - (60 (tramp-error - v 'file-error - "Listener process not running on remote host: `%s'" - remote-copy-program)) - (tramp-send-command v (format "netstat -l | grep -q :%s" listener)) - (while (not (tramp-send-command-and-check v nil)) - (tramp-send-command - v (format "netstat -l | grep -q :%s" listener))))) + (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2)))) - (with-temp-buffer + ;; 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 + (file-name-nondirectory newname) tmpfile))) (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 - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - 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 - copy-args - (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) + (progn + (tramp-do-copy-or-rename-file-out-of-band + op filename tmpfile ok-if-already-exists keep-date) + (tramp-do-copy-or-rename-file-out-of-band + 'rename tmpfile newname ok-if-already-exists keep-date)) + ;; Save exit. + (ignore-errors + (if dir-flag + (delete-directory + (expand-file-name ".." tmpfile) 'recursive) + (delete-file tmpfile))))) + + ;; 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 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. + (setq options + (format-spec + (tramp-ssh-controlmaster-options v) + (format-spec-make + ?t (tramp-get-connection-property + (tramp-get-connection-process v) "temp-file" ""))) + spec (list + ;; "%h" and "%u" do not happen in `tramp-copy-args' + ;; of `scp', so it is save to use `v'. + ?h (or (tramp-file-name-host v) "") + ?u (or (tramp-file-name-user v) + ;; There might be an interactive setting. + (tramp-get-connection-property v "login-as" nil) + "") + ;; For direct remote copying, the port must be the + ;; same for source and target. + ?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-force-scp-protocol v) + ?z (tramp-scp-direct-remote-copying v1 v2)) + copy-program (tramp-get-method-parameter v 'tramp-copy-program) + copy-keep-date (tramp-get-method-parameter + v 'tramp-copy-keep-date) + copy-args + ;; " " has either been a replacement of "%k" (when + ;; keep-date argument is non-nil), or a replacement for + ;; the whole keep-date sublist. + (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) + ;; `tramp-ssh-controlmaster-options' is a string instead + ;; of a list. Unflatten it. + copy-args + (tramp-compat-flatten-tree + (mapcar + (lambda (x) (if (tramp-compat-string-search " " x) + (split-string x) x)) + copy-args)) + copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) + remote-copy-program + (tramp-get-method-parameter v 'tramp-remote-copy-program) + remote-copy-args + (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) + + ;; Check for local copy program. + (unless (executable-find copy-program) + (tramp-error + v 'file-error "Cannot find local copy program: %s" copy-program)) + + ;; Install listener on the remote side. The prompt must be + ;; consumed later on, when the process does not listen anymore. + (when remote-copy-program + (unless (with-tramp-connection-property + v (concat "remote-copy-program-" remote-copy-program) + (tramp-find-executable + v remote-copy-program (tramp-get-remote-path v))) + (tramp-error + v 'file-error + "Cannot find remote listener: %s" remote-copy-program)) + (setq remote-copy-program + (mapconcat + #'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 + (60 (tramp-error + v 'file-error + "Listener process not running on remote host: `%s'" + remote-copy-program)) + (tramp-send-command v (format "netstat -l | grep -q :%s" listener)) + (while (not (tramp-send-command-and-check v nil)) + (tramp-send-command + v (format "netstat -l | grep -q :%s" listener))))) + + (with-temp-buffer + (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 + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + 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 + copy-args + (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) + + ;; We must adapt `tramp-local-end-of-line' for sending + ;; the password. Also, we indicate that perhaps several + ;; password prompts might appear. + (let ((tramp-local-end-of-line tramp-rsh-end-of-line) + (tramp-password-prompt-not-unique (and v1 v2))) + (tramp-process-actions + p v nil tramp-actions-copy-out-of-band))) + + ;; Reset the transfer process properties. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Clear the remote prompt. + (when (and remote-copy-program + (not (tramp-send-command-and-check v nil))) + ;; Houston, we have a problem! Likely, the listener is + ;; still running, so let's clear everything (but the + ;; cached password). + (tramp-cleanup-connection v 'keep-debug 'keep-password)))) + + ;; Handle KEEP-DATE argument. + (when (and keep-date (not copy-keep-date)) + (tramp-compat-set-file-times + newname + (file-attribute-modification-time (file-attributes filename)) + (unless ok-if-already-exists 'nofollow))) + + ;; Set the mode. + (unless (and keep-date copy-keep-date) + (ignore-errors + (set-file-modes newname (tramp-default-file-modes filename))))) - ;; We must adapt `tramp-local-end-of-line' for - ;; sending the password. - (let ((tramp-local-end-of-line tramp-rsh-end-of-line)) - (tramp-process-actions - p v nil tramp-actions-copy-out-of-band))) - - ;; Reset the transfer process properties. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - ;; Clear the remote prompt. - (when (and remote-copy-program - (not (tramp-send-command-and-check v nil))) - ;; Houston, we have a problem! Likely, the listener is - ;; still running, so let's clear everything (but the - ;; cached password). - (tramp-cleanup-connection v 'keep-debug 'keep-password)))) - - ;; Handle KEEP-DATE argument. - (when (and keep-date (not copy-keep-date)) - (tramp-compat-set-file-times - newname - (tramp-compat-file-attribute-modification-time - (file-attributes filename)) - (unless ok-if-already-exists 'nofollow))) - - ;; Set the mode. - (unless (and keep-date copy-keep-date) - (ignore-errors - (set-file-modes newname (tramp-default-file-modes filename))))) - - ;; If the operation was `rename', delete the original file. - (unless (eq op 'copy) - (if (file-regular-p filename) - (delete-file filename) - (delete-directory filename 'recursive)))))) + ;; If the operation was `rename', delete the original file. + (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." @@ -2493,42 +2532,58 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-dired-compress-file (file) "Like `dired-compress-file' for Tramp files." - ;; Code stolen mainly from dired-aux.el. - (with-parsed-tramp-file-name file nil - (tramp-flush-file-properties v localname) - (let ((suffixes dired-compress-file-suffixes) - suffix) - ;; See if any suffix rule matches this file name. - (while suffixes - (let (case-fold-search) - (if (string-match-p (car (car suffixes)) localname) - (setq suffix (car suffixes) suffixes nil)) - (setq suffixes (cdr suffixes)))) - - (cond ((file-symlink-p file) nil) - ((and suffix (nth 2 suffix)) - ;; We found an uncompression rule. - (with-tramp-progress-reporter - v 0 (format "Uncompressing %s" file) - (when (tramp-send-command-and-check - v (concat (nth 2 suffix) " " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) - (string-match (car suffix) file) - (concat (substring file 0 (match-beginning 0)))))) - (t - ;; We don't recognize the file as compressed, so compress it. - ;; Try gzip. - (with-tramp-progress-reporter v 0 (format "Compressing %s" file) - (when (tramp-send-command-and-check - v (concat "gzip -f " - (tramp-shell-quote-argument localname))) - (dired-remove-file file) - (cond ((file-exists-p (concat file ".gz")) - (concat file ".gz")) - ((file-exists-p (concat file ".z")) - (concat file ".z")) - (t nil))))))))) + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. + (if (>= emacs-major-version 29) + (tramp-run-real-handler #'dired-compress-file (list file)) + ;; Code stolen mainly from dired-aux.el. + (with-parsed-tramp-file-name file nil + (tramp-flush-file-properties v localname) + (let ((suffixes dired-compress-file-suffixes) + suffix) + ;; See if any suffix rule matches this file name. + (while suffixes + (let (case-fold-search) + (if (string-match-p (car (car suffixes)) localname) + (setq suffix (car suffixes) suffixes nil)) + (setq suffixes (cdr suffixes)))) + + (cond ((file-symlink-p file) nil) + ((and suffix (nth 2 suffix)) + ;; We found an uncompression rule. + (with-tramp-progress-reporter + v 0 (format "Uncompressing %s" file) + (when (tramp-send-command-and-check + v (if (string-match-p "%[io]" (nth 2 suffix)) + (replace-regexp-in-string + "%i" (tramp-shell-quote-argument localname) + (nth 2 suffix)) + (concat (nth 2 suffix) " " + (tramp-shell-quote-argument localname)))) + (unless (string-match-p "\\.tar\\.gz" file) + (dired-remove-file file)) + (string-match (car suffix) file) + (concat (substring file 0 (match-beginning 0)))))) + (t + ;; We don't recognize the file as compressed, so + ;; compress it. Try gzip. + (with-tramp-progress-reporter v 0 (format "Compressing %s" file) + (when (tramp-send-command-and-check + v (if (file-directory-p file) + (format "tar -cf - %s | gzip -c9 > %s.tar.gz" + (tramp-shell-quote-argument + (file-name-nondirectory localname)) + (tramp-shell-quote-argument localname)) + (concat "gzip -f " + (tramp-shell-quote-argument localname)))) + (unless (file-directory-p file) + (dired-remove-file file)) + (catch 'found nil + (dolist (target (mapcar (lambda (suffix) + (concat file suffix)) + '(".tar.gz" ".gz" ".z"))) + (when (file-exists-p target) + (throw 'found target)))))))))))) (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -2600,7 +2655,7 @@ The method used must be an out-of-band method." ;; We cannot use `insert-buffer-substring' because the Tramp ;; buffer changes its contents before insertion due to calling ;; `expand-file-name' and alike. - (insert (with-current-buffer (tramp-get-buffer v) (buffer-string))) + (insert (tramp-get-buffer-string (tramp-get-buffer v))) ;; We must enable unibyte strings, because the "--dired" ;; output counts in bytes. @@ -2712,38 +2767,32 @@ the result will be a local, non-Tramp, file name." ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) - ;; If connection is not established yet, run the real handler. - (if (not (tramp-connectable-p name)) - (tramp-run-real-handler #'expand-file-name (list name nil)) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + ;; If connection is not established yet, run the real handler. + (if (not (tramp-connectable-p v)) + (tramp-run-real-handler #'expand-file-name (list name nil)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "~/" localname))) ;; Tilde expansion if necessary. This needs a shell which ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) + (fname (match-string 2 localname)) + hname) ;; We cannot simply apply "~/", because under sudo "~/" is ;; expanded to the local user home directory but to the ;; root home directory. On the other hand, using always ;; the default user name for tilde expansion is not ;; appropriate either, because ssh and companions might ;; use a user name from the config file. - (when (and (string-equal uname "~") + (when (and (zerop (length uname)) (string-match-p "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-tramp-connection-property v uname - (tramp-send-command - v - (format "cd %s && pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) - (setq localname (concat uname fname)))) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; There might be a double slash, for example when "~/" ;; expands to "/". Remove this. (while (string-match "//" localname) @@ -2751,15 +2800,17 @@ the result will be a local, non-Tramp, file name." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. ;; `default-directory' is bound, because on Windows there ;; would be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler - #'expand-file-name (list localname))))))))) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-drop-volume-letter + (tramp-run-real-handler + #'expand-file-name (list localname)))))))))) ;;; Remote commands: @@ -2825,6 +2876,7 @@ implementation will be used." stderr (tramp-make-tramp-temp-name v))))) (remote-tmpstderr (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) + (orig-command command) (program (car command)) (args (cdr command)) ;; When PROGRAM matches "*sh", and the first arg is @@ -2855,7 +2907,7 @@ implementation will be used." ;; `shell'. We discard hops, if existing, that's why ;; we cannot use `file-remote-p'. (prompt (format "PS1=%s %s" - (tramp-make-tramp-file-name v nil 'nohop) + (tramp-make-tramp-file-name v) tramp-initial-end-of-output)) ;; We use as environment the difference to toplevel ;; `process-environment'. @@ -2981,6 +3033,9 @@ implementation will be used." (set-process-sentinel p sentinel)) (when filter (set-process-filter p filter)) + (process-put p 'remote-command orig-command) + (tramp-set-connection-property + p "remote-command" orig-command) ;; Set query flag and process marker for this ;; process. We ignore errors, because the ;; process could have finished already. @@ -3016,7 +3071,7 @@ implementation will be used." vec (concat "signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell)) - (let ((default-directory (tramp-make-tramp-file-name vec 'localname)) + (let ((default-directory (tramp-make-tramp-file-name vec 'noloc)) process-file-return-signal-string signals res result) (setq signals (append @@ -3107,7 +3162,7 @@ implementation will be used." (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) - tmpinput (tramp-make-tramp-file-name v input 'nohop)) + tmpinput (tramp-make-tramp-file-name v input)) (copy-file infile tmpinput t))) (when input (setq command (format "%s <%s" command input))) @@ -3139,7 +3194,7 @@ implementation will be used." ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) - tmpstderr (tramp-make-tramp-file-name v stderr 'nohop)))) + tmpstderr (tramp-make-tramp-file-name v stderr)))) ;; stderr to be discarded. ((null (cadr destination)) (setq stderr (tramp-get-remote-null-device v))))) @@ -3164,8 +3219,7 @@ implementation will be used." (when outbuf (with-current-buffer outbuf (insert - (with-current-buffer (tramp-get-connection-buffer v) - (buffer-string)))) + (tramp-get-buffer-string (tramp-get-connection-buffer v)))) (when (and display (get-buffer-window outbuf t)) (redisplay)))) ;; When the user did interrupt, we should do it also. We use ;; return code -1 as marker. @@ -3208,9 +3262,9 @@ implementation will be used." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) - (tramp-compat-file-missing v filename)) + (tramp-error v 'file-missing filename)) - (let* ((size (tramp-compat-file-attribute-size + (let* ((size (file-attribute-size (file-attributes (file-truename filename)))) (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) (loc-dec (tramp-get-inline-coding v "local-decoding" size)) @@ -3286,255 +3340,197 @@ implementation will be used." (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (uid (or (tramp-compat-file-attribute-user-id - (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (tramp-compat-file-attribute-group-id - (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (if (and (tramp-local-host-p v) - ;; `file-writable-p' calls `file-expand-file-name'. We - ;; cannot use `tramp-run-real-handler' therefore. - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))) - ;; Short track: if we are on the local host, we can run directly. - (let ((create-lockfiles (not file-locked))) - (write-region start end localname append 'no-message lockname)) - - (let* ((modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - ;; We use this to save the value of - ;; `last-coding-system-used' after writing the tmp - ;; file. At the end of the function, we set - ;; `last-coding-system-used' to this saved value. This - ;; way, any intermediary coding systems used while - ;; talking to the remote shell or suchlike won't hose - ;; this variable. This approach was snarfed from - ;; ange-ftp.el. - coding-system-used - ;; Write region into a tmp file. This isn't really - ;; needed if we use an encoding function, but currently - ;; we use it always because this makes the logic - ;; simpler. We must also set `temporary-file-directory', - ;; because it could point to a remote directory. - (temporary-file-directory tramp-compat-temporary-file-directory) - (tmpfile (or tramp-temp-buffer-file-name - (tramp-compat-make-temp-file filename)))) - - ;; If `append' is non-nil, we copy the file locally, and let - ;; the native `write-region' implementation do the job. - (when (and append (file-exists-p filename)) - (copy-file filename tmpfile 'ok)) - - ;; We say `no-message' here because we don't want the - ;; visited file modtime data to be clobbered from the temp - ;; file. We call `set-visited-file-modtime' ourselves later - ;; on. We must ensure that `file-coding-system-alist' - ;; matches `tmpfile'. - (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile)) - create-lockfiles) - (condition-case err - (write-region start end tmpfile append 'no-message) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Now, `last-coding-system-used' has the right value. Remember it. - (setq coding-system-used last-coding-system-used)) - - ;; The permissions of the temporary file should be set. If - ;; FILENAME does not exist (eq modes nil) it has been - ;; renamed to the backup file. This case `save-buffer' - ;; handles permissions. - ;; Ensure that it is still readable. - (when modes - (set-file-modes tmpfile (logior (or modes 0) #o0400))) - - ;; This is a bit lengthy due to the different methods - ;; possible for file transfer. First, we check whether the - ;; method uses an scp program. If so, we call it. - ;; Otherwise, both encoding and decoding command must be - ;; specified. However, if the method _also_ specifies an - ;; encoding function, then that is used for encoding the - ;; contents of the tmp file. - (let* ((size (tramp-compat-file-attribute-size - (file-attributes tmpfile))) - (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) - (loc-enc (tramp-get-inline-coding v "local-encoding" size))) - (cond - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (if (and (not (stringp start)) - (= (or end (point-max)) (point-max)) - (= (or start (point-min)) (point-min)) - (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile)) - (progn - (setq tramp-temp-buffer-file-name tmpfile) - (condition-case err - ;; We keep the local file for performance - ;; reasons, useful for "rsync". - (copy-file tmpfile filename t) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err))))) - (setq tramp-temp-buffer-file-name nil) - ;; Don't rename, in order to keep context in SELinux. - (unwind-protect - (copy-file tmpfile filename t) - (delete-file tmpfile)))) - - ;; Use inline file transfer. - (rem-dec - ;; Encode tmpfile. + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (if (and (tramp-local-host-p v) + ;; `file-writable-p' calls `file-expand-file-name'. We + ;; cannot use `tramp-run-real-handler' therefore. + (file-writable-p (file-name-directory localname)) + (or (file-directory-p localname) + (file-writable-p localname))) + ;; Short track: if we are on the local host, we can run directly. + (let ((create-lockfiles (not file-locked))) + (write-region start end localname append 'no-message lockname)) + + (let* ((modes (tramp-default-file-modes + filename (and (eq mustbenew 'excl) 'nofollow))) + ;; We use this to save the value of + ;; `last-coding-system-used' after writing the tmp file. + ;; At the end of the function, we set + ;; `last-coding-system-used' to this saved value. This + ;; way, any intermediary coding systems used while + ;; talking to the remote shell or suchlike won't hose + ;; this variable. This approach was snarfed from + ;; ange-ftp.el. + coding-system-used + ;; Write region into a tmp file. This isn't really + ;; needed if we use an encoding function, but currently + ;; we use it always because this makes the logic simpler. + ;; We must also set `temporary-file-directory', because + ;; it could point to a remote directory. + (temporary-file-directory + tramp-compat-temporary-file-directory) + (tmpfile (or tramp-temp-buffer-file-name + (tramp-compat-make-temp-file filename)))) + + ;; If `append' is non-nil, we copy the file locally, and let + ;; the native `write-region' implementation do the job. + (when (and append (file-exists-p filename)) + (copy-file filename tmpfile 'ok)) + + ;; We say `no-message' here because we don't want the visited + ;; file modtime data to be clobbered from the temp file. We + ;; call `set-visited-file-modtime' ourselves later on. We + ;; must ensure that `file-coding-system-alist' matches + ;; `tmpfile'. + (let ((file-coding-system-alist + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) + (condition-case err + (write-region start end tmpfile append 'no-message) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Now, `last-coding-system-used' has the right value. + ;; Remember it. + (setq coding-system-used last-coding-system-used)) + + ;; The permissions of the temporary file should be set. If + ;; FILENAME does not exist (eq modes nil) it has been renamed + ;; to the backup file. This case `save-buffer' handles + ;; permissions. Ensure that it is still readable. + (when modes + (set-file-modes tmpfile (logior (or modes 0) #o0400))) + + ;; This is a bit lengthy due to the different methods possible + ;; for file transfer. First, we check whether the method uses + ;; an scp program. If so, we call it. Otherwise, both + ;; encoding and decoding command must be specified. However, + ;; if the method _also_ specifies an encoding function, then + ;; that is used for encoding the contents of the tmp file. + (let* ((size (file-attribute-size (file-attributes tmpfile))) + (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) + (loc-enc (tramp-get-inline-coding v "local-encoding" size))) + (cond + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (if (and (not (stringp start)) + (= (or end (point-max)) (point-max)) + (= (or start (point-min)) (point-min)) + (tramp-get-method-parameter + v 'tramp-copy-keep-tmpfile)) + (progn + (setq tramp-temp-buffer-file-name tmpfile) + (condition-case err + ;; We keep the local file for performance + ;; reasons, useful for "rsync". + (copy-file tmpfile filename t) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err))))) + (setq tramp-temp-buffer-file-name nil) + ;; Don't rename, in order to keep context in SELinux. (unwind-protect - (with-temp-buffer - (set-buffer-multibyte nil) - ;; Use encoding function or command. - (with-tramp-progress-reporter - v 3 (format-message - "Encoding local file `%s' using `%s'" - tmpfile loc-enc) - (if (functionp loc-enc) - ;; The following `let' is a workaround for - ;; the base64.el that comes with pgnus-0.84. - ;; If both of the following conditions are - ;; satisfied, it tries to write to a local - ;; file in default-directory, but at this - ;; point, default-directory is remote. - ;; (`call-process-region' can't write to - ;; remote files, it seems.) The file in - ;; question is a tmp file anyway. - (let ((coding-system-for-read 'binary) - (default-directory - tramp-compat-temporary-file-directory)) - (insert-file-contents-literally tmpfile) - (funcall loc-enc (point-min) (point-max))) - - (unless (zerop (tramp-call-local-coding-command - loc-enc tmpfile t)) - (tramp-error - v 'file-error - (concat "Cannot write to `%s', " - "local encoding command `%s' failed") - filename loc-enc)))) - - ;; Send buffer into remote decoding command which - ;; writes to remote file. Because this happens on - ;; the remote host, we cannot use the function. - (with-tramp-progress-reporter - v 3 (format-message - "Decoding remote file `%s' using `%s'" - filename rem-dec) - (goto-char (point-max)) - (unless (bolp) (newline)) - (tramp-send-command - v - (format - (concat rem-dec " <<'%s'\n%s%s") - (tramp-shell-quote-argument localname) - tramp-end-of-heredoc - (buffer-string) - tramp-end-of-heredoc)) - (tramp-barf-unless-okay - v nil - "Couldn't write region to `%s', decode using `%s' failed" - filename rem-dec) - ;; When `file-precious-flag' is set, the region is - ;; written to a temporary file. Check that the - ;; checksum is equal to that from the local tmpfile. - (when file-precious-flag - (erase-buffer) - (and - ;; cksum runs locally, if possible. - (zerop (tramp-call-process v "cksum" tmpfile t)) - ;; cksum runs remotely. - (tramp-send-command-and-check - v - (format - "cksum <%s" (tramp-shell-quote-argument localname))) - ;; ... they are different. - (not - (string-equal - (buffer-string) - (with-current-buffer (tramp-get-buffer v) - (buffer-string)))) - (tramp-error - v 'file-error - (concat "Couldn't write region to `%s'," - " decode using `%s' failed") - filename rem-dec))))) - - ;; Save exit. - (delete-file tmpfile))) + (copy-file tmpfile filename t) + (delete-file tmpfile)))) - ;; That's not expected. - (t - (tramp-error - v 'file-error - (concat "Method `%s' should specify both encoding and " - "decoding command or an scp program") - method)))) + ;; Use inline file transfer. + (rem-dec + ;; Encode tmpfile. + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + ;; Use encoding function or command. + (with-tramp-progress-reporter + v 3 (format-message + "Encoding local file `%s' using `%s'" + tmpfile loc-enc) + (if (functionp loc-enc) + ;; The following `let' is a workaround for the + ;; base64.el that comes with pgnus-0.84. If + ;; both of the following conditions are + ;; satisfied, it tries to write to a local + ;; file in default-directory, but at this + ;; point, default-directory is remote. + ;; (`call-process-region' can't write to + ;; remote files, it seems.) The file in + ;; question is a tmp file anyway. + (let ((coding-system-for-read 'binary) + (default-directory + tramp-compat-temporary-file-directory)) + (insert-file-contents-literally tmpfile) + (funcall loc-enc (point-min) (point-max))) + + (unless (zerop (tramp-call-local-coding-command + loc-enc tmpfile t)) + (tramp-error + v 'file-error + (concat "Cannot write to `%s', " + "local encoding command `%s' failed") + filename loc-enc)))) + + ;; Send buffer into remote decoding command which + ;; writes to remote file. Because this happens on + ;; the remote host, we cannot use the function. + (with-tramp-progress-reporter + v 3 (format-message + "Decoding remote file `%s' using `%s'" + filename rem-dec) + (goto-char (point-max)) + (unless (bolp) (newline)) + (tramp-send-command + v + (format + (concat rem-dec " <<'%s'\n%s%s") + (tramp-shell-quote-argument localname) + tramp-end-of-heredoc + (buffer-string) + tramp-end-of-heredoc)) + (tramp-barf-unless-okay + v nil + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec) + ;; When `file-precious-flag' is set, the region is + ;; written to a temporary file. Check that the + ;; checksum is equal to that from the local tmpfile. + (when file-precious-flag + (erase-buffer) + (and + ;; cksum runs locally, if possible. + (zerop (tramp-call-process v "cksum" tmpfile t)) + ;; cksum runs remotely. + (tramp-send-command-and-check + v + (format + "cksum <%s" + (tramp-shell-quote-argument localname))) + ;; ... they are different. + (not + (string-equal + (buffer-string) + (tramp-get-buffer-string (tramp-get-buffer v)))) + (tramp-error + v 'file-error + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec))))) - ;; Make `last-coding-system-used' have the right value. - (when coding-system-used - (setq last-coding-system-used coding-system-used)))) + ;; Save exit. + (delete-file tmpfile))) - (tramp-flush-file-properties v localname) + ;; That's not expected. + (t + (tramp-error + v 'file-error + (concat "Method `%s' should specify both encoding and " + "decoding command or an scp program") + method)))) - ;; We must protect `last-coding-system-used', now we have set it - ;; to its correct value. - (let (last-coding-system-used (need-chown t)) - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename 'integer))) - (set-visited-file-modtime - ;; We must pass modtime explicitly, because FILENAME can - ;; be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (or (tramp-compat-file-attribute-modification-time file-attr) - (current-time))) - (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid) - (= (tramp-compat-file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid filename uid gid)) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))))) + ;; Make `last-coding-system-used' have the right value. + (when coding-system-used + (setq last-coding-system-used coding-system-used)))))) (defvar tramp-vc-registered-file-names nil "List used to collect file names, which are checked during `vc-registered'.") @@ -3658,8 +3654,7 @@ Fall back to normal file name handler if no Tramp handler exists." (defun tramp-sh-file-name-handler-p (vec) "Whether VEC uses a method from `tramp-sh-file-name-handler'." (and (assoc (tramp-file-name-method vec) tramp-methods) - (eq (tramp-find-foreign-file-name-handler - (tramp-make-tramp-file-name vec nil 'nohop)) + (eq (tramp-find-foreign-file-name-handler vec) 'tramp-sh-file-name-handler))) ;; This must be the last entry, because `identity' always matches. @@ -3776,8 +3771,7 @@ Fall back to normal file name handler if no Tramp handler exists." "Read output from \"gio monitor\" and add corresponding `file-notify' events." (let ((events (process-get proc 'events)) (remote-prefix - (with-current-buffer (process-buffer proc) - (file-remote-p default-directory))) + (file-remote-p (tramp-get-default-directory (process-buffer proc)))) (rest-string (process-get proc 'rest-string)) pos) (when rest-string @@ -4812,7 +4806,7 @@ Goes through the list `tramp-inline-compress-commands'." ((stringp tramp-scp-strict-file-name-checking) tramp-scp-strict-file-name-checking) - ;; Determine the options. + ;; Determine the option. (t (setq tramp-scp-strict-file-name-checking "") (let ((case-fold-search t)) (ignore-errors @@ -4855,6 +4849,79 @@ Goes through the list `tramp-inline-compress-commands'." (setq tramp-scp-force-scp-protocol "-O"))))))) tramp-scp-force-scp-protocol))) +(defun tramp-scp-direct-remote-copying (vec1 vec2) + "Return the direct remote copying argument of the local scp." + (cond + ((or (not tramp-use-scp-direct-remote-copying) (null vec1) (null vec2) + (not (tramp-get-process vec1)) + (not (equal (tramp-file-name-port vec1) (tramp-file-name-port vec2))) + (null (assoc "%z" (tramp-get-method-parameter vec1 'tramp-copy-args))) + (null (assoc "%z" (tramp-get-method-parameter vec2 'tramp-copy-args)))) + "") + + ((let ((case-fold-search t)) + (and + ;; Check, whether "scp" supports "-R" option. + (with-tramp-connection-property nil "scp-R" + (when (executable-find "scp") + (with-temp-buffer + (tramp-call-process vec1 "scp" nil t nil "-R") + (goto-char (point-min)) + (not (search-forward-regexp + "\\(illegal\\|unknown\\) option -- R" nil 'noerror))))) + + ;; Check, that RemoteCommand is not used. + (with-tramp-connection-property + (tramp-get-process vec1) "ssh-remote-command" + (let ((command `("ssh" "-G" ,(tramp-file-name-host vec1)))) + (with-temp-buffer + (tramp-call-process + vec1 tramp-encoding-shell nil t nil + tramp-encoding-command-switch + (mapconcat #'identity command " ")) + (goto-char (point-min)) + (not (search-forward "remotecommand" nil 'noerror))))) + + ;; Check hostkeys. + (with-tramp-connection-property + (tramp-get-process vec1) + (concat "direct-remote-copying-" + (tramp-make-tramp-file-name vec2 'noloc)) + (let ((command + (append + `("ssh" "-G" ,(tramp-file-name-host vec2) "|" + "grep" "-i" "^hostname" "|" "cut" "-d\" \"" "-f2" "|" + "ssh-keyscan" "-f" "-") + (when (tramp-file-name-port vec2) + `("-p" ,(tramp-file-name-port 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. + (tramp-call-process + vec1 tramp-encoding-shell nil t nil tramp-encoding-command-switch + (mapconcat #'identity command " ")) + (goto-char (point-min)) + (while (and (not found) (not (eobp))) + (setq string + (buffer-substring + (line-beginning-position) (line-end-position)) + string + (and + (string-match "^[^# ]+ \\S-+ \\(\\S-+\\)$" string) + (match-string 1 string)) + found + (and string + (with-current-buffer (tramp-get-buffer vec1) + (goto-char (point-min)) + (search-forward string nil 'noerror)))) + (forward-line)) + found))))) + "-R") + + (t "-3"))) + (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." @@ -4949,8 +5016,7 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((current-host tramp-system-name) (target-alist (tramp-compute-multi-hops vec)) - ;; Needed for `tramp-get-remote-null-device'. - (previous-hop nil) + (previous-hop tramp-null-hop) ;; We will apply `tramp-ssh-controlmaster-options' ;; only for the first hop. (options (tramp-ssh-controlmaster-options vec)) @@ -5035,9 +5101,14 @@ connection if a previous connection has died for some reason." ;; Set password prompt vector. (tramp-set-connection-property p "password-vector" - (make-tramp-file-name - :method l-method :user l-user :domain l-domain - :host l-host :port l-port)) + (if (tramp-get-method-parameter + hop 'tramp-password-previous-hop) + (let ((pv (copy-tramp-file-name previous-hop))) + (setf (tramp-file-name-method pv) l-method) + pv) + (make-tramp-file-name + :method l-method :user l-user :domain l-domain + :host l-host :port l-port))) ;; Set session timeout. (when (tramp-get-method-parameter @@ -5473,7 +5544,7 @@ Nonexistent directories are removed from spec." (lambda (x) (and (stringp x) - (file-directory-p (tramp-make-tramp-file-name vec x 'nohop)) + (file-directory-p (tramp-make-tramp-file-name vec x)) x)) remote-path)))))) @@ -6015,9 +6086,6 @@ function cell is returned to be applied on a buffer." ;; ;; * 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. ;; @@ -6061,5 +6129,9 @@ function cell is returned to be applied on a buffer." ;; be to stipulate, as a directory or connection-local variable, an ;; additional rc file on the remote machine that is sourced every ;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306> +;; +;; * Support hostname canonicalization in ~/.ssh/config. +;; <https://stackoverflow.com/questions/70205232/> + ;;; tramp-sh.el ends here |