diff options
Diffstat (limited to 'lisp/net/tramp-sh.el')
| -rw-r--r-- | lisp/net/tramp-sh.el | 985 |
1 files changed, 403 insertions, 582 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bcdc014daba..f00434c1468 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -46,7 +46,6 @@ (defconst tramp-default-remote-shell "/bin/sh" "The default remote shell Tramp applies.") -;;;###tramp-autoload (defcustom tramp-inline-compress-start-size 4096 "The minimum size of compressing where inline transfer. When inline transfer, compress transferred data of file whose @@ -56,23 +55,12 @@ If it is nil, no compression at all will be applied." :group 'tramp :type '(choice (const nil) integer)) -;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 "Maximum file size where inline copying is preferred to an out-of-the-band copy. If it is nil, out-of-the-band copy will be used without a check." :group 'tramp :type '(choice (const nil) integer)) -;;;###tramp-autoload -(defcustom tramp-terminal-type "dumb" - "Value of TERM environment variable for logging in to remote host. -Because Tramp wants to parse the output of the remote shell, it is easily -confused by ANSI color escape sequences and suchlike. Often, shell init -files conditionalize this setup based on the TERM environment variable." - :group 'tramp - :type 'string) - -;;;###tramp-autoload (defcustom tramp-histfile-override "~/.tramp_history" "When invoking a shell, override the HISTFILE with this value. When setting to a string, it redirects the shell history to that @@ -115,13 +103,12 @@ detected as prompt when being sent on echoing hosts, therefore.") (defconst tramp-end-of-heredoc (md5 tramp-end-of-output) "String used to recognize end of heredoc strings.") -;;;###tramp-autoload -(defcustom tramp-use-ssh-controlmaster-options t +(defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt)) "Whether to use `tramp-ssh-controlmaster-options'. Set it to nil, if you use Control* or Proxy* options in your ssh configuration." :group 'tramp - :version "24.4" + :version "28.1" :type 'boolean) (defvar tramp-ssh-controlmaster-options nil @@ -138,6 +125,15 @@ depends on the installed local ssh version. The string is used in `tramp-methods'.") +(defvar tramp-scp-strict-file-name-checking nil + "Which scp strict file name checking argument to use. + +It is the string \"-T\" if supported by the local scp (since +release 8.0), otherwise the string \"\". If it is nil, it will +be auto-detected by Tramp. + +The string is used in `tramp-methods'.") + ;; Initialize `tramp-methods' with the supported methods. ;;;###tramp-autoload (tramp--with-startup @@ -173,8 +169,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") - ("-r") ("%c"))) + (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 @@ -182,14 +178,15 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") - ("-q") ("-r") ("%c"))) + ("%x") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) (add-to-list 'tramp-methods @@ -238,7 +235,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -412,16 +410,34 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh - '((tramp-parse-rhosts "/etc/hosts.equiv") + `((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") + ;; On W32 systems, the ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + "ssh/ssh_known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) + (tramp-parse-sconfig ,(expand-file-name + "ssh/ssh_config" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) (tramp-parse-shostkeys "/etc/ssh2/hostkeys") (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") (tramp-parse-rhosts "~/.rhosts") (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config") + ;; On W32 systems, the .ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + ".ssh/known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) + (tramp-parse-sconfig ,(expand-file-name + ".ssh/config" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) (tramp-parse-shostkeys "~/.ssh2/hostkeys") (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") @@ -444,7 +460,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty - ,(if (memq system-type '(windows-nt)) + ,(if (eq system-type 'windows-nt) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") @@ -477,70 +493,6 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh) (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)) -;; "getconf PATH" yields: -;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin -;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin -;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin -;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! -;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin -;; IRIX64: /usr/bin -;; QNAP QTS: --- -;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin -;;;###tramp-autoload -(defcustom tramp-remote-path - '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin" - "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin" - "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin" - "/opt/bin" "/opt/sbin" "/opt/local/bin") - "List of directories to search for executables on remote host. -For every remote host, this variable will be set buffer local, -keeping the list of existing directories on that host. - -You can use \"~\" in this list, but when searching for a shell which groks -tilde expansion, all directory names starting with \"~\" will be ignored. - -`Default Directories' represent the list of directories given by -the command \"getconf PATH\". It is recommended to use this -entry on head of this list, because these are the default -directories for POSIX compatible commands. On remote hosts which -do not offer the getconf command (like cygwin), the value -\"/bin:/usr/bin\" is used instead. This entry is represented in -the list by the special value `tramp-default-remote-path'. - -`Private Directories' are the settings of the $PATH environment, -as given in your `~/.profile'. This entry is represented in -the list by the special value `tramp-own-remote-path'." - :group 'tramp - :type '(repeat (choice - (const :tag "Default Directories" tramp-default-remote-path) - (const :tag "Private Directories" tramp-own-remote-path) - (string :tag "Directory")))) - -;;;###tramp-autoload -(defcustom tramp-remote-process-environment - '("ENV=''" "TMOUT=0" "LC_CTYPE=''" - "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat" - "autocorrect=" "correct=") - "List of environment variables to be set on the remote host. - -Each element should be a string of the form ENVVARNAME=VALUE. An -entry ENVVARNAME= disables the corresponding environment variable, -which might have been set in the init files like ~/.profile. - -Special handling is applied to some environment variables, -which should not be set here: - -The PATH environment variable should be set via `tramp-remote-path'. - -The TERM environment variable should be set via `tramp-terminal-type'. - -The INSIDE_EMACS environment variable will automatically be set -based on the Tramp and Emacs versions, and should not be set here." - :group 'tramp - :version "26.1" - :type '(repeat string)) - -;;;###tramp-autoload (defcustom tramp-sh-extra-args '(("/bash\\'" . "-noediting -norc -noprofile") ("/zsh\\'" . "-f +Z -V")) @@ -567,6 +519,7 @@ shell from reading its init file." (tramp-yn-prompt-regexp tramp-action-yn) (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) + (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -584,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is called.") '((tramp-password-prompt-regexp tramp-action-password) (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) + (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. @@ -1010,6 +964,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-exists-p . tramp-sh-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-sh-handle-file-local-copy) + (file-locked-p . tramp-handle-file-locked-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -1018,7 +973,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) @@ -1036,9 +991,11 @@ Format specifiers \"%s\" are replaced before the script is used.") (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) + (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) ;; `make-directory-internal' performed by default handler. + (make-lock-file-name . tramp-handle-make-lock-file-name) (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) @@ -1057,6 +1014,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) (unhandled-file-name-directory . ignore) + (unlock-file . tramp-handle-unlock-file) (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (write-region . tramp-sh-handle-write-region)) @@ -1626,49 +1584,6 @@ ID-FORMAT valid values are `string' and `integer'." (or (tramp-check-cached-permissions v ?r) (tramp-run-test "-r" filename))))) -;; When the remote shell is started, it looks for a shell which groks -;; tilde expansion. Here, we assume that all shells which grok tilde -;; expansion will also provide a `test' command which groks `-nt' (for -;; newer than). If this breaks, tell me about it and I'll try to do -;; something smarter about it. -(defun tramp-sh-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond ((not (file-exists-p file1)) nil) - ((not (file-exists-p file2)) t) - (t ;; We are sure both files exist at this point. We try to - ;; get the mtime of both files. If they are not equal to - ;; the "dont-know" value, then we subtract the times and - ;; obtain the result. - (let ((fa1 (file-attributes file1)) - (fa2 (file-attributes file2))) - (if (and - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa1) - tramp-time-dont-know)) - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa2) - tramp-time-dont-know))) - (time-less-p - (tramp-compat-file-attribute-modification-time fa2) - (tramp-compat-file-attribute-modification-time fa1)) - ;; If one of them is the dont-know value, then we can - ;; still try to run a shell command on the remote host. - ;; However, this only works if both files are Tramp - ;; files and both have the same method, same user, same - ;; host. - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "Files %s and %s must have same method, user, host" - file1 file2))) - (with-parsed-tramp-file-name file1 nil - (tramp-run-test2 - (tramp-get-test-nt-command v) file1 file2))))))) - ;; Functions implemented using the basic functions above. (defun tramp-sh-handle-file-directory-p (filename) @@ -1825,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; files. (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (string-match-p "/" filename) + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -1934,7 +1849,7 @@ ID-FORMAT valid values are `string' and `integer'." 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) (tramp-run-real-handler - 'copy-file + #'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)))) @@ -1975,7 +1890,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; We must do it file-wise. (tramp-run-real-handler - 'copy-directory + #'copy-directory (list dirname newname keep-date parents copy-contents))) ;; When newname did exist, we have wrong cached values. @@ -2031,7 +1946,7 @@ file names." (length (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes - (apply #'file-extended-attributes (list filename)))) + (file-extended-attributes filename))) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -2107,7 +2022,7 @@ file names." ;; errors, because ACL strings could be incompatible. (when attributes (ignore-errors - (apply #'set-file-extended-attributes (list newname attributes)))) + (set-file-extended-attributes newname attributes))) ;; In case of `rename', we must flush the cache of the source file. (when (and t1 (eq op 'rename)) @@ -2318,7 +2233,7 @@ The method used must be an out-of-band method." (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) + options source target remote-copy-program remote-copy-args p) (with-parsed-tramp-file-name (if t1 filename newname) nil (if (and t1 t2) @@ -2353,10 +2268,10 @@ The method used must be an out-of-band method." #'identity) (if t1 (tramp-make-copy-program-file-name v) - (tramp-unquote-shell-quote-argument filename))) + (tramp-compat-file-name-unquote filename))) target (if t2 (tramp-make-copy-program-file-name v) - (tramp-unquote-shell-quote-argument newname))) + (tramp-compat-file-name-unquote newname))) ;; Check for user. There might be an interactive setting. (setq user (or (tramp-file-name-user v) @@ -2370,53 +2285,38 @@ The method used must be an out-of-band method." (setq listener (number-to-string (+ 50000 (random 10000)))))) ;; Compose copy command. - (setq host (or host "") - user (or user "") - port (or port "") - spec (format-spec-make - ?t (tramp-get-connection-property - (tramp-get-connection-process v) "temp-file" "")) - options (format-spec (tramp-ssh-controlmaster-options v) spec) - spec (format-spec-make - ?h host ?u user ?p port ?r listener ?c options - ?k (if keep-date " " "") - ?n (concat "2>" (tramp-get-remote-null-device v))) + (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)) copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-keep-date (tramp-get-method-parameter v 'tramp-copy-keep-date) - copy-args - (delete - ;; " " has either been a replacement of "%k" (when - ;; keep-date argument is non-nil), or a replacement - ;; for the whole keep-date sublist. - " " - (dolist - (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args) - (setq copy-args - (append - copy-args - (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) - (if (member "" y) '(" ") y)))))) - - copy-env - (delq - nil + ;; " " 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) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (string-join x " "))) - (tramp-get-method-parameter v 'tramp-copy-env))) - + (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)) - - (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args)) - (setq remote-copy-args - (append - remote-copy-args - (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) - (if (member "" y) '(" ") y))))) + (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) @@ -2462,41 +2362,38 @@ The method used must be an out-of-band method." v "process-name" (buffer-name (current-buffer))) (tramp-set-connection-property v "process-buffer" (current-buffer)) - (while copy-env + (when copy-env (tramp-message - orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env)) - (setenv (pop copy-env) (pop copy-env))) + 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. - (let* ((command - (mapconcat - #'identity (append (list copy-program) copy-args) - " ")) - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (start-process-shell-command - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - command)))) - (tramp-message orig-vec 6 "%s" command) - (process-put p 'vector orig-vec) - (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. - (let ((tramp-local-end-of-line tramp-rsh-end-of-line)) - (tramp-process-actions - p v nil tramp-actions-copy-out-of-band)))) + (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) + + ;; 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") @@ -2684,12 +2581,9 @@ The method used must be an out-of-band method." (save-restriction (narrow-to-region beg-marker end-marker) ;; Check for "--dired" output. - (forward-line -2) - (when (looking-at-p "//SUBDIRED//") - (forward-line -1)) - (when (looking-at "//DIRED//\\s-+") - (let ((beg (match-end 0)) - (end (point-at-eol))) + (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror) + (let ((beg (match-beginning 1)) + (end (match-end 0))) ;; Now read the numeric positions of file names. (goto-char beg) (while (< (point) end) @@ -2699,7 +2593,7 @@ The method used must be an out-of-band method." ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t)))))) ;; Remove trailing lines. - (goto-char (point-at-bol)) + (beginning-of-line) (while (looking-at "//") (forward-line 1) (delete-region (match-beginning 0) (point)))) @@ -2709,8 +2603,8 @@ The method used must be an out-of-band method." (save-restriction (narrow-to-region beg-marker end-marker) ;; Some busyboxes are reluctant to discard colors. - (unless - (string-match-p "color" (tramp-get-connection-property v "ls" "")) + (unless (tramp-compat-string-search + "color" (tramp-get-connection-property v "ls" "")) (goto-char (point-min)) (while (re-search-forward tramp-display-escape-sequence-regexp nil t) (replace-match ""))) @@ -2780,66 +2674,75 @@ the result will be a local, non-Tramp, file name." (setq dir (or dir default-directory "/")) ;; Handle empty NAME. (when (zerop (length name)) (setq name ".")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory 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 - (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) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - ;; 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 "~") - (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)))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). - ;; `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)))))))) + ;; On MS Windows, some special file names are not returned properly + ;; by `file-name-absolute-p'. + (if (and (eq system-type 'windows-nt) + (string-match-p + (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name)) + (tramp-run-real-handler #'expand-file-name (list name dir)) + ;; 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 + (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) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname))) + ;; 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 "~") + (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)))) + ;; There might be a double slash, for example when "~/" + ;; expands to "/". Remove this. + (while (string-match "//" localname) + (setq localname (replace-match "/" t t localname))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) + ;; No tilde characters in file name, do normal + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `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))))))))) ;;; Remote commands: ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. -;; The complete STDERR buffer is available only when the process has -;; terminated. (defun tramp-sh-handle-make-process (&rest args) "Like `make-process' for Tramp files. -STDERR can also be a file name. If method parameter `tramp-direct-async' -and connection property \"direct-async-process\" are non-nil, an -alternative implementation will be used." +STDERR can also be a remote file name. If method parameter +`tramp-direct-async' and connection property +\"direct-async-process\" are non-nil, an alternative +implementation will be used." (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args @@ -2849,7 +2752,10 @@ alternative implementation will be used." (command (plist-get args :command)) (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) - (connection-type (plist-get args :connection-type)) + (connection-type + (if (plist-member args :connection-type) + (plist-get args :connection-type) + tramp-process-connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) (stderr (plist-get args :stderr))) @@ -2865,7 +2771,7 @@ alternative implementation will be used." (memq (car coding) coding-system-list) (memq (cdr coding) coding-system-list))) (signal 'wrong-type-argument (list #'symbolp coding))) - (unless (or (null connection-type) (memq connection-type '(pipe pty))) + (unless (memq connection-type '(nil pipe t pty)) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) @@ -2873,7 +2779,7 @@ alternative implementation will be used." (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (when (and (stringp stderr) (not (tramp-equal-remote default-directory stderr))) (signal 'file-error (list "Wrong stderr" stderr))) @@ -2885,9 +2791,9 @@ alternative implementation will be used." ;; STDERR can also be a file name. (tmpstderr (and stderr - (if (and (stringp stderr) (tramp-tramp-file-p stderr)) - (tramp-unquote-file-local-name stderr) - (tramp-make-tramp-temp-file v)))) + (tramp-unquote-file-local-name + (if (stringp stderr) + stderr (tramp-make-tramp-temp-name v))))) (remote-tmpstderr (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) @@ -2896,7 +2802,8 @@ alternative implementation will be used." ;; "-c", it might be that the arguments exceed the ;; command line length. Therefore, we modify the ;; command. - (heredoc (and (stringp program) + (heredoc (and (not (bufferp stderr)) + (stringp program) (string-match-p "sh$" program) (= (length args) 2) (string-equal "-c" (car args)) @@ -2925,18 +2832,13 @@ alternative implementation will be used." (env (dolist (elt (cons prompt process-environment) env) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match-p "=" elt) + (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) - (if (tramp-get-env-with-u-option v) - (setq env (append `("-u" ,elt) env)) - (setq uenv (cons elt uenv))))))) + (setq uenv (cons elt uenv)))))) + (env (setenv-internal + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (command (when (stringp program) - (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep) (format "cd %s && %s exec %s %s env %s %s" (tramp-shell-quote-argument localname) (if uenv @@ -2965,6 +2867,23 @@ alternative implementation will be used." tramp-current-connection p) + ;; Handle error buffer. + (when (bufferp stderr) + (with-current-buffer stderr + (setq buffer-read-only nil)) + ;; Create named pipe. + (tramp-send-command v (format "mknod %s p" tmpstderr)) + ;; Create stderr process. + (make-process + :name (buffer-name stderr) + :buffer stderr + :command `("cat" ,tmpstderr) + :coding coding + :noquery t + :filter nil + :sentinel #'ignore + :file-handler t)) + (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -2993,16 +2912,16 @@ alternative implementation will be used." (if (symbolp coding) coding (cdr coding)))) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) - ;; We call `tramp-maybe-open-connection', in - ;; order to cleanup the prompt afterwards. (catch 'suppress - (tramp-maybe-open-connection v) - (setq p (tramp-get-connection-process v)) ;; Set the pid of the remote shell. This is ;; needed when sending signals remotely. (let ((pid (tramp-send-command-and-read v "echo $$"))) + (setq p (tramp-get-connection-process v)) (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) + ;; Disable carriage return to newline translation. + (when (memq connection-type '(nil pipe)) + (tramp-send-command v "stty -icrnl")) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could have ;; trashed the connection buffer. Remove this. @@ -3030,40 +2949,22 @@ alternative implementation will be used." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) - ;; We must flush them here already; otherwise - ;; `rename-file', `delete-file' or - ;; `insert-file-contents' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") - ;; Copy tmpstderr file. - (when (and (stringp stderr) - (not (tramp-tramp-file-p stderr))) - (add-function - :after (process-sentinel p) - (lambda (_proc _msg) - (rename-file remote-tmpstderr stderr)))) - ;; Provide error buffer. This shows only - ;; initial error messages; messages arriving - ;; later on will be inserted when the process - ;; is deleted. The temporary file will exist - ;; until the process is deleted. + ;; Kill stderr process delete and named pipe. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally remote-tmpstderr)) - ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (when (file-exists-p remote-tmpstderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr nil nil nil 'replace)) + (ignore-errors + (while (accept-process-output + (get-buffer-process stderr) 0 nil t)) + (delete-process (get-buffer-process stderr))) + (ignore-errors (delete-file remote-tmpstderr))))) ;; Return process. p))) ;; Save exit. - (if (string-match-p tramp-temp-buffer-name (buffer-name)) + (if (string-prefix-p tramp-temp-buffer-name (buffer-name)) (ignore-errors (set-process-buffer p nil) (kill-buffer (current-buffer))) @@ -3137,7 +3038,7 @@ alternative implementation will be used." (when (and (numberp destination) (zerop destination)) (error "Implementation does not handle immediate return")) - (with-parsed-tramp-file-name default-directory nil + (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let (command env uenv input tmpinput stderr tmpstderr outbuf ret) ;; Compute command. (setq command (mapconcat #'tramp-shell-quote-argument @@ -3145,16 +3046,10 @@ alternative implementation will be used." ;; We use as environment the difference to toplevel `process-environment'. (dolist (elt process-environment) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match-p "=" elt) + (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) - (if (tramp-get-env-with-u-option v) - (setq env (append `("-u" ,elt) env)) - (setq uenv (cons elt uenv)))))) - (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep) + (setq uenv (cons elt uenv))))) + (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep) (when env (setq command (format @@ -3350,11 +3245,11 @@ alternative implementation will be used." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) -;; CCC grok LOCKNAME (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)) + (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) @@ -3363,25 +3258,31 @@ alternative implementation will be used." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((uid (or (tramp-compat-file-attribute-user-id + (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. - (let (file-name-handler-alist) - (and - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))))) + (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. - (tramp-run-real-handler - #'write-region - (list start end localname append 'no-message lockname)) + (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))) @@ -3414,13 +3315,11 @@ alternative implementation will be used." ;; file. We call `set-visited-file-modtime' ourselves later ;; on. We must ensure that `file-coding-system-alist' ;; matches `tmpfile'. - (let (file-name-handler-alist - (file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile))) + (let ((file-coding-system-alist + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) (condition-case err - (tramp-run-real-handler - #'write-region - (list start end tmpfile append 'no-message lockname)) + (write-region start end tmpfile append 'no-message) ((error quit) (setq tramp-temp-buffer-file-name nil) (delete-file tmpfile) @@ -3589,6 +3488,12 @@ alternative implementation will be used." ;; 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) (null visit) (stringp visit))) (tramp-message v 0 "Wrote %s" filename)) @@ -3762,6 +3667,8 @@ Fall back to normal file name handler if no Tramp handler exists." (setq file-name (expand-file-name file-name)) (with-parsed-tramp-file-name file-name nil (let ((default-directory (file-name-directory file-name)) + (process-environment + (cons "GIO_USE_FILE_MONITOR=help" process-environment)) command events filter p sequence) (cond ;; "inotifywait". @@ -3794,18 +3701,6 @@ Fall back to normal file name handler if no Tramp handler exists." '(created changed changes-done-hint moved deleted)) ((memq 'attribute-change flags) '(attribute-changed))) sequence `(,command "monitor" ,localname))) - ;; "gvfs-monitor-dir". - ((setq command (tramp-get-remote-gvfs-monitor-dir v)) - (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter - events - (cond - ((and (memq 'change flags) (memq 'attribute-change flags)) - '(created changed changes-done-hint moved deleted - attribute-changed)) - ((memq 'change flags) - '(created changed changes-done-hint moved deleted)) - ((memq 'attribute-change flags) '(attribute-changed))) - sequence `(,command ,localname))) ;; None. (t (tramp-error v 'file-notify-error @@ -3838,10 +3733,6 @@ Fall back to normal file name handler if no Tramp handler exists." (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) - ;; Set "gio-file-monitor" property if needed. - (when (string-equal (file-name-nondirectory command) "gio") - (tramp-set-connection-property - p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v))) p)))) (defun tramp-sh-gio-monitor-process-filter (proc string) @@ -3850,7 +3741,8 @@ Fall back to normal file name handler if no Tramp handler exists." (remote-prefix (with-current-buffer (process-buffer proc) (file-remote-p default-directory))) - (rest-string (process-get proc 'rest-string))) + (rest-string (process-get proc 'rest-string)) + pos) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) @@ -3862,93 +3754,72 @@ Fall back to normal file name handler if no Tramp handler exists." "changes done" "changes-done-hint" string) string (tramp-compat-string-replace "renamed to" "moved" string)) - ;; https://bugs.launchpad.net/bugs/1742946 - (when - (string-match-p "Monitoring not supported\\|No locations given" string) - (delete-process proc)) - - ;; Delete empty lines. - (setq string (tramp-compat-string-replace "\n\n" "\n" string)) - - (while (string-match - (eval-when-compile - (concat "^[^:]+:" - "[[:space:]]\\([^:]+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\([^:]+\\)\\)?$")) - string) - - (let* ((file (match-string 1 string)) - (file1 (match-string 4 string)) - (object - (list - proc - (list - (intern-soft (match-string 2 string))) - ;; File names are returned as absolute paths. We must - ;; add the remote prefix. - (concat remote-prefix file) - (when file1 (concat remote-prefix file1))))) - (setq string (replace-match "" nil nil string)) - ;; Usually, we would add an Emacs event now. Unfortunately, - ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the handler directly. - (when (member (cl-caadr object) events) - (tramp-compat-funcall - (lookup-key special-event-map [file-notify]) - `(file-notify ,object file-notify-callback))))) - ;; Save rest of the string. - (when (zerop (length string)) (setq string nil)) - (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) - -(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) - "Read output from \"gvfs-monitor-dir\" 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))) - (rest-string (process-get proc 'rest-string))) - (when rest-string - (tramp-message proc 10 "Previous string:\n%s" rest-string)) - (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Attribute change is returned in unused wording. - string (tramp-compat-string-replace - "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) - - (while (string-match - (concat "^[\n\r]*" - "Directory Monitor Event:[\n\r]+" - "Child = \\([^\n\r]+\\)[\n\r]+" - "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" - "Event = \\([^[:blank:]]+\\)[\n\r]+") - string) - (let* ((file (match-string 1 string)) - (file1 (match-string 3 string)) - (object - (list - proc - (list - (intern-soft - (tramp-compat-string-replace - "_" "-" (downcase (match-string 4 string))))) - ;; File names are returned as absolute paths. We must - ;; add the remote prefix. - (concat remote-prefix file) - (when file1 (concat remote-prefix file1))))) - (setq string (replace-match "" nil nil string)) - ;; Usually, we would add an Emacs event now. Unfortunately, - ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the handler directly. - (when (member (cl-caadr object) events) - (tramp-compat-funcall - (lookup-key special-event-map [file-notify]) - `(file-notify ,object file-notify-callback))))) + (catch 'doesnt-work + ;; https://bugs.launchpad.net/bugs/1742946 + (when + (string-match-p "Monitoring not supported\\|No locations given" string) + (delete-process proc) + (throw 'doesnt-work nil)) + + ;; Determine monitor name. + (unless (tramp-connection-property-p proc "gio-file-monitor") + (tramp-set-connection-property + proc "gio-file-monitor" + (cond + ;; We have seen this on cygwin gio and on emba. Let's make + ;; some assumptions. + ((string-match + "Can't find module 'help' specified in GIO_USE_FILE_MONITOR" string) + (setq pos (match-end 0)) + (cond + ((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor) + ((eq system-type 'cygwin) 'GPollFileMonitor) + (t nil))) + ;; TODO: What happens, if several monitor names are reported? + ((string-match "\ +Supported arguments for GIO_USE_FILE_MONITOR environment variable: +\\s-*\\([[:alpha:]]+\\) - 20" string) + (setq pos (match-end 0)) + (intern + (format "G%sFileMonitor" (capitalize (match-string 1 string))))) + (t (setq pos (length string)) nil))) + (setq string (substring string pos))) + + ;; Delete empty lines. + (setq string (tramp-compat-string-replace "\n\n" "\n" string)) + + (while (string-match + (eval-when-compile + (concat "^[^:]+:" + "[[:space:]]\\([^:]+\\):" + "[[:space:]]" (regexp-opt tramp-gio-events t) + "\\([[:space:]]\\([^:]+\\)\\)?$")) + string) + + (let* ((file (match-string 1 string)) + (file1 (match-string 4 string)) + (object + (list + proc + (list + (intern-soft (match-string 2 string))) + ;; File names are returned as absolute paths. We + ;; must add the remote prefix. + (concat remote-prefix file) + (when file1 (concat remote-prefix file1))))) + (setq string (replace-match "" nil nil string)) + ;; Usually, we would add an Emacs event now. Unfortunately, + ;; `unread-command-events' does not accept several events at + ;; once. Therefore, we apply the handler directly. + (when (member (cl-caadr object) events) + (tramp-compat-funcall + (lookup-key special-event-map [file-notify]) + `(file-notify ,object file-notify-callback)))))) ;; Save rest of the string. + (while (string-match "^\n" string) + (setq string (replace-match "" nil nil string))) (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) (process-put proc 'rest-string string))) @@ -4098,24 +3969,6 @@ Returns the exit code of the `test' program." switch (tramp-shell-quote-argument localname))))) -(defun tramp-run-test2 (format-string file1 file2) - "Run `test'-like program on the remote system, given FILE1, FILE2. -FORMAT-STRING contains the program name, switches, and place holders. -Returns the exit code of the `test' program. Barfs if the methods, -hosts, or files, disagree." - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "tramp-run-test2 only implemented for same method, user, host"))) - (with-parsed-tramp-file-name file1 v1 - (with-parsed-tramp-file-name file1 v2 - (tramp-send-command-and-check - v1 - (format format-string - (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname)))))) - (defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) "Regexp to determine remote SunOS.") @@ -4307,10 +4160,9 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format (concat - "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "exec env TERM='%s' INSIDE_EMACS='%s' " "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i") - tramp-terminal-type - (or (getenv "INSIDE_EMACS") emacs-version) tramp-version + tramp-terminal-type (tramp-inside-emacs) (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) (format "HISTFILE=%s" @@ -4463,7 +4315,7 @@ process to set up. VEC specifies the connection." ;; Use MULE to select the right EOL convention for communicating ;; with the process. (let ((cs (or (and (memq 'utf-8-hfs (coding-system-list)) - (string-match-p "^Darwin" uname) + (string-prefix-p "Darwin" uname) (cons 'utf-8-hfs 'utf-8-hfs)) (and (memq 'utf-8 (coding-system-list)) (string-match-p "utf-?8" (tramp-get-remote-locale vec)) @@ -4476,7 +4328,7 @@ process to set up. VEC specifies the connection." cs-encode (or (cdr cs) 'undecided) cs-encode (coding-system-change-eol-conversion - cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix))) + cs-encode (if (string-prefix-p "Darwin" uname) 'mac 'unix))) (tramp-send-command vec "(echo foo ; echo bar)" t) (goto-char (point-min)) (when (search-forward "\r" nil t) @@ -4526,7 +4378,7 @@ process to set up. VEC specifies the connection." ;; IRIX64 bash expands "!" even when in single quotes. This ;; destroys our shell functions, we must disable it. See ;; <https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>. - (when (string-match-p "^IRIX64" uname) + (when (string-prefix-p "IRIX64" uname) (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. @@ -4782,12 +4634,12 @@ means standard output and thus the current buffer), or nil (which means discard it)." (tramp-call-process nil tramp-encoding-shell - (when (and input (not (string-match-p "%s" cmd))) input) + (when (and input (not (tramp-compat-string-search "%s" cmd))) input) (if (eq output t) t nil) nil tramp-encoding-command-switch (concat - (if (string-match-p "%s" cmd) (format cmd input) cmd) + (if (tramp-compat-string-search "%s" cmd) (format cmd input) cmd) (if (stringp output) (concat " >" output) "")))) (defconst tramp-inline-compress-commands @@ -4918,6 +4770,33 @@ Goes through the list `tramp-inline-compress-commands'." " -o ControlPersist=no"))))))))) tramp-ssh-controlmaster-options))) +(defun tramp-scp-strict-file-name-checking (vec) + "Return the strict file name checking argument of the local scp." + (cond + ;; No options to be computed. + ((null (assoc "%x" (tramp-get-method-parameter vec 'tramp-copy-args))) + "") + + ;; There is already a value to be used. + ((stringp tramp-scp-strict-file-name-checking) + tramp-scp-strict-file-name-checking) + + ;; Determine the options. + (t (setq tramp-scp-strict-file-name-checking "") + (let ((case-fold-search t)) + (ignore-errors + (when (executable-find "scp") + (with-tramp-progress-reporter + vec 4 "Computing strict file name argument" + (with-temp-buffer + (tramp-call-process vec "scp" nil t nil "-T") + (goto-char (point-min)) + (unless + (search-forward-regexp + "\\(illegal\\|unknown\\) option -- T" nil t) + (setq tramp-scp-strict-file-name-checking "-T"))))))) + 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." @@ -4927,7 +4806,7 @@ If there is just some editing, retry it after 5 seconds." (progn (tramp-message vec 5 "Cannot timeout session, trying it again in %s seconds." 5) - (run-at-time 5 nil 'tramp-timeout-session vec)) + (run-at-time 5 nil #'tramp-timeout-session vec)) (tramp-message vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc)) (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes))) @@ -4982,10 +4861,12 @@ connection if a previous connection has died for some reason." (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) - (format "Opening connection for %s using %s" + (format "Opening connection %s for %s using %s" + process-name (tramp-file-name-host vec) (tramp-file-name-method vec)) - (format "Opening connection for %s@%s using %s" + (format "Opening connection %s for %s@%s using %s" + process-name (tramp-file-name-user vec) (tramp-file-name-host vec) (tramp-file-name-method vec))) @@ -5058,19 +4939,17 @@ connection if a previous connection has died for some reason." (l-domain (tramp-file-name-domain hop)) (l-host (tramp-file-name-host hop)) (l-port (tramp-file-name-port hop)) - (login-program - (tramp-get-method-parameter hop 'tramp-login-program)) - (login-args - (tramp-get-method-parameter hop 'tramp-login-args)) (remote-shell (tramp-get-method-parameter hop 'tramp-remote-shell)) (extra-args (tramp-get-sh-extra-args remote-shell)) (async-args - (tramp-get-method-parameter hop 'tramp-async-args)) + (tramp-compat-flatten-tree + (tramp-get-method-parameter hop 'tramp-async-args))) (connection-timeout (tramp-get-method-parameter hop 'tramp-connection-timeout)) - (command login-program) + (command + (tramp-get-method-parameter hop 'tramp-login-program)) ;; We don't create the temporary file. In ;; fact, it is just a prefix for the ;; ControlPath option of ssh; the real @@ -5084,11 +4963,7 @@ connection if a previous connection has died for some reason." (with-tramp-connection-property (tramp-get-process vec) "temp-file" (tramp-compat-make-temp-name))) - spec r-shell) - - ;; Add arguments for asynchronous processes. - (when (and process-name async-args) - (setq login-args (append async-args login-args))) + r-shell) ;; Check, whether there is a restricted shell. (dolist (elt tramp-restricted-shell-hosts-alist) @@ -5113,31 +4988,24 @@ connection if a previous connection has died for some reason." ;; Replace `login-args' place holders. (setq - l-host (or l-host "") - l-user (or l-user "") - l-port (or l-port "") - spec (format-spec-make ?t tmpfile) - options (format-spec options spec) - spec (format-spec-make - ?h l-host ?u l-user ?p l-port ?c options - ?l (concat remote-shell " " extra-args " -i")) command - (concat - ;; We do not want to see the trailing local - ;; prompt in `start-file-process'. - (unless r-shell "exec ") - command " " - (mapconcat - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) (string-join x " "))) - login-args " ") - ;; Local shell could be a Windows COMSPEC. It - ;; doesn't know the ";" syntax, but we must exit - ;; always for `start-file-process'. It could - ;; also be a restricted shell, which does not - ;; allow "exec". - (when r-shell " && exit || exit"))) + (mapconcat + #'identity + (append + ;; We do not want to see the trailing local + ;; prompt in `start-file-process'. + (unless r-shell '("exec")) + `(,command) + ;; Add arguments for asynchronous processes. + (when process-name async-args) + (tramp-expand-args + hop 'tramp-login-args + ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") + ?c (format-spec options (format-spec-make ?t tmpfile)) + ?l (concat remote-shell " " extra-args " -i")) + ;; A restricted shell does not allow "exec". + (when r-shell '("&&" "exit" "||" "exit"))) + " ")) ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) @@ -5158,7 +5026,7 @@ connection if a previous connection has died for some reason." (when (tramp-get-connection-property p "session-timeout" nil) (run-at-time (tramp-get-connection-property p "session-timeout" nil) nil - 'tramp-timeout-session vec)) + #'tramp-timeout-session vec)) ;; Make initial shell settings. (tramp-open-connection-setup-interactive-shell p vec) @@ -5361,7 +5229,7 @@ Return ATTR." (when (stringp (car attr)) (aset (nth 8 attr) 0 ?l))) ;; Convert directory indication bit. - (when (string-match-p "^d" (nth 8 attr)) + (when (string-prefix-p "d" (nth 8 attr)) (setcar attr t)) ;; Convert symlink from `tramp-do-file-attributes-with-stat'. ;; Decode also multibyte string. @@ -5423,15 +5291,16 @@ Return ATTR." (directory-file-name (tramp-file-name-unquote-localname vec)))) (when (string-match-p tramp-ipv6-regexp host) (setq host (format "[%s]" host))) + ;; This does not work for MS Windows scp, if there are characters + ;; to be quoted. OpenSSH 8 supports disabling of strict file name + ;; checking in scp, we use it when available. (unless (string-match-p "ftp$" method) - (setq localname (tramp-shell-quote-argument localname))) + (setq localname (tramp-unquote-shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) - ((not (zerop (length user))) - (format - "%s@%s:%s" user host (tramp-unquote-shell-quote-argument localname))) - (t (format "%s:%s" host (tramp-unquote-shell-quote-argument localname)))))) + ((zerop (length user)) (format "%s:%s" host localname)) + (t (format "%s@%s:%s" user host localname))))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." @@ -5459,8 +5328,7 @@ Nonexistent directories are removed from spec." ;; cache the result for the session only. Otherwise, the ;; result is cached persistently. (if (memq 'tramp-own-remote-path tramp-remote-path) - (tramp-get-process vec) - vec) + (tramp-get-process vec) vec) "remote-path" (let* ((remote-path (copy-tree tramp-remote-path)) (elt1 (memq 'tramp-default-remote-path remote-path)) @@ -5478,7 +5346,7 @@ Nonexistent directories are removed from spec." (progn (tramp-message vec 3 - "`getconf PATH' not successful, using default value \"%s\"." + "`getconf PATH' not successful, using default value \"%s\"." "/bin:/usr/bin") "/bin:/usr/bin")))) (own-remote-path @@ -5682,15 +5550,15 @@ Nonexistent directories are removed from spec." ;; Check whether stat(1) returns usable syntax. "%s" does not ;; work on older AIX systems. Recent GNU stat versions ;; (8.24?) use shell quoted format for "%N", we check the - ;; boundaries "`" and "'", therefore. See Bug#23422 in - ;; coreutils. Since GNU stat 8.26, environment variable - ;; QUOTING_STYLE is supported. + ;; boundaries "`" and "'" and their localized variants, + ;; therefore. See Bug#23422 in coreutils. Since GNU stat + ;; 8.26, environment variable QUOTING_STYLE is supported. (when result (setq result (concat "env QUOTING_STYLE=locale " result) tmp (tramp-send-command-and-read vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) - (string-match-p "^\\(`/'\\|‘/’\\)$" (car tmp)) + (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp)) (integerp (cadr tmp))) (setq result nil))) result)))) @@ -5765,42 +5633,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (tramp-message vec 5 "Finding a suitable `gio-monitor' command") (tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t))) -(defun tramp-get-remote-gio-file-monitor (vec) - "Determine remote GFileMonitor." - (with-tramp-connection-property vec "gio-file-monitor" - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 5 "Finding the used GFileMonitor") - (when-let ((gio (tramp-get-remote-gio-monitor vec))) - ;; Search for the used FileMonitor. There is no known way to - ;; get this information directly from gio, so we check for - ;; linked libraries of libgio. - (when (tramp-send-command-and-check vec (concat "ldd " gio)) - (goto-char (point-min)) - (when (re-search-forward "\\S-+/libgio\\S-+") - (when (tramp-send-command-and-check - vec (concat "strings " (match-string 0))) - (goto-char (point-min)) - (re-search-forward - (format - "^%s$" - (regexp-opt - '("GFamFileMonitor" "GFenFileMonitor" - "GInotifyFileMonitor" "GKqueueFileMonitor"))) - nil 'noerror) - (intern (match-string 0))))))))) - -(defun tramp-get-remote-gvfs-monitor-dir (vec) - "Determine remote `gvfs-monitor-dir' command." - (with-tramp-connection-property vec "gvfs-monitor-dir" - (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") - ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to - ;; establish better timeouts in filenotify-tests.el. Any better - ;; distinction approach would be welcome! - (or (tramp-find-executable - vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t) - (tramp-find-executable - vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t)))) - (defun tramp-get-remote-inotifywait (vec) "Determine remote `inotifywait' command." (with-tramp-connection-property vec "inotifywait" @@ -5945,16 +5777,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile))) (delete-file tmpfile))))) -(defun tramp-get-env-with-u-option (vec) - "Check, whether the remote `env' command supports the -u option." - (with-tramp-connection-property vec "env-u-option" - (tramp-message vec 5 "Checking, whether `env -u' works") - ;; Option "-u" is a GNU extension. - (tramp-send-command-and-check - vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO" - (tramp-get-remote-null-device vec)) - t))) - ;; Some predefined connection properties. (defun tramp-get-inline-compress (vec prop size) "Return the compress command related to PROP. @@ -5987,12 +5809,13 @@ function cell is returned to be applied on a buffer." (with-tramp-connection-property (tramp-get-process vec) prop (tramp-find-inline-encoding vec) (tramp-get-connection-property (tramp-get-process vec) prop nil))) - (prop1 (if (string-match-p "encoding" prop) + (prop1 (if (tramp-compat-string-search "encoding" prop) "inline-compress" "inline-decompress")) compress) ;; The connection property might have been cached. So we must ;; send the script to the remote side - maybe. - (when (and coding (symbolp coding) (string-match-p "remote" prop)) + (when (and coding (symbolp coding) + (tramp-compat-string-search "remote" prop)) (let ((name (symbol-name coding))) (while (string-match "-" name) (setq name (replace-match "_" nil t name))) @@ -6004,7 +5827,7 @@ function cell is returned to be applied on a buffer." ;; Return the value. (cond ((and compress (symbolp coding)) - (if (string-match-p "decompress" prop1) + (if (tramp-compat-string-search "decompress" prop1) `(lambda (beg end) (,coding beg end) (let ((coding-system-for-write 'binary) @@ -6023,16 +5846,16 @@ function cell is returned to be applied on a buffer." (,coding (point-min) (point-max))))) ((symbolp coding) coding) - ((and compress (string-match-p "decoding" prop)) + ((and compress (tramp-compat-string-search "decoding" prop)) (format ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. (cond - ((and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + ((and (tramp-compat-string-search "local" prop) + (eq system-type 'windows-nt)) "(%s | \"%s\")") - ((string-match-p "local" prop) "(%s | %s)") + ((tramp-compat-string-search "local" prop) "(%s | %s)") (t "(%s | %s >%%s)")) coding compress)) (compress @@ -6040,14 +5863,14 @@ function cell is returned to be applied on a buffer." ;; Windows shells need the program file name after ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. - (if (and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (if (and (tramp-compat-string-search "local" prop) + (eq system-type 'windows-nt)) "(%s <%%s | \"%s\")" "(%s <%%s | %s)") compress coding)) - ((string-match-p "decoding" prop) + ((tramp-compat-string-search "decoding" prop) (cond - ((string-match-p "local" prop) (format "%s" coding)) + ((tramp-compat-string-search "local" prop) (format "%s" coding)) (t (format "%s >%%s" coding)))) (t (format "%s <%%s" coding))))))) @@ -6143,8 +5966,6 @@ function cell is returned to be applied on a buffer." ;; session could be reused after a connection loss. Use dtach, or ;; screen, or tmux, or mosh. ;; -;; * Implement `:stderr' of `make-process' as pipe process. - ;; * One interesting solution (with other applications as well) would ;; be to stipulate, as a directory or connection-local variable, an ;; additional rc file on the remote machine that is sourced every |