diff options
Diffstat (limited to 'lisp/net/tramp.el')
| -rw-r--r-- | lisp/net/tramp.el | 699 |
1 files changed, 536 insertions, 163 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 690dd99ae55..83df05c24b7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -64,6 +64,10 @@ (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) +;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package. +;;;###autoload (when (featurep 'tramp-compat) +;;;###autoload (load "tramp-compat" 'noerror 'nomessage)) + ;;; User Customizable Internal Variables: (defgroup tramp nil @@ -105,7 +109,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are 7 file caching 8 connection properties 9 test commands -10 traces (huge)." +10 traces (huge) +11 call traces (maintainer only)." :type 'integer) (defcustom tramp-debug-to-file nil @@ -248,6 +253,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: - \"%c\" adds additional `tramp-ssh-controlmaster-options' options for the first hop. - \"%n\" expands to \"2>/dev/null\". + - \"%x\" is replaced by the `tramp-scp-strict-file-name-checking' + argument if it is supported. The existence of `tramp-login-args', combined with the absence of `tramp-copy-args', is an indication that the @@ -354,12 +361,13 @@ Notes: All these arguments can be overwritten by connection properties. See Info node `(tramp) Predefined connection information'. -When using `su' or `sudo' the phrase \"open connection to a remote -host\" sounds strange, but it is used nevertheless, for consistency. -No connection is opened to a remote host, but `su' or `sudo' is -started on the local host. You should specify a remote host -`localhost' or the name of the local host. Another host name is -useful only in combination with `tramp-default-proxies-alist'.") +When using `su', `sudo' or `doas' the phrase \"open connection to +a remote host\" sounds strange, but it is used nevertheless, for +consistency. No connection is opened to a remote host, but `su', +`sudo' or `doas' is started on the local host. You should +specify a remote host `localhost' or the name of the local host. +Another host name is useful only in combination with +`tramp-default-proxies-alist'.") (defcustom tramp-default-method ;; An external copy method seems to be preferred, because it performs @@ -386,6 +394,8 @@ Also see `tramp-default-method-alist'." :type 'string) (defcustom tramp-default-method-alist nil + ;; FIXME: This is not an "alist", because its elements are not of + ;; the form (KEY . VAL) but (KEY1 KEY2 VAL). "Default method to use for specific host/user pairs. This is an alist of items (HOST USER METHOD). The first matching item specifies the method to use for a file name which does not specify a @@ -413,6 +423,8 @@ This variable is regarded as obsolete, and will be removed soon." :type '(choice (const nil) string)) (defcustom tramp-default-user-alist nil + ;; FIXME: This is not an "alist", because its elements are not of + ;; the form (KEY . VAL) but (KEY1 KEY2 VAL). "Default user to use for specific method/host pairs. This is an alist of items (METHOD HOST USER). The first matching item specifies the user to use for a file name which does not specify a @@ -432,6 +444,8 @@ Useful for su and sudo methods mostly." :type 'string) (defcustom tramp-default-host-alist nil + ;; FIXME: This is not an "alist", because its elements are not of + ;; the form (KEY . VAL) but (KEY1 KEY2 VAL). "Default host to use for specific method/user pairs. This is an alist of items (METHOD USER HOST). The first matching item specifies the host to use for a file name which does not specify a @@ -447,6 +461,8 @@ empty string for the method name." (choice :tag " Host name" string (const nil))))) (defcustom tramp-default-proxies-alist nil + ;; FIXME: This is not an "alist", because its elements are not of + ;; the form (KEY . VAL) but (KEY1 KEY2 VAL). "Route to be followed for specific host/user pairs. This is an alist of items (HOST USER PROXY). The first matching item specifies the proxy to be passed for a file name located on @@ -479,7 +495,7 @@ interpreted as a regular expression which always matches." ;; either lower case or upper case letters. See ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>. (defcustom tramp-restricted-shell-hosts-alist - (when (memq system-type '(windows-nt)) + (when (eq system-type 'windows-nt) (list (format "\\`\\(%s\\|%s\\)\\'" (regexp-quote (downcase tramp-system-name)) (regexp-quote (upcase tramp-system-name))))) @@ -549,7 +565,7 @@ usually suffice.") the remote shell.") (defcustom tramp-local-end-of-line - (if (memq system-type '(windows-nt)) "\r\n" "\n") + (if (eq system-type 'windows-nt) "\r\n" "\n") "String used for end of line in local processes." :version "24.1" :type 'string) @@ -570,8 +586,7 @@ Sometimes the prompt is reported to look like \"login as:\"." (defcustom tramp-shell-prompt-pattern ;; Allow a prompt to start right after a ^M since it indeed would be - ;; displayed at the beginning of the line (and Zsh uses it). This - ;; regexp works only for GNU Emacs. + ;; displayed at the beginning of the line (and Zsh uses it). ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. (concat "\\(?:^\\|\r\\)" @@ -652,6 +667,14 @@ The regexp should match at end of buffer. See also `tramp-yesno-prompt-regexp'." :type 'regexp) +(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) + (defcustom tramp-terminal-prompt-regexp (concat "\\(" "TERM = (.*)" @@ -674,6 +697,23 @@ The regexp should match at end of buffer." :version "27.1" :type 'regexp) +;; A security key requires the user physically to touch the device +;; with their finger. We must tell it to the user. +;; Added in OpenSSH 8.2. I've tested it with yubikey. +(defcustom tramp-security-key-confirm-regexp + "^\r*Confirm user presence for key .*[\r\n]*" + "Regular expression matching security key confirmation message. +The regexp should match at end of buffer." + :version "28.1" + :type 'regexp) + +(defcustom tramp-security-key-confirmed-regexp + "^\r*User presence confirmed[\r\n]*" + "Regular expression matching security key confirmation message. +The regexp should match at end of buffer." + :version "28.1" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" (regexp-opt '("Operation not permitted") t)) @@ -1061,7 +1101,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") (defconst tramp-completion-file-name-regexp-default (concat - "\\`/\\(" + "\\`" + ;; `file-name-completion' uses absolute paths for matching. This + ;; means that on W32 systems, something like "/ssh:host:~/path" + ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]+:[^/|:]*|\\)*" ;; Last hop. @@ -1080,7 +1126,13 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-simplified (concat - "\\`/\\(" + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]*|\\)*" ;; Last hop. @@ -1096,7 +1148,14 @@ See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate - "\\`/\\(\\[[^]]*\\)?\\'" + (concat + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(\\[[^]]*\\)?\\'") "Value for `tramp-completion-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") @@ -1205,14 +1264,14 @@ this variable to be set as well." :type '(choice (const nil) integer)) ;; Logging in to a remote host normally requires obtaining a pty. But -;; Emacs on macOS has process-connection-type set to nil by default, +;; Emacs on macOS has `process-connection-type' set to nil by default, ;; so on those systems Tramp doesn't obtain a pty. Here, we allow ;; for an override of the system default. (defcustom tramp-process-connection-type t "Overrides `process-connection-type' for connections from Tramp. Tramp binds `process-connection-type' to the value given here before opening a connection to a remote host." - :type '(choice (const nil) (const t) (const pty))) + :type '(choice (const nil) (const t) (const pipe) (const pty))) (defcustom tramp-connection-timeout 60 "Defines the max time to wait for establishing a connection (in seconds). @@ -1235,6 +1294,67 @@ let-bind this variable." :version "24.4" :type '(choice (const nil) integer)) +;; "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 +(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")))) + +(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)) + (defcustom tramp-completion-reread-directory-timeout 10 "Defines seconds since last remote command before rereading a directory. A remote directory might have changed its contents. In order to @@ -1287,6 +1407,14 @@ calling HANDLER.") (cl-defstruct (tramp-file-name (:type list) :named) method user domain host port localname hop) +(put #'tramp-file-name-method 'tramp-suppress-trace t) +(put #'tramp-file-name-user 'tramp-suppress-trace t) +(put #'tramp-file-name-domain 'tramp-suppress-trace t) +(put #'tramp-file-name-host 'tramp-suppress-trace t) +(put #'tramp-file-name-port 'tramp-suppress-trace t) +(put #'tramp-file-name-localname 'tramp-suppress-trace t) +(put #'tramp-file-name-hop 'tramp-suppress-trace t) + (defun tramp-file-name-user-domain (vec) "Return user and domain components of VEC." (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec)) @@ -1295,6 +1423,8 @@ calling HANDLER.") tramp-prefix-domain-format) (tramp-file-name-domain vec)))) +(put #'tramp-file-name-user-domain 'tramp-suppress-trace t) + (defun tramp-file-name-host-port (vec) "Return host and port components of VEC." (when (or (tramp-file-name-host vec) (tramp-file-name-port vec)) @@ -1303,12 +1433,16 @@ calling HANDLER.") tramp-prefix-port-format) (tramp-file-name-port vec)))) +(put #'tramp-file-name-host-port 'tramp-suppress-trace t) + (defun tramp-file-name-port-or-default (vec) "Return port component of VEC. If nil, return `tramp-default-port'." (or (tramp-file-name-port vec) (tramp-get-method-parameter vec 'tramp-default-port))) +(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t) + ;; Comparison of file names is performed by `tramp-equal-remote'. (defun tramp-file-name-equal-p (vec1 vec2) "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." @@ -1355,6 +1489,8 @@ entry does not exist, return nil." (string-match-p tramp-file-name-regexp name) t)) +(put #'tramp-tramp-file-p 'tramp-suppress-trace t) + ;; This function bypasses the file name handler approach. It is NOT ;; recommended to use it in any package if not absolutely necessary. ;; However, it is more performant than `file-local-name', and might be @@ -1403,6 +1539,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in result (propertize result 'tramp-default t)))) +(put #'tramp-find-method 'tramp-suppress-trace t) + (defun tramp-find-user (method user host) "Return the right user string to use depending on METHOD and HOST. This is USER, if non-nil. Otherwise, do a lookup in @@ -1424,6 +1562,8 @@ This is USER, if non-nil. Otherwise, do a lookup in result (propertize result 'tramp-default t)))) +(put #'tramp-find-user 'tramp-suppress-trace t) + (defun tramp-find-host (method user host) "Return the right host string to use depending on METHOD and USER. This is HOST, if non-nil. Otherwise, do a lookup in @@ -1445,6 +1585,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in result (propertize result 'tramp-default t)))) +(put #'tramp-find-host 'tramp-suppress-trace t) + (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure of NAME, a remote file name. The structure consists of method, user, domain, host, port, @@ -1483,7 +1625,8 @@ default values are used." (setq v (tramp-dissect-hop-name hop) hop (and hop (tramp-make-tramp-hop-name v)))) (let ((tramp-default-host - (or (and v (not (string-match-p "%h" (tramp-file-name-host v))) + (or (and v (not (tramp-compat-string-search + "%h" (tramp-file-name-host v))) (tramp-file-name-host v)) tramp-default-host))) (setq method (tramp-find-method method user host) @@ -1509,6 +1652,8 @@ default values are used." (tramp-user-error v "Method `%s' is not supported for multi-hops." method))))))) +(put #'tramp-dissect-file-name 'tramp-suppress-trace t) + (defun tramp-dissect-hop-name (name &optional nodefault) "Return a `tramp-file-name' structure of `hop' part of NAME. See `tramp-dissect-file-name' for details." @@ -1526,6 +1671,8 @@ See `tramp-dissect-file-name' for details." ;; Return result. v)) +(put #'tramp-dissect-hop-name 'tramp-suppress-trace t) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) @@ -1535,6 +1682,8 @@ See `tramp-dissect-file-name' for details." (format "*tramp/%s %s@%s*" method user-domain host-port) (format "*tramp/%s %s*" method host-port)))) +(put #'tramp-buffer-name 'tramp-suppress-trace t) + (defun tramp-make-tramp-file-name (&rest args) "Construct a Tramp file name from ARGS. @@ -1702,6 +1851,8 @@ version, the function does nothing." (format "*debug tramp/%s %s@%s*" method user-domain host-port) (format "*debug tramp/%s %s*" method host-port)))) +(put #'tramp-debug-buffer-name 'tramp-suppress-trace t) + (defconst tramp-debug-outline-regexp (concat "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. @@ -1710,6 +1861,10 @@ version, the function does nothing." "Used for highlighting Tramp debug buffers in `outline-mode'.") (defconst tramp-debug-font-lock-keywords + ;; FIXME: Make it a function instead of an ELisp expression, so you + ;; can evaluate it with `funcall' rather than `eval'! + ;; Also, in `font-lock-defaults' you can specify a function name for + ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords! '(list (concat "^\\(?:" tramp-debug-outline-regexp "\\).+") '(1 font-lock-warning-face t t) @@ -1723,10 +1878,13 @@ Point must be at the beginning of a header line. The outline level is equal to the verbosity of the Tramp message." (1+ (string-to-number (match-string 2)))) +(put #'tramp-debug-outline-level 'tramp-suppress-trace t) + (defun tramp-get-debug-buffer (vec) "Get the debug buffer for VEC." (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec)) (when (bobp) + (set-buffer-file-coding-system 'utf-8) (setq buffer-undo-list t) ;; Activate `outline-mode'. This runs `text-mode-hook' and ;; `outline-mode-hook'. We must prevent that local processes @@ -1738,19 +1896,35 @@ The outline level is equal to the verbosity of the Tramp message." (outline-mode)) (setq-local outline-level 'tramp-debug-outline-level) (setq-local font-lock-keywords - `(t (eval ,tramp-debug-font-lock-keywords) - ,(eval tramp-debug-font-lock-keywords))) + ;; FIXME: This `(t FOO . BAR)' representation in + ;; `font-lock-keywords' is supposed to be an + ;; internal implementation "detail". Don't abuse it here! + `(t (eval ,tramp-debug-font-lock-keywords t) + ,(eval tramp-debug-font-lock-keywords t))) ;; Do not edit the debug buffer. (use-local-map special-mode-map)) (current-buffer))) +(put #'tramp-get-debug-buffer 'tramp-suppress-trace t) + (defun tramp-get-debug-file-name (vec) - "Get the debug buffer for VEC." + "Get the debug file name for VEC." (expand-file-name (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec)) (tramp-compat-temporary-file-directory))) -(defsubst tramp-debug-message (vec fmt-string &rest arguments) +(put #'tramp-get-debug-file-name 'tramp-suppress-trace t) + +(defun tramp-trace-buffer-name (vec) + "A name for the trace buffer for VEC." + (tramp-compat-string-replace "debug" "trace" (tramp-debug-buffer-name vec))) + +(put #'tramp-trace-buffer-name 'tramp-suppress-trace t) + +(defvar tramp-trace-functions nil + "A list of non-Tramp functions to be traced with tramp-verbose > 10.") + +(defun tramp-debug-message (vec fmt-string &rest arguments) "Append message to debug buffer of VEC. Message is formatted with FMT-STRING as control string and the remaining ARGUMENTS to actually emit the message (if applicable)." @@ -1760,11 +1934,11 @@ ARGUMENTS to actually emit the message (if applicable)." (with-current-buffer (tramp-get-debug-buffer vec) (goto-char (point-max)) (let ((point (point))) - ;; Headline. (when (bobp) + ;; Headline. (insert (format - ";; Emacs: %s Tramp: %s -*- mode: outline; -*-" + ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-" emacs-version tramp-version)) (when (>= tramp-verbose 10) (let ((tramp-verbose 0)) @@ -1774,6 +1948,15 @@ ARGUMENTS to actually emit the message (if applicable)." (locate-library "tramp") (or tramp-repository-branch "") (or tramp-repository-version ""))))) + ;; Traces. + (when (>= tramp-verbose 11) + (dolist + (elt + (append + (mapcar #'intern (all-completions "tramp-" obarray 'functionp)) + tramp-trace-functions)) + (unless (get elt 'tramp-suppress-trace) + (trace-function-background elt)))) ;; Delete debug file. (when (and tramp-debug-to-file (tramp-get-debug-file-name vec)) (ignore-errors (delete-file (tramp-get-debug-file-name vec))))) @@ -1791,7 +1974,7 @@ ARGUMENTS to actually emit the message (if applicable)." (if (not btf) (setq fn "") (and (symbolp btf) (setq fn (symbol-name btf)) - (or (not (string-match-p "^tramp" fn)) + (or (not (string-prefix-p "tramp" fn)) (get btf 'tramp-suppress-trace)) (setq fn nil)) (setq btn (1+ btn)))) @@ -1882,7 +2065,7 @@ function is meant for debugging purposes." (put #'tramp-backtrace 'tramp-suppress-trace t) -(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) +(defun tramp-error (vec-or-proc signal fmt-string &rest arguments) "Emit an error. VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to @@ -2043,7 +2226,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', "Report progress of an operation for Tramp." (let* ((parameters (cdr reporter)) (message (aref parameters 3))) - (when (string-match-p message (or (current-message) "")) + (when (tramp-compat-string-search message (or (current-message) "")) (tramp-compat-progress-reporter-update reporter value suffix)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) @@ -2083,14 +2266,15 @@ without a visible progress reporter." FILE must be a local file name on a connection identified via VEC." (declare (indent 3) (debug t)) `(if (file-name-absolute-p ,file) - (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass @body as parameter to - ;; `tramp-set-file-property' because it mangles our - ;; debug messages. - (setq value (progn ,@body)) - (tramp-set-file-property ,vec ,file ,property value)) - value) + (let ((value (tramp-get-file-property + ,vec ,file ,property tramp-cache-undefined))) + (when (eq value tramp-cache-undefined) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) ,@body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) @@ -2098,14 +2282,15 @@ FILE must be a local file name on a connection identified via VEC." (defmacro with-tramp-connection-property (key property &rest body) "Check in Tramp for property PROPERTY, otherwise execute BODY and set." (declare (indent 2) (debug t)) - `(let ((value (tramp-get-connection-property ,key ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass ,@body as parameter to - ;; `tramp-set-connection-property' because it mangles our debug - ;; messages. - (setq value (progn ,@body)) - (tramp-set-connection-property ,key ,property value)) - value)) + `(let ((value (tramp-get-connection-property + ,key ,property tramp-cache-undefined))) + (when (eq value tramp-cache-undefined) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) @@ -2155,7 +2340,7 @@ Example: (unless (and (functionp (nth 0 (car v))) (cond ;; Windows registry. - ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v))) + ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process @@ -2287,6 +2472,8 @@ Must be handled by the callers." file-name-case-insensitive-p ;; Emacs 27+ only. file-system-info + ;; Emacs 28+ only. + file-locked-p lock-file make-lock-file-name unlock-file ;; Tramp internal magic file name function. tramp-set-file-uid-gid)) (if (file-name-absolute-p (nth 0 args)) @@ -2459,8 +2646,12 @@ Falls back to normal file name handler if no Tramp file name handler exists." (tramp-unload-file-name-handlers) (when tramp-mode ;; We cannot use `tramp-compat-temporary-file-directory' here due - ;; to autoload. + ;; to autoload. When installing Tramp's GNU ELPA package, there + ;; might be an older, incompatible version active. We try to + ;; overload this. (let ((default-directory temporary-file-directory)) + (when (bound-and-true-p tramp-archive-autoload) + (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (apply operation args))) @@ -2472,7 +2663,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." "Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp - 'tramp-autoload-file-name-handler)) + #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))) ;;;###autoload (tramp-register-autoload-file-name-handlers) @@ -2591,6 +2782,14 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;;; File name handler functions for completion mode: +;; This function takes action since Emacs 28.1, when +;; `read-extended-command-predicate' is set to +;; `command-completion-default-include-p'. +(defun tramp-command-completion-p (_symbol buffer) + "A predicate for Tramp interactive commands. +They are completed by \"M-x TAB\" only if the current buffer is remote." + (with-current-buffer buffer (tramp-tramp-file-p default-directory))) + (defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are @@ -2676,7 +2875,7 @@ not in completion mode." result1 (ignore-errors (tramp-run-real-handler - 'file-name-all-completions (list filename directory)))))) + #'file-name-all-completions (list filename directory)))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -2800,8 +2999,7 @@ remote host and localname (filename on remote host)." "Return all method completions for PARTIAL-METHOD." (mapcar (lambda (method) - (and method - (string-match-p (concat "^" (regexp-quote partial-method)) method) + (and method (string-prefix-p partial-method method) (tramp-completion-make-tramp-file-name method nil nil nil))) (mapcar #'car tramp-methods))) @@ -2813,8 +3011,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (cond ((and partial-user partial-host) - (if (and host - (string-match-p (concat "^" (regexp-quote partial-host)) host) + (if (and host (string-prefix-p partial-host host) (string-equal partial-user (or user partial-user))) (setq user partial-user) (setq user nil @@ -2822,16 +3019,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (partial-user (setq host nil) - (unless - (and user - (string-match-p (concat "^" (regexp-quote partial-user)) user)) + (unless (and user (string-prefix-p partial-user user)) (setq user nil))) (partial-host (setq user nil) - (unless - (and host - (string-match-p (concat "^" (regexp-quote partial-host)) host)) + (unless (and host (string-prefix-p partial-host host)) (setq host nil))) (t (setq user nil @@ -3025,7 +3218,7 @@ User may be nil." (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. User is always nil." - (if (memq system-type '(windows-nt)) + (if (eq system-type 'windows-nt) (with-tramp-connection-property nil "parse-putty" (with-temp-buffer (when (zerop (tramp-call-process @@ -3097,7 +3290,7 @@ User is always nil." (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) ;; We must do it file-wise. (tramp-run-real-handler - 'copy-directory + #'copy-directory (list directory newname keep-date parents copy-contents))) (defun tramp-handle-directory-file-name (directory) @@ -3155,7 +3348,7 @@ User is always nil." (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))) + (setq name (tramp-compat-file-name-concat dir name))) ;; If NAME is not a Tramp file, run the real handler. (if (not (tramp-tramp-file-p name)) (tramp-run-real-handler #'expand-file-name (list name nil)) @@ -3163,6 +3356,9 @@ User is always nil." (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) ;; 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. @@ -3444,6 +3640,11 @@ User is always nil." (and (file-directory-p (file-name-directory filename)) (file-writable-p (file-name-directory filename))))))) +(defcustom tramp-allow-unsafe-temporary-files nil + "Whether root-owned auto-save, backup or lock files can be written to \"/tmp\"." + :version "28.1" + :type 'boolean) + (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil @@ -3459,8 +3660,26 @@ User is always nil." (tramp-make-tramp-file-name v (cdr x)) (cdr x)))) tramp-backup-directory-alist) - backup-directory-alist))) - (tramp-run-real-handler #'find-backup-file-name (list filename))))) + backup-directory-alist)) + result) + (prog1 ;; Run plain `find-backup-file-name'. + (setq result + (tramp-run-real-handler + #'find-backup-file-name (list filename))) + ;; Protect against security hole. + (when (and (not tramp-allow-unsafe-temporary-files) + (not backup-inhibited) + (file-in-directory-p (car result) temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Backup file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -3483,7 +3702,7 @@ User is always nil." (list filename switches wildcard full-directory-p)) ;; `ls-lisp' always returns full listings. We must remove ;; superfluous parts. - (unless (string-match-p "l" switches) + (unless (tramp-compat-string-search "l" switches) (save-excursion (goto-char (point-min)) (while (setq start @@ -3597,21 +3816,114 @@ User is always nil." (signal (car err) (cdr err)))))) ;; Save exit. - (progn - (when visit - (setq buffer-file-name filename - buffer-read-only (not (file-writable-p filename))) - (set-visited-file-modtime) - (set-buffer-modified-p nil)) - (when (and (stringp local-copy) - (or remote-copy (null tramp-temp-buffer-file-name))) - (delete-file local-copy)) - (when (stringp remote-copy) - (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))) + (when visit + (setq buffer-file-name filename + buffer-read-only (not (file-writable-p filename))) + (set-visited-file-modtime) + (set-buffer-modified-p nil)) + (when (and (stringp local-copy) + (or remote-copy (null tramp-temp-buffer-file-name))) + (delete-file local-copy)) + (when (stringp remote-copy) + (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop)))) ;; Result. - (list (expand-file-name filename) - (cadr result))))) + (cons (expand-file-name filename) (cdr result))))) + +(defun tramp-get-lock-file (file) + "Read lockfile info of FILE. +Return nil when there is no lockfile." + (when-let ((lockname (tramp-compat-make-lock-file-name file))) + (or (file-symlink-p lockname) + (and (file-readable-p lockname) + (with-temp-buffer + (insert-file-contents-literally lockname) + (buffer-string)))))) + +(defun tramp-get-lock-pid (file) + "Determine pid for lockfile of FILE." + ;; Some Tramp methods do not offer a connection process, but just a + ;; network process as a place holder. Those processes use the + ;; "lock-pid" connection property as fake pid, in fact it is the + ;; time stamp the process is created. + (let ((p (tramp-get-process (tramp-dissect-file-name file)))) + (number-to-string + (or (process-id p) + (tramp-get-connection-property p "lock-pid" (emacs-pid)))))) + +(defconst tramp-lock-file-info-regexp + ;; USER@HOST.PID[:BOOT_TIME] + "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'" + "The format of a lock file.") + +(defun tramp-handle-file-locked-p (file) + "Like `file-locked-p' for Tramp files." + (when-let ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) + (or (and (string-equal (match-string 1 info) (user-login-name)) + (string-equal (match-string 2 info) (system-name)) + (string-equal (match-string 3 info) (tramp-get-lock-pid file))) + (match-string 1 info)))) + +(defun tramp-handle-lock-file (file) + "Like `lock-file' for Tramp files." + ;; See if this file is visited and has changed on disk since it + ;; was visited. + (catch 'dont-lock + (unless (eq (file-locked-p file) t) ;; Locked by me. + (when-let ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) + (unless (ask-user-about-lock + file (format + "%s@%s (pid %s)" (match-string 1 info) + (match-string 2 info) (match-string 3 info))) + (throw 'dont-lock nil))) + + (when-let ((lockname (tramp-compat-make-lock-file-name file)) + ;; USER@HOST.PID[:BOOT_TIME] + (info + (format + "%s@%s.%s" (user-login-name) (system-name) + (tramp-get-lock-pid file)))) + + ;; Protect against security hole. + (with-parsed-tramp-file-name file nil + (when (and (not tramp-allow-unsafe-temporary-files) + create-lockfiles + (file-in-directory-p lockname temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes file 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Lock file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe lock file name"))) + + ;; Do the lock. + (let (create-lockfiles signal-hook-function) + (condition-case nil + (make-symbolic-link info lockname 'ok-if-already-exists) + (error + (with-file-modes #o0644 + (write-region info nil lockname))))))))) + +(defun tramp-handle-make-lock-file-name (file) + "Like `make-lock-file-name' for Tramp files." + (and create-lockfiles + ;; This variable has been introduced with Emacs 28.1. + (not (bound-and-true-p remote-file-name-inhibit-locks)) + (tramp-run-real-handler 'make-lock-file-name (list file)))) + +(defun tramp-handle-unlock-file (file) + "Like `unlock-file' for Tramp files." + (when-let ((lockname (tramp-compat-make-lock-file-name file))) + (condition-case err + (delete-file lockname) + ;; `userlock--handle-unlock-error' exists since Emacs 28.1. + (error (tramp-compat-funcall 'userlock--handle-unlock-error err))))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." @@ -3680,15 +3992,15 @@ User is always nil." (setq choices tramp-default-proxies-alist) (while choices (setq item (pop choices) - proxy (eval (nth 2 item))) + proxy (eval (nth 2 item) t)) (when (and ;; Host. (string-match-p - (or (eval (nth 0 item)) "") + (or (eval (nth 0 item) t) "") (or (tramp-file-name-host-port (car target-alist)) "")) ;; User. (string-match-p - (or (eval (nth 1 item)) "") + (or (eval (nth 1 item) t) "") (or (tramp-file-name-user-domain (car target-alist)) ""))) (if (null proxy) ;; No more hops needed. @@ -3739,6 +4051,22 @@ User is always nil." ;; Result. target-alist)) +(defun tramp-expand-args (vec parameter &rest spec-list) + "Expand login arguments as given by PARAMETER in `tramp-methods'. +PARAMETER is a symbol like `tramp-login-args', denoting a list of +list of strings from `tramp-methods', containing %-sequences for +substitution. SPEC-LIST is a list of char/value pairs used for +`format-spec-make'." + (let ((args (tramp-get-method-parameter vec parameter)) + (spec (apply 'format-spec-make spec-list))) + ;; Expand format spec. + (tramp-compat-flatten-tree + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (format-spec y spec)) x)) + (unless (member "" x) x)) + args)))) + (defun tramp-direct-async-process-p (&rest args) "Whether direct async `make-process' can be called." (let ((v (tramp-dissect-file-name default-directory)) @@ -3756,8 +4084,7 @@ User is always nil." (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) (defun tramp-handle-make-process (&rest args) - "An alternative `make-process' implementation for Tramp files. -It does not support `:stderr'." + "An alternative `make-process' implementation for Tramp files." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((default-directory (tramp-compat-temporary-file-directory)) @@ -3766,7 +4093,10 @@ It does not support `:stderr'." (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))) @@ -3782,7 +4112,7 @@ It does not support `:stderr'." (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))) @@ -3798,23 +4128,20 @@ It does not support `:stderr'." (generate-new-buffer tramp-temp-buffer-name))) (env (mapcar (lambda (elt) - (when (string-match-p "=" elt) elt)) + (when (tramp-compat-string-search "=" elt) elt)) tramp-remote-process-environment)) ;; We use as environment the difference to toplevel ;; `process-environment'. (env (dolist (elt process-environment env) (when (and - (string-match-p "=" elt) + (tramp-compat-string-search "=" elt) (not (member elt (default-toplevel-value 'process-environment)))) (setq env (cons elt env))))) (env (setenv-internal - env "INSIDE_EMACS" - (concat (or (getenv "INSIDE_EMACS") emacs-version) - ",tramp:" tramp-version) - 'keep)) + env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (env (mapcar #'tramp-shell-quote-argument (delq nil env))) ;; Quote command. (command (mapconcat #'tramp-shell-quote-argument command " ")) @@ -3823,14 +4150,11 @@ It does not support `:stderr'." (append `("cd" ,localname "&&" "(" "env") env `(,command ")")))) ;; Check for `tramp-sh-file-name-handler', because something - ;; is different between tramp-adb.el and tramp-sh.el. + ;; is different between tramp-sh.el, and tramp-adb.el or + ;; tramp-sshfs.el. (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) (login-program (tramp-get-method-parameter v 'tramp-login-program)) - (login-args - (tramp-get-method-parameter v 'tramp-login-args)) - (async-args - (tramp-get-method-parameter v 'tramp-async-args)) ;; We don't create the temporary file. In fact, it ;; is just a prefix for the ControlPath option of ;; ssh; the real temporary file has another name, and @@ -3848,29 +4172,23 @@ It does not support `:stderr'." (when sh-file-name-handler-p (tramp-compat-funcall 'tramp-ssh-controlmaster-options v))) - spec p) + login-args p) - ;; Replace `login-args' place holders. + ;; Replace `login-args' place holders. Split + ;; ControlMaster options. (setq - spec (format-spec-make ?t tmpfile) - options (format-spec (or options "") spec) - spec (format-spec-make - ?h (or host "") ?u (or user "") ?p (or port "") - ?c options ?l "") - ;; Add arguments for asynchronous processes. - login-args (append async-args login-args) - ;; Expand format spec. - login-args - (tramp-compat-flatten-tree - (mapcar - (lambda (x) - (setq x (mapcar (lambda (y) (format-spec y spec)) x)) - (unless (member "" x) x)) - login-args)) - ;; Split ControlMaster options. login-args - (tramp-compat-flatten-tree - (mapcar (lambda (x) (split-string x " ")) login-args)) + (append + (tramp-compat-flatten-tree + (tramp-get-method-parameter v 'tramp-async-args)) + (tramp-compat-flatten-tree + (mapcar + (lambda (x) (split-string x " ")) + (tramp-expand-args + v 'tramp-login-args + ?h (or host "") ?u (or user "") ?p (or port "") + ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) + ?l "")))) p (make-process :name name :buffer buffer :command (append `(,login-program) login-args command) @@ -4151,7 +4469,8 @@ of." (defun tramp-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) @@ -4160,7 +4479,8 @@ of." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - (let ((tmpfile (tramp-compat-make-temp-file filename)) + (let ((file-locked (eq (file-locked-p lockname) t)) + (tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) (uid (or (tramp-compat-file-attribute-user-id @@ -4169,6 +4489,15 @@ of." (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)) + (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4180,8 +4509,8 @@ of." ;; 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. - (tramp-run-real-handler - #'write-region (list start end tmpfile append 'no-message lockname)) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error @@ -4199,13 +4528,18 @@ of." (current-time)))) ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid)) + (tramp-set-file-uid-gid filename uid gid) - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))) + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; The end. + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" @@ -4261,6 +4595,9 @@ of." ;; prompts from the remote host. See the variable ;; `tramp-actions-before-shell' for usage of these functions. +(defvar tramp-process-action-regexp nil + "The regexp used to invoke an action in `tramp-process-one-action'.") + (defun tramp-action-login (_proc vec) "Send the login name." (let ((user (or (tramp-file-name-user vec) @@ -4286,7 +4623,7 @@ of." (unless (tramp-get-connection-property vec "first-password-request" nil) (tramp-clear-passwd vec)) (goto-char (point-min)) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (tramp-check-for-regexp proc tramp-process-action-regexp) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -4351,6 +4688,24 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-send-string vec tramp-local-end-of-line) t) +(defun tramp-action-show-and-confirm-message (proc vec) + "Show the user a message for confirmation. +Wait, until the connection buffer changes." + (with-current-buffer (process-buffer proc) + (let ((stimers (with-timeout-suspend))) + (tramp-message vec 6 "\n%s" (buffer-string)) + (goto-char (point-min)) + (tramp-check-for-regexp proc tramp-process-action-regexp) + (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 0)) + (redisplay 'force) + ;; Hide message in buffer. + (narrow-to-region (point-max) (point-max)) + ;; Wait for new output. + (tramp-wait-for-regexp proc 30 tramp-security-key-confirmed-regexp)) + ;; Reenable the timers. + (with-timeout-unsuspend stimers))) + t) + (defun tramp-action-process-alive (proc _vec) "Check, whether a process has finished." (unless (process-live-p proc) @@ -4388,6 +4743,7 @@ The terminal type can be configured with `tramp-terminal-type'." "Wait for output from the shell and perform one action. See `tramp-process-actions' for the format of ACTIONS." (let ((case-fold-search t) + tramp-process-action-regexp found todo item pattern action) (while (not found) ;; Reread output once all actions have been performed. @@ -4396,7 +4752,8 @@ See `tramp-process-actions' for the format of ACTIONS." (setq todo actions) (while todo (setq item (pop todo) - pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))) + tramp-process-action-regexp (symbol-value (nth 0 item)) + pattern (format "\\(%s\\)\\'" tramp-process-action-regexp) action (nth 1 item)) (tramp-message vec 5 "Looking for regexp \"%s\" from remote shell" pattern) @@ -4870,7 +5227,7 @@ VEC is used for tracing." (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-temp-buffer - (unless (or (memq system-type '(windows-nt)) + (unless (or (eq system-type 'windows-nt) (not (zerop (tramp-call-process nil "locale" nil t nil "-a")))) (while candidates @@ -4961,7 +5318,7 @@ ID-FORMAT valid values are `string' and `integer'." (or (when-let ((handler (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid))) + (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid))) (funcall handler #'tramp-get-remote-gid vec id-format)) ;; Ensure there is a valid result. (and (equal id-format 'integer) tramp-unknown-id-integer) @@ -5041,37 +5398,54 @@ Return the local name of the temporary file." "Like `make-auto-save-file-name' for Tramp files. Returns a file name in `tramp-auto-save-directory' for autosaving this file, if that variable is non-nil." - (when (stringp tramp-auto-save-directory) - (setq tramp-auto-save-directory - (expand-file-name tramp-auto-save-directory))) - ;; Create directory. - (unless (or (null tramp-auto-save-directory) - (file-exists-p tramp-auto-save-directory)) - (make-directory tramp-auto-save-directory t)) - - (let ((system-type - (if (and (stringp tramp-auto-save-directory) - (tramp-tramp-file-p tramp-auto-save-directory)) - 'not-windows - system-type)) - (auto-save-file-name-transforms - (if (null tramp-auto-save-directory) - auto-save-file-name-transforms)) - (buffer-file-name - (if (null tramp-auto-save-directory) - buffer-file-name - (expand-file-name - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - (tramp-compat-file-name-unquote (buffer-file-name))) - tramp-auto-save-directory)))) - ;; Run plain `make-auto-save-file-name'. - (tramp-run-real-handler #'make-auto-save-file-name nil))) + (with-parsed-tramp-file-name buffer-file-name nil + (when (stringp tramp-auto-save-directory) + (setq tramp-auto-save-directory + (expand-file-name tramp-auto-save-directory))) + ;; Create directory. + (unless (or (null tramp-auto-save-directory) + (file-exists-p tramp-auto-save-directory)) + (make-directory tramp-auto-save-directory t)) + + (let ((system-type + (if (and (stringp tramp-auto-save-directory) + (tramp-tramp-file-p tramp-auto-save-directory)) + 'not-windows + system-type)) + (auto-save-file-name-transforms + (if (null tramp-auto-save-directory) + auto-save-file-name-transforms)) + (filename buffer-file-name) + (buffer-file-name + (if (null tramp-auto-save-directory) + buffer-file-name + (expand-file-name + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-compat-file-name-unquote (buffer-file-name))) + tramp-auto-save-directory))) + result) + (prog1 ;; Run plain `make-auto-save-file-name'. + (setq result (tramp-run-real-handler #'make-auto-save-file-name nil)) + ;; Protect against security hole. + (when (and (not tramp-allow-unsafe-temporary-files) + auto-save-default + (file-in-directory-p result temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Autosave file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe autosave file name")))))) (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. @@ -5281,6 +5655,8 @@ Invokes `password-read' if available, `read-passwd' else." ;; Reenable the timers. (with-timeout-unsuspend stimers)))) +(put #'tramp-read-passwd 'tramp-suppress-trace t) + (defun tramp-clear-passwd (vec) "Clear password cache for connection related to VEC." (let ((method (tramp-file-name-method vec)) @@ -5295,6 +5671,8 @@ Invokes `password-read' if available, `read-passwd' else." :host ,host-port :port ,method)) (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop)))) +(put #'tramp-clear-passwd 'tramp-suppress-trace t) + (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." @@ -5439,11 +5817,6 @@ BODY is the backend specific code." ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) ;; -;; * I was wondering if it would be possible to use tramp even if I'm -;; actually using sshfs. But when I launch a command I would like -;; to get it executed on the remote machine where the files really -;; are. (Andrea Crotti) -;; ;; * Run emerge on two remote files. Bug is described here: ;; <https://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>. ;; (Bug#6850) |