diff options
Diffstat (limited to 'lisp/net/tramp.el')
| -rw-r--r-- | lisp/net/tramp.el | 914 |
1 files changed, 566 insertions, 348 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index df2f0850b83..3420bb76d14 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -82,6 +82,7 @@ (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -440,12 +441,12 @@ See `tramp-methods' for a list of possibilities for METHOD." (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") +(add-to-list 'tramp-methods `(,tramp-default-method-marker)) + (defcustom tramp-default-user nil "Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like -\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'. - -This variable is regarded as obsolete, and will be removed soon." +\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'." :type '(choice (const nil) string)) ;;;###tramp-autoload @@ -525,7 +526,7 @@ interpreted as a regular expression which always matches." (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) - (list (tramp-compat-rx + (list (rx bos (| (literal (downcase tramp-system-name)) (literal (upcase tramp-system-name))) eos))) @@ -539,7 +540,7 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (tramp-compat-rx + (rx bos (| (literal tramp-system-name) (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) @@ -640,10 +641,11 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - (tramp-compat-rx - bol (* nonl) - (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) (any ":：៖") (? "\^@") (* blank)) + (rx-to-string + `(: bol (* nonl) + (group (| . ,password-word-equivalents)) + (* nonl) (any . ,tramp-compat-password-colon-equivalents) + (? "\^@") (* blank))) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -659,14 +661,13 @@ The `sudo' program appears to insert a `^@' character into the prompt." (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - (: "Login " (| "Incorrect" "incorrect")) - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -724,7 +725,8 @@ The regexp should match at end of buffer." ;; 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. +;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey, +;; which has also passed the tests, does not show such a message. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -789,6 +791,7 @@ It shall be used in combination with `generate-new-buffer-name'.") (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -899,18 +902,17 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (tramp-compat-rx bol (literal (tramp-build-prefix-format)))) + (rx bol (literal (tramp-build-prefix-format)))) (defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - `((default . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (>= 2 alnum)))) + `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) (simplified . "") - (separate . ,(tramp-compat-rx - (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) + (separate + . ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () @@ -938,7 +940,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-method-regexp () "Return `tramp-postfix-method-regexp'." - (tramp-compat-rx (literal (tramp-build-postfix-method-format)))) + (rx (literal (tramp-build-postfix-method-format)))) (defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'! "Regexp matching delimiter between method and user or host names. @@ -950,8 +952,7 @@ Derived from `tramp-postfix-method-format'.") (defconst tramp-prefix-domain-format "%" "String matching delimiter between user and domain names.") -(defconst tramp-prefix-domain-regexp - (tramp-compat-rx (literal tramp-prefix-domain-format)) +(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format)) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") @@ -959,7 +960,7 @@ Derived from `tramp-prefix-domain-format'.") "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp - (tramp-compat-rx + (rx (group (regexp tramp-user-regexp)) (regexp tramp-prefix-domain-regexp) (group (regexp tramp-domain-regexp))) @@ -969,8 +970,7 @@ Derived from `tramp-prefix-domain-format'.") "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp - (tramp-compat-rx (literal tramp-postfix-user-format)) +(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format)) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") @@ -993,7 +993,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-ipv6-regexp () "Return `tramp-prefix-ipv6-regexp'." - (tramp-compat-rx (literal tramp-prefix-ipv6-format))) + (rx (literal tramp-prefix-ipv6-format))) (defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching left hand side of IPv6 addresses. @@ -1021,7 +1021,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-ipv6-regexp () "Return `tramp-postfix-ipv6-regexp'." - (tramp-compat-rx (literal tramp-postfix-ipv6-format))) + (rx (literal tramp-postfix-ipv6-format))) (defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching right hand side of IPv6 addresses. @@ -1030,8 +1030,7 @@ Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp - (tramp-compat-rx (literal tramp-prefix-port-format)) +(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format)) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") @@ -1039,7 +1038,7 @@ Derived from `tramp-prefix-port-format'.") "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp - (tramp-compat-rx + (rx (group (regexp tramp-host-regexp)) (regexp tramp-prefix-port-regexp) (group (regexp tramp-port-regexp))) @@ -1048,8 +1047,7 @@ Derived from `tramp-prefix-port-format'.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp - (tramp-compat-rx (literal tramp-postfix-hop-format)) +(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format)) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -1069,7 +1067,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-host-regexp () "Return `tramp-postfix-host-regexp'." - (tramp-compat-rx (literal tramp-postfix-host-format))) + (rx (literal tramp-postfix-host-format))) (defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching delimiter between host names and localnames. @@ -1096,7 +1094,7 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - (tramp-compat-rx + (rx ;; Method. (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) ;; Optional user. This includes domain. @@ -1118,7 +1116,7 @@ It is expected, that `tramp-syntax' has the proper value." It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (? (group (+ (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)))) @@ -1178,11 +1176,9 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") ;; `tramp-method-regexp' needs at least two characters, in order to ;; distinguish from volume letter. This is in the way when completing. (defconst tramp-completion-method-regexp-alist - `((default . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (+ alnum)))) + `((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum)))) (simplified . "") - (separate . ,(tramp-compat-rx - (| (literal tramp-default-method-marker) (* alnum))))) + (separate . ,(rx (| (literal tramp-default-method-marker) (* alnum))))) "Alist mapping Tramp syntax to regexps matching completion methods.") (defun tramp-build-completion-method-regexp () @@ -1198,8 +1194,8 @@ The `ftp' syntax does not support methods.") "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." (if (eq tramp-syntax 'separate) ;; FIXME: This shouldn't be necessary. - (tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos) - (tramp-compat-rx + (rx bos "/" (? "[" (* (not "]"))) eos) + (rx bos ;; `file-name-completion' uses absolute paths for matching. ;; This means that on W32 systems, something like @@ -1217,9 +1213,12 @@ The `ftp' syntax does not support methods.") (? (regexp tramp-completion-method-regexp) ;; Method separator, user name and host name. (? (regexp tramp-postfix-method-regexp) - ;; This is a little bit lax, but it serves. - (? (regexp tramp-host-regexp)))) - + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp)) + (? (| (regexp tramp-host-regexp) ;; This includes a user. + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))))) eos))) (defvar tramp-completion-file-name-regexp @@ -1404,20 +1403,6 @@ based on the Tramp and Emacs versions, and should not be set here." :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 -make it visible during file name completion in the minibuffer, -Tramp flushes its cache and rereads the directory contents when -more than `tramp-completion-reread-directory-timeout' seconds -have been gone since last remote command execution. A value of t -would require an immediate reread during filename completion, nil -means to use always cached values for the directory contents." - :type '(choice (const nil) (const t) integer)) -(make-obsolete-variable - 'tramp-completion-reread-directory-timeout - 'remote-file-name-inhibit-cache "27.2") - ;;; Internal Variables: (defvar tramp-current-connection nil @@ -1429,6 +1414,7 @@ the (optional) timestamp of last activity on this connection.") "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -1437,9 +1423,13 @@ This shouldn't be set explicitly. It is let-bound, for example during direct remote copying with scp.") (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-exists-p . tramp-completion-handle-file-exists-p) + (file-name-all-completions . tramp-completion-handle-file-name-all-completions) - (file-name-completion . tramp-completion-handle-file-name-completion)) + (file-name-completion . tramp-completion-handle-file-name-completion) + (file-name-directory . tramp-completion-handle-file-name-directory) + (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)) "Alist of completion handler functions. Used for file names matching `tramp-completion-file-name-regexp'. Operations not mentioned here will be handled by Tramp's file @@ -1527,8 +1517,7 @@ same connection. Make a copy in order to avoid side effects." (setq vec (copy-tramp-file-name vec)) (setf (tramp-file-name-localname vec) (and (stringp localname) - (tramp-compat-file-name-unquote - (directory-file-name localname))) + (file-name-unquote (directory-file-name localname))) (tramp-file-name-hop vec) nil)) vec)) @@ -1561,7 +1550,7 @@ entry does not exist, return nil." ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) "Return unquoted localname component of VEC." - (tramp-compat-file-name-unquote (tramp-file-name-localname vec))) + (file-name-unquote (tramp-file-name-localname vec))) ;;;###tramp-autoload (defun tramp-tramp-file-p (name) @@ -1599,7 +1588,7 @@ of `process-file', `start-file-process', or `shell-command'." ;; The localname can be quoted with "/:". Extract this. (defun tramp-unquote-file-local-name (name) "Return unquoted localname of NAME." - (tramp-compat-file-name-unquote (tramp-file-local-name name))) + (file-name-unquote (tramp-file-local-name name))) (defun tramp-find-method (method user host) "Return the right method string to use depending on USER and HOST. @@ -1656,7 +1645,7 @@ This is USER, if non-nil. Otherwise, do a lookup in This is HOST, if non-nil. Otherwise, do a lookup in `tramp-default-host-alist' and `tramp-default-host'." (let ((result - (or (and (> (length host) 0) host) + (or (and (tramp-compat-length> host 0) host) (let ((choices tramp-default-host-alist) lhost item) (while choices @@ -1668,7 +1657,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in lhost) tramp-default-host))) ;; We must mark, whether a default value has been used. - (if (or (> (length host) 0) (null result)) + (if (or (tramp-compat-length> host 0) (null result)) result (propertize result 'tramp-default t)))) @@ -1731,14 +1720,13 @@ default values are used." :port port :localname localname :hop hop)) ;; The method must be known. (unless (or nodefault non-essential - (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error - v "Method `%s' is not known." method)) + v "Method `%s' is not known" method)) ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." method))))))) + v "Method `%s' is not supported for multi-hops" method))))))) (put #'tramp-dissect-file-name 'tramp-suppress-trace t) @@ -1761,27 +1749,31 @@ See `tramp-dissect-file-name' for details." (let ((v (tramp-dissect-file-name (concat tramp-prefix-format (replace-regexp-in-string - (tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos) + (rx (regexp tramp-postfix-hop-regexp) eos) tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." + v "Method `%s' is not supported for multi-hops" (tramp-file-name-method v))) ;; Return result. v)) (put #'tramp-dissect-hop-name 'tramp-suppress-trace t) +(defsubst tramp-string-empty-or-nil-p (string) + "Check whether STRING is empty or nil." + (or (null string) (string= string ""))) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*tramp/%s %s@%s*" method user-domain host-port) - (format "*tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*tramp/%s %s*" method host-port) + (format "*tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-buffer-name 'tramp-suppress-trace t) @@ -1826,23 +1818,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." hop (nth 6 args)))) ;; Unless `tramp-syntax' is `simplified', we need a method. - (when (and (not (zerop (length tramp-postfix-method-format))) - (zerop (length method))) + (when (and (not (string-empty-p tramp-postfix-method-format)) + (tramp-string-empty-or-nil-p method)) (signal 'wrong-type-argument (list #'stringp method))) (concat tramp-prefix-format hop - (unless (zerop (length tramp-postfix-method-format)) + (unless (string-empty-p tramp-postfix-method-format) (concat method tramp-postfix-method-format)) user - (unless (zerop (length domain)) + (unless (tramp-string-empty-or-nil-p domain) (concat tramp-prefix-domain-format domain)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) tramp-postfix-user-format) (when host (if (string-match-p tramp-ipv6-regexp host) (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host)) - (unless (zerop (length port)) + (unless (tramp-string-empty-or-nil-p port) (concat tramp-prefix-port-format port)) tramp-postfix-host-format localname))) @@ -1857,8 +1849,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (replace-regexp-in-string tramp-prefix-regexp "" (replace-regexp-in-string - (tramp-compat-rx - (regexp tramp-postfix-host-regexp) eos) + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) @@ -1867,12 +1858,12 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." It must not be a complete Tramp file name, but as long as there are necessary only. This function will be used in file name completion." (concat tramp-prefix-format - (unless (or (zerop (length method)) - (zerop (length tramp-postfix-method-format))) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-postfix-method-format)) (concat method tramp-postfix-method-format)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat user tramp-postfix-user-format)) - (unless (zerop (length host)) + (unless (tramp-string-empty-or-nil-p host) (concat (if (string-match-p tramp-ipv6-regexp host) (concat @@ -1919,7 +1910,7 @@ Return `tramp-cache-undefined' in case it doesn't exist." (or (and (tramp-file-name-p vec-or-proc) (get-buffer-process (tramp-buffer-name vec-or-proc))) (and (processp vec-or-proc) - (tramp-get-process (process-get vec-or-proc 'vector))) + (tramp-get-process (process-get vec-or-proc 'tramp-vector))) tramp-cache-undefined)) (defun tramp-get-connection-process (vec) @@ -1967,9 +1958,9 @@ of `current-buffer'." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*debug tramp/%s %s@%s*" method user-domain host-port) - (format "*debug tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*debug tramp/%s %s*" method host-port) + (format "*debug tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-debug-buffer-name 'tramp-suppress-trace t) @@ -1988,7 +1979,7 @@ of `current-buffer'." ;; 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 - (tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) + (rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) '(1 font-lock-warning-face t t) '(0 (outline-font-lock-face) keep t)) "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2199,7 +2190,7 @@ applicable)." vec-or-proc 'dont-create)))))))) ;; Translate proc to vec. (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'vector)))) + (setq vec-or-proc (process-get vec-or-proc 'tramp-vector)))) ;; Do it. (when (tramp-file-name-p vec-or-proc) (apply #'tramp-debug-message @@ -2322,12 +2313,12 @@ the resulting error message." (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -2402,7 +2393,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (let* ((parameters (cdr reporter)) (message (aref parameters 3))) (when (tramp-compat-string-search message (or (current-message) "")) - (tramp-compat-progress-reporter-update reporter value suffix)))) + (progress-reporter-update reporter value suffix)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode. @@ -2440,13 +2431,12 @@ locally on a remote file name. When the local system is a W32 system but the remote system is Unix, this introduces a superfluous drive letter into the file name. This function removes it." (save-match-data - (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) - (result (tramp-compat-file-name-unquote name 'top))) + (let ((quoted (file-name-quoted-p name 'top)) + (result (file-name-unquote name 'top))) (setq result (replace-regexp-in-string - (tramp-compat-rx (regexp tramp-volume-letter-regexp) "/") - "/" result)) - (if quoted (tramp-compat-file-name-quote result 'top) result)))) + (rx (regexp tramp-volume-letter-regexp) "/") "/" result)) + (if quoted (file-name-quote result 'top) result)))) ;;; Config Manipulation Functions: @@ -2480,13 +2470,14 @@ Example: (setcdr v (delete (car v) (cdr v)))) ;; Check for function and file or registry key. (unless (and (functionp (nth 0 (car v))) + (stringp (nth 1 (car v))) (cond ;; Windows registry. ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - v "reg" nil nil nil "query" (nth 1 (car v)))))) + nil "reg" nil nil nil "query" (nth 1 (car v)))))) ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) @@ -2554,7 +2545,7 @@ coding system might not be determined. This function repairs it." ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. - (push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result))))) + (push (cons (rx (literal tmpname)) (cdr elt)) result))))) (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -2604,15 +2595,13 @@ Must be handled by the callers." file-name-nondirectory file-name-sans-versions file-notify-add-watch file-ownership-preserved-p file-readable-p file-regular-p file-remote-p - file-selinux-context file-symlink-p file-truename - file-writable-p find-backup-file-name get-file-buffer - insert-directory insert-file-contents load - make-directory set-file-acl set-file-modes + file-selinux-context file-symlink-p file-system-info + file-truename file-writable-p find-backup-file-name + get-file-buffer insert-directory insert-file-contents + load make-directory set-file-acl set-file-modes set-file-selinux-context set-file-times substitute-in-file-name unhandled-file-name-directory vc-registered - ;; Emacs 27+ only. - file-system-info ;; Emacs 28- only. make-directory-internal ;; Emacs 28+ only. @@ -2655,12 +2644,12 @@ Must be handled by the callers." (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - '(make-nearby-temp-file process-file shell-command - start-file-process temporary-file-directory - ;; Emacs 27+ only. - exec-path make-process + '(exec-path make-nearby-temp-file make-process process-file + shell-command start-file-process temporary-file-directory ;; Emacs 29+ only. - list-system-processes memory-info process-attributes)) + list-system-processes memory-info process-attributes + ;; Emacs 30+ only. + file-user-uid)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -2791,7 +2780,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." (if-let - ((fn (and tramp-mode + ((fn (and tramp-mode minibuffer-completing-file-name (assoc operation tramp-completion-file-name-handler-alist)))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -2839,7 +2828,7 @@ remote file names." #'file-name-sans-extension (directory-files dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) - (files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol))) + (files-regexp (rx bol (regexp (regexp-opt files)) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -2876,7 +2865,7 @@ remote file names." (put #'tramp-completion-file-name-handler 'operations (mapcar #'car tramp-completion-file-name-handler-alist)) - ;; Integrated in Emacs 27. + ;; After unloading, `tramp-archive-enabled' might not be defined. (when (bound-and-true-p tramp-archive-enabled) (add-to-list 'file-name-handler-alist (cons tramp-archive-file-name-regexp @@ -2961,9 +2950,76 @@ not in completion mode." (or ;; We check this for the process related to ;; `tramp-buffer-name'; otherwise `start-file-process' ;; wouldn't run ever when `non-essential' is non-nil. - (and vec (process-live-p (get-process (tramp-buffer-name vec)))) + (process-live-p (tramp-get-process vec)) (not non-essential)))) +(defun tramp-completion-handle-expand-file-name (filename &optional directory) + "Like `expand-file-name' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; check, whether DIRECTORY is "/method:" or "/[method/". + (let ((dir (or directory default-directory "/"))) + (cond + ((file-name-absolute-p filename) filename) + ((and (eq tramp-syntax 'simplified) + (string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir)) + (concat dir filename)) + ((string-match-p + (rx bos (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp))) + eos) + dir) + (concat dir filename)) + (t (tramp-run-real-handler #'expand-file-name (list filename directory)))))) + +(defun tramp-completion-handle-file-exists-p (filename) + "Like `file-exists-p' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; regard all files "/method:" or "/[method/" as existent, if + ;; "method" is a valid Tramp method. And we regard all files + ;; "/method:user@", "/user@" or "/[method/user@" as existent, if + ;; "user@" is a valid file name completion. Host completion is + ;; performed in the respective backen operation. + (or (and (cond + ;; Completion styles like `flex' and `substring' check for + ;; the file name "/". This does exist. + ((string-equal filename "/")) + ;; Is it a valid method? + ((and (not (string-empty-p tramp-postfix-method-format)) + (string-match + (rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 9 (regexp tramp-method-regexp)) + (? (regexp tramp-postfix-method-regexp)) + eos) + filename)) + (assoc (match-string 9 filename) tramp-methods)) + ;; Is it a valid user? + ((string-match + (rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 10 + (regexp tramp-method-regexp) + (regexp tramp-postfix-method-regexp)) + (group-n 11 + (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp)) + eos) + filename) + (member + (match-string 11 filename) + (file-name-all-completions + "" (concat tramp-prefix-format (match-string 10 filename)))))) + t) + + (tramp-run-real-handler #'file-exists-p (list filename)))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible @@ -2974,10 +3030,10 @@ not in completion mode." (tramp-drop-volume-letter (expand-file-name filename directory))) ;; When `tramp-syntax' is `simplified', we need a default method. (tramp-default-method - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method)) (tramp-default-method-alist - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method-alist)) tramp-default-user tramp-default-user-alist tramp-default-host tramp-default-host-alist @@ -2985,7 +3041,7 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (+ (regexp tramp-remote-file-name-spec-regexp) (regexp tramp-postfix-hop-regexp)))) @@ -3037,11 +3093,12 @@ not in completion mode." result1))) ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))) + (delete-dups + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3078,14 +3135,14 @@ They are collected by `tramp-completion-dissect-file-name1'." (let (;; "/method" "/[method" (tramp-completion-file-name-structure1 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (? (regexp tramp-completion-method-regexp))) eol) 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3094,7 +3151,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3103,7 +3160,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3113,7 +3170,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3124,7 +3181,7 @@ They are collected by `tramp-completion-dissect-file-name1'." ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list - (tramp-compat-rx + (rx (regexp tramp-prefix-regexp) (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) @@ -3199,6 +3256,45 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-completion-handle-file-name-directory (filename) + "Like `file-name-directory' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; return "/method:" or "/[method/", if "method" is a valid Tramp + ;; method. In the `separate' file name syntax, we return "/[" when + ;; `filename' is "/[string" w/o a trailing method separator "/". + (cond + ((string-match + (rx (group (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp))) + (? (regexp tramp-completion-method-regexp)) eos) + filename) + (match-string 1 filename)) + ((and (string-match + (rx (group + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp))) + (? (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))) + eos) + filename) + ;; Is it a valid method? + (or (tramp-string-empty-or-nil-p (match-string 2 filename)) + (assoc (match-string 2 filename) tramp-methods))) + (match-string 1 filename)) + (t (tramp-run-real-handler #'file-name-directory (list filename))))) + +(defun tramp-completion-handle-file-name-nondirectory (filename) + "Like `file-name-nondirectory' for partial Tramp files." + (tramp-compat-string-replace (file-name-directory filename) "" filename)) + (defun tramp-parse-default-user-host (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' @@ -3257,7 +3353,7 @@ Either user or host may be nil." Either user or host may be nil." (let (result (regexp - (tramp-compat-rx + (rx bol (group (regexp tramp-host-regexp)) (? (+ blank) (group (regexp tramp-user-regexp)))))) (when (re-search-forward regexp (line-end-position) t) @@ -3273,8 +3369,7 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group - (tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ",")) + (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3285,7 +3380,7 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (tramp-compat-rx + (rx (| (: bol (* blank) "Host") (: bol (+ nonl)) ;; ??? (group (regexp tramp-host-regexp)))) @@ -3310,15 +3405,14 @@ User is always nil." User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (tramp-compat-rx - bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) + (rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (tramp-compat-rx + (rx bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub" eol))) (defun tramp-parse-hosts (filename) @@ -3330,8 +3424,7 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (tramp-compat-rx - bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) 1 (rx blank))) (defun tramp-parse-passwd (filename) @@ -3350,7 +3443,7 @@ Host is always \"localhost\"." "Return a (user host) tuple allowed to access. Host is always \"localhost\"." (let (result - (regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":"))) + (regexp (rx bol (group (regexp tramp-user-regexp)) ":"))) (when (re-search-forward regexp (line-end-position) t) (setq result (list (match-string 1) "localhost"))) (forward-line 1) @@ -3401,14 +3494,13 @@ User is always nil." (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts - registry-or-dirname - (tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol)))) + registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." (let (result - (regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl))))) + (regexp (rx (literal registry) "\\" (group (+ nonl))))) (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string 1)))) (forward-line 1) @@ -3435,15 +3527,35 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 3) (debug t)) `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) - (tramp-flush-directory-properties v localname))) + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname)))) + +(defmacro tramp-skeleton-delete-file (filename &optional trash &rest body) + "Skeleton for `tramp-*-handle-delete-file'. +BODY is the backend specific code." + (declare (indent 2) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (let ((delete-by-moving-to-trash + (and delete-by-moving-to-trash + ;; This variable exists since Emacs 30.1. + (not (bound-and-true-p + remote-file-name-inhibit-delete-by-moving-to-trash))))) + (if (and delete-by-moving-to-trash ,trash) + (move-file-to-trash ,filename) + ,@body) + (tramp-flush-file-properties v localname)))) (defmacro tramp-skeleton-directory-files (directory &optional full match nosort count &rest body) @@ -3524,6 +3636,25 @@ BODY is the backend specific code." (tramp-dissect-file-name ,directory) 'file-missing ,directory) nil))) +(defmacro tramp-skeleton-file-exists-p (filename &rest body) + "Skeleton for `tramp-*-handle-file-exists-p'. +BODY is the backend specific code." + (declare (indent 1) (debug t)) + ;; `file-exists-p' is used as predicate in file name completion. + `(or (and minibuffer-completing-file-name + (file-name-absolute-p ,filename) + (tramp-string-empty-or-nil-p + (tramp-file-name-localname (tramp-dissect-file-name ,filename)))) + ;; We don't want to run it when `non-essential' is t, or there + ;; is no connection process yet. + (when (tramp-connectable-p ,filename) + (with-parsed-tramp-file-name (expand-file-name ,filename) nil + (with-tramp-file-property v localname "file-exists-p" + (if (tramp-file-property-p v localname "file-attributes") + (not + (null (tramp-get-file-property v localname "file-attributes"))) + ,@body)))))) + (defmacro tramp-skeleton-file-local-copy (filename &rest body) "Skeleton for `tramp-*-handle-file-local-copy'. BODY is the backend specific code." @@ -3539,6 +3670,99 @@ BODY is the backend specific code." ;; Trigger the `file-missing' error. (signal 'error nil))))) +(defmacro tramp-skeleton-file-truename (filename &rest body) + "Skeleton for `tramp-*-handle-file-truename'. +BODY is the backend specific code." + (declare (indent 1) (debug (form body))) + ;; Preserve trailing "/". + `(funcall + (if (directory-name-p ,filename) #'file-name-as-directory #'identity) + ;; Quote properly. + (funcall + (if (file-name-quoted-p ,filename) #'file-name-quote #'identity) + (with-parsed-tramp-file-name + (file-name-unquote (expand-file-name ,filename)) nil + (tramp-make-tramp-file-name + v + (with-tramp-file-property v localname "file-truename" + (let (result) + (setq result (progn ,@body)) + ;; Detect cycle. + (when (and (file-symlink-p ,filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" ,filename)) + ;; If the resulting localname looks remote, we must quote + ;; it for security reasons. + (when (file-remote-p result) + (setq result (file-name-quote result 'top))) + result))))))) + +(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body) + "Skeleton for `tramp-*-handle-make-directory'. +BODY is the backend specific code." + ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers + ;; anymore. And the return values are specified since then as well. + (declare (indent 2) (debug t)) + `(let* ((dir (directory-file-name (expand-file-name ,dir))) + (par (file-name-directory dir))) + (with-parsed-tramp-file-name dir nil + (when (and (null ,parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists dir)) + ;; Make missing directory parts. + (when ,parents + (unless (file-directory-p par) + (make-directory par ,parents))) + ;; Just do it. + (if (file-exists-p dir) t + (tramp-flush-file-properties v localname) + ,@body + nil)))) + +(defmacro tramp-skeleton-handle-make-symbolic-link + (target linkname &optional ok-if-already-exists &rest body) + "Skeleton for `tramp-*-handle-make-symbolic-link'. +BODY is the backend specific code. +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink if it is located +on the same host. Otherwise, TARGET is quoted." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,linkname) nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p ,target) + (tramp-file-name-equal-p v (tramp-dissect-file-name ,target))) + (setq ,target (tramp-file-local-name (expand-file-name ,target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name ,target (tramp-file-local-name default-directory)))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p ,target) + (make-symbolic-link + (file-name-quote ,target 'top) ,linkname ,ok-if-already-exists) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p ,linkname) + ;; What to do? + (if (or (null ,ok-if-already-exists) ; not allowed to exist + (and (numberp ,ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file ,linkname))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ,@body))) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. @@ -3705,6 +3929,15 @@ Let-bind it when necessary.") vec (concat "~" (substring filename (match-beginning 1)))) (tramp-make-tramp-file-name (tramp-dissect-file-name filename))))) +(defun tramp-handle-file-user-uid () + "Like `user-uid' for Tramp files." + (let ((v (tramp-dissect-file-name default-directory))) + (or (tramp-get-remote-uid v 'integer) + ;; Some handlers for `tramp-get-remote-uid' return nil if they + ;; can't get the UID; always return -1 in this case for + ;; consistency. + tramp-unknown-id-integer))) + (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) @@ -3763,7 +3996,7 @@ Let-bind it when necessary.") ;; Otherwise, remove any trailing slash from localname component. ;; Method, host, etc, are unchanged. (while (with-parsed-tramp-file-name directory nil - (and (not (zerop (length localname))) + (and (tramp-compat-length> localname 0) (eq (aref localname (1- (length localname))) ?/) (not (string= localname "/")))) (setq directory (substring directory 0 -1))) @@ -3794,7 +4027,8 @@ Let-bind it when necessary.") ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -3809,12 +4043,11 @@ Let-bind it when necessary.") ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -3843,9 +4076,10 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (eq (file-attribute-type (file-attributes (file-truename filename))) t)) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -3858,13 +4092,8 @@ Let-bind it when necessary.") (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (not (null (file-attributes filename))))))) + (tramp-skeleton-file-exists-p filename + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." @@ -3897,7 +4126,7 @@ Let-bind it when necessary.") ;; Run the command on the localname portion only unless we are in ;; completion mode. (tramp-make-tramp-file-name - v (or (and (zerop (length (tramp-file-name-localname v))) + v (or (and (tramp-string-empty-or-nil-p (tramp-file-name-localname v)) (not (tramp-connectable-p file))) (tramp-run-real-handler #'file-name-as-directory @@ -3960,7 +4189,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (= (length (delete "./" (delete "../" fnac))) 1)) + (when (and (consp fnac) + (tramp-compat-length= (delete "./" (delete "../" fnac)) 1)) (setq fnac (delete "./" (delete "../" fnac)))) (or (try-completion @@ -3971,9 +4201,7 @@ Let-bind it when necessary.") (and completion-ignored-extensions (string-match-p - (tramp-compat-rx - (regexp (regexp-opt completion-ignored-extensions)) eos) - x) + (rx (regexp (regexp-opt completion-ignored-extensions)) eos) x) ;; We remember the hit. (push x hits-ignored-extensions)))))) ;; No match. So we try again for ignored files. @@ -4004,18 +4232,11 @@ Let-bind it when necessary.") ((not (file-exists-p file2)) t) ;; Tramp reads and writes timestamps on second level. So we round ;; the timestamps to seconds without fractions. - ;; `time-convert' has been introduced with Emacs 27.1. - ((fboundp 'time-convert) - (time-less-p - (tramp-compat-funcall - 'time-convert - (file-attribute-modification-time (file-attributes file2)) 'integer) - (tramp-compat-funcall - 'time-convert - (file-attribute-modification-time (file-attributes file1)) 'integer))) (t (time-less-p - (file-attribute-modification-time (file-attributes file2)) - (file-attribute-modification-time (file-attributes file1)))))) + (time-convert + (file-attribute-modification-time (file-attributes file2)) 'integer) + (time-convert + (file-attribute-modification-time (file-attributes file1)) 'integer))))) (defun tramp-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -4079,14 +4300,8 @@ Let-bind it when necessary.") (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (tramp-compat-file-name-quoted-p filename) - #'tramp-compat-file-name-quote #'identity) - (let ((result (tramp-compat-file-name-unquote (expand-file-name filename))) + (tramp-skeleton-file-truename filename + (let ((result (directory-file-name localname)) (numchase 0) ;; Don't make the following value larger than necessary. ;; People expect an error message in a timely fashion when @@ -4096,31 +4311,21 @@ Let-bind it when necessary.") ;; Unquoting could enable encryption. tramp-crypt-enabled symlink-target) - (with-parsed-tramp-file-name result v1 - ;; We cache only the localname. - (tramp-make-tramp-file-name - v1 - (with-tramp-file-property v1 v1-localname "file-truename" - (while (and (setq symlink-target (file-symlink-p result)) - (< numchase numchase-limit)) - (setq numchase (1+ numchase) - result - (with-parsed-tramp-file-name (expand-file-name result) v2 - (tramp-make-tramp-file-name - v2 - (if (stringp symlink-target) - (if (file-remote-p symlink-target) - (tramp-compat-file-name-quote symlink-target 'top) - (tramp-drop-volume-letter - (expand-file-name - symlink-target - (file-name-directory v2-localname)))) - v2-localname)))) - (when (>= numchase numchase-limit) - (tramp-error - v1 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (tramp-file-local-name (directory-file-name result))))))))) + (while (and (setq symlink-target + (file-symlink-p (tramp-make-tramp-file-name v result))) + (< numchase numchase-limit)) + (setq numchase (1+ numchase) + result + (if (file-remote-p symlink-target) + (file-name-quote symlink-target 'top) + (tramp-drop-volume-letter + (expand-file-name + symlink-target (file-name-directory result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit))) + (directory-file-name result)))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -4343,8 +4548,7 @@ Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." (defconst tramp-process-attributes-ps-args `("-eww" "-o" - ,(mapconcat - #'identity + ,(string-join '("pid" "euid" "euser" @@ -4420,53 +4624,49 @@ Parsing the remote \"ps\" output is controlled by It is not guaranteed, that all process attributes as described in `process-attributes' are returned. The additional attribute `pid' shall be returned always." - ;; Since Emacs 27.1. - (when (fboundp 'connection-local-criteria-for-default-directory) - (with-tramp-file-property vec "/" "process-attributes" - (ignore-errors - (with-temp-buffer - (hack-connection-local-variables-apply - (connection-local-criteria-for-default-directory)) - ;; (pop-to-buffer (current-buffer)) - (when (zerop - (apply - #'process-file - "ps" nil t nil tramp-process-attributes-ps-args)) - (let (result res) - (goto-char (point-min)) - (while (not (eobp)) - ;; (tramp-test-message - ;; "%s" (buffer-substring (point) (line-end-position))) - (when (save-excursion - (search-forward-regexp - (rx digit) (line-end-position) 'noerror)) - (setq res nil) - (dolist (elt tramp-process-attributes-ps-format) - (push - (cons - (car elt) - (cond - ((eq (cdr elt) 'number) (read (current-buffer))) - ((eq (cdr elt) 'string) - (search-forward-regexp (rx (+ (not blank)))) - (match-string 0)) - ((numberp (cdr elt)) - (search-forward-regexp (rx (+ blank))) - (search-forward-regexp - (rx (+ nonl)) (+ (point) (cdr elt))) - (string-trim (match-string 0))) - ((fboundp (cdr elt)) - (funcall (cdr elt))) - ((null (cdr elt)) - (search-forward-regexp (rx (+ blank))) - (buffer-substring (point) (line-end-position))))) - res)) - ;; `nice' could be `-'. - (setq res (rassq-delete-all '- res)) - (push (append res) result)) - (forward-line)) - ;; Return result. - result))))))) + (with-tramp-file-property vec "/" "process-attributes" + (ignore-errors + (with-temp-buffer + (hack-connection-local-variables-apply + (connection-local-criteria-for-default-directory)) + ;; (pop-to-buffer (current-buffer)) + (when (zerop + (apply + #'process-file "ps" nil t nil tramp-process-attributes-ps-args)) + (let (result res) + (goto-char (point-min)) + (while (not (eobp)) + ;; (tramp-test-message + ;; "%s" (buffer-substring (point) (line-end-position))) + (when (save-excursion + (search-forward-regexp + (rx digit) (line-end-position) 'noerror)) + (setq res nil) + (dolist (elt tramp-process-attributes-ps-format) + (push + (cons + (car elt) + (cond + ((eq (cdr elt) 'number) (read (current-buffer))) + ((eq (cdr elt) 'string) + (search-forward-regexp (rx (+ (not blank)))) + (match-string 0)) + ((numberp (cdr elt)) + (search-forward-regexp (rx (+ blank))) + (search-forward-regexp (rx (+ nonl)) (+ (point) (cdr elt))) + (string-trim (match-string 0))) + ((fboundp (cdr elt)) + (funcall (cdr elt))) + ((null (cdr elt)) + (search-forward-regexp (rx (+ blank))) + (buffer-substring (point) (line-end-position))))) + res)) + ;; `nice' could be `-'. + (setq res (rassq-delete-all '- res)) + (push (append res) result)) + (forward-line)) + ;; Return result. + result)))))) (defun tramp-handle-list-system-processes () "Like `list-system-processes' for Tramp files." @@ -4581,11 +4781,22 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (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))))) + (condition-case err + ;; When there is no connection, we don't do it. Otherwise, + ;; functions like `kill-buffer' would try to reestablish the + ;; connection. See Bug#61663. + (if-let ((v (tramp-dissect-file-name file)) + ((process-live-p (tramp-get-process v))) + (lockname (tramp-compat-make-lock-file-name file))) + (delete-file lockname) + ;; Trigger the unlock error. + (signal 'file-error `("Cannot remove lock file for" ,file))) + ;; `userlock--handle-unlock-error' exists since Emacs 28.1. It + ;; checks for `create-lockfiles' since Emacs 30.1, we don't need + ;; this check here, then. + (error (unless (or (not create-lockfiles) + (bound-and-true-p remote-file-name-inhibit-locks)) + (tramp-compat-funcall 'userlock--handle-unlock-error err))))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." @@ -4627,9 +4838,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") tramp-prefix-format proxy tramp-postfix-host-format)) (entry (list (and (stringp host-port) - (tramp-compat-rx bol (literal host-port) eol)) + (rx bol (literal host-port) eol)) (and (stringp user-domain) - (tramp-compat-rx bol (literal user-domain) eol)) + (rx bol (literal user-domain) eol)) (propertize proxy 'tramp-ad-hoc t)))) (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) ;; Add the hop. @@ -4687,7 +4898,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (unless (tramp-multi-hop-p item) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error - vec "Method `%s' is not supported for multi-hops." + vec "Method `%s' is not supported for multi-hops" (tramp-file-name-method item))))) ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the @@ -4702,14 +4913,14 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (or ;; The host name is used for the remote shell command. (member - "%h" (tramp-compat-flatten-tree + "%h" (flatten-tree (tramp-get-method-parameter item 'tramp-login-args))) ;; The host name must match previous hop. (string-match-p previous-host host)) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (tramp-compat-rx bol (literal host) eol))))) + (setq previous-host (rx bol (literal host) eol))))) ;; Result. target-alist)) @@ -4723,7 +4934,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (let ((args (tramp-get-method-parameter vec parameter)) (spec (apply 'format-spec-make spec-list))) ;; Expand format spec. - (tramp-compat-flatten-tree + (flatten-tree (mapcar (lambda (x) (setq x (mapcar (lambda (y) (format-spec y spec)) x)) @@ -4741,7 +4952,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (tramp-get-connection-property v "direct-async-process") ;; There's no multi-hop. (or (not (tramp-multi-hop-p v)) - (= (length (tramp-compute-multi-hops v)) 1)) + (null (cdr (tramp-compute-multi-hops v)))) ;; There's no remote stdout or stderr file. (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer))) (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) @@ -4822,7 +5033,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) (append (tramp-get-method-parameter v 'tramp-direct-async) - `(,(mapconcat #'identity command " "))) + `(,(string-join command " "))) command))) ;; Check for `tramp-sh-file-name-handler', because something @@ -4860,9 +5071,8 @@ substitution. SPEC-LIST is a list of char/value pairs used for (setq login-args (append - (tramp-compat-flatten-tree - (tramp-get-method-parameter v 'tramp-async-args)) - (tramp-compat-flatten-tree + (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) + (flatten-tree (mapcar (lambda (x) (split-string x " ")) (tramp-expand-args @@ -4880,6 +5090,11 @@ substitution. SPEC-LIST is a list of char/value pairs used for ;; t. See Bug#51177. (when filter (set-process-filter p filter)) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'remote-command orig-command) (tramp-set-connection-property p "remote-command" orig-command) @@ -5064,19 +5279,11 @@ support symbolic links." (when current-buffer-p (barf-if-buffer-read-only) (push-mark nil t)) - ;; `shell-command-save-pos-or-erase' has been introduced with - ;; Emacs 27.1. - (if (fboundp 'shell-command-save-pos-or-erase) - (tramp-compat-funcall - 'shell-command-save-pos-or-erase current-buffer-p) - (setq buffer-read-only nil) - (erase-buffer))) + (shell-command-save-pos-or-erase current-buffer-p)) (if (integerp asynchronous) (let ((tramp-remote-process-environment - ;; `async-shell-command-width' has been introduced with - ;; Emacs 27.1. - (if (natnump (bound-and-true-p async-shell-command-width)) + (if (natnump async-shell-command-width) (cons (format "COLUMNS=%d" (bound-and-true-p async-shell-command-width)) tramp-remote-process-environment) @@ -5097,17 +5304,19 @@ support symbolic links." (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5115,9 +5324,10 @@ support symbolic links." (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -5127,11 +5337,7 @@ support symbolic links." (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) - ;; `shell-command-set-point-after-cmd' has been - ;; introduced with Emacs 27.1. - (if (fboundp 'shell-command-set-point-after-cmd) - (tramp-compat-funcall - 'shell-command-set-point-after-cmd))) + (shell-command-set-point-after-cmd)) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) (display-message-or-buffer output-buffer))))))) @@ -5139,10 +5345,7 @@ support symbolic links." (defun tramp-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files. BUFFER might be a list, in this case STDERR is separated." - ;; `make-process' knows the `:file-handler' argument since Emacs - ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'. - (tramp-file-name-handler - 'make-process + (make-process :name name :buffer (if (consp buffer) (car buffer) buffer) :command (and program (cons program args)) @@ -5155,7 +5358,7 @@ BUFFER might be a list, in this case STDERR is separated." "Like `substitute-in-file-name' for Tramp files. \"//\" and \"/~\" substitute only in the local filename part." ;; Check, whether the local part is a quoted file name. - (if (tramp-compat-file-name-quoted-p filename) + (if (file-name-quoted-p filename) filename ;; First, we must replace environment variables. (setq filename (tramp-replace-environment-variables filename)) @@ -5186,6 +5389,12 @@ BUFFER might be a list, in this case STDERR is separated." (defconst tramp-time-doesnt-exist '(-1 65535) "An invalid time value, used as \"Doesn't exist\" value.") +(defsubst tramp-defined-time (time) + "Return TIME or nil (when TIME is not a time spec)." + (unless (or (time-equal-p time tramp-time-doesnt-exist) + (time-equal-p time tramp-time-dont-know)) + time)) + (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." (unless (buffer-file-name) @@ -5197,7 +5406,7 @@ BUFFER might be a list, in this case STDERR is separated." (or (file-attribute-modification-time (file-attributes (buffer-file-name))) tramp-time-doesnt-exist)))) - (unless (tramp-compat-time-equal-p time-list tramp-time-dont-know) + (unless (time-equal-p time-list tramp-time-dont-know) (tramp-run-real-handler #'set-visited-file-modtime (list time-list)))) (defun tramp-handle-verify-visited-file-modtime (&optional buf) @@ -5223,14 +5432,13 @@ of." (cond ;; File exists, and has a known modtime. - ((and attr - (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))) + ((and attr (not (time-equal-p modtime tramp-time-dont-know))) (< (abs (tramp-time-diff modtime mt)) 2)) ;; Modtime has the don't know value. (attr t) ;; If file does not exist, say it is not modified if and ;; only if that agrees with the buffer's record. - (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))) + (t (time-equal-p mt tramp-time-doesnt-exist)))))))) (defun tramp-handle-write-region (start end filename &optional append visit lockname mustbenew) @@ -5289,7 +5497,7 @@ of." ;; There might be pending output. Avoid problems with reentrant ;; call of Tramp. (ignore-errors - (while (tramp-accept-process-output proc 0))) + (while (tramp-accept-process-output proc))) (tramp-message proc 6 "Kill %S" proc) (delete-process proc)) @@ -5301,7 +5509,7 @@ of." (with-current-buffer (process-buffer proc) (file-exists-p (concat (file-remote-p default-directory) - (process-get proc 'watch-name)))))) + (process-get proc 'tramp-watch-name)))))) (defun tramp-file-notify-process-sentinel (proc event) "Call `file-notify-rm-watch'." @@ -5427,7 +5635,7 @@ Wait, until the connection buffer changes." ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (tramp-compat-ignore-error 'file-error + (while (not (ignore-error file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) @@ -5441,13 +5649,13 @@ Wait, until the connection buffer changes." "Check, whether a process has finished." (unless (process-live-p proc) ;; There might be pending output. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (cond ((and (not (process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") @@ -5478,7 +5686,7 @@ See `tramp-process-actions' for the format of ACTIONS." (while (not found) ;; Reread output once all actions have been performed. ;; Obviously, the output was not complete. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (setq todo actions) (while todo (setq item (pop todo) @@ -5521,7 +5729,7 @@ performed successfully. Any other value means an error." ;; use the "password-vector" property in case we have several hops. (tramp-set-connection-property (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) + proc "password-vector" (process-get proc 'tramp-vector)) "first-password-request" tramp-cache-read-persistent-data) (save-restriction (with-tramp-progress-reporter @@ -5595,11 +5803,22 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) -(defun tramp-accept-process-output (proc &optional timeout) +(defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also. If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." + (declare (advertised-calling-convention (proc) "29.2")) + ;; There could be other processes which use the same socket for + ;; communication. This could block the output for the current + ;; process. Read such output first. (Bug#61350) + ;; The process property isn't set anymore due to Bug#62194. + (when-let (((process-get proc 'tramp-shared-socket)) + (v (process-get proc 'tramp-vector))) + (dolist (p (delq proc (process-list))) + (when (tramp-file-name-equal-p v (process-get p 'tramp-vector)) + (with-local-quit (accept-process-output p 0 nil t))))) + (with-current-buffer (process-buffer proc) (let ((inhibit-read-only t) last-coding-system-used @@ -5609,10 +5828,10 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' ;; returns t in order to report success. (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) + (setq result (accept-process-output proc 0 nil t)) t) (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) + proc 10 "%s %s %s\n%s" + proc (process-status proc) result (buffer-string)) ;; Propagate quit. (keyboard-quit))) result))) @@ -5726,8 +5945,7 @@ the remote host use line-endings as defined in the variable (let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) ;; Replace "\n" by `tramp-rsh-end-of-line'. (setq string - (mapconcat - #'identity (split-string string "\n") tramp-rsh-end-of-line)) + (string-join (split-string string "\n") tramp-rsh-end-of-line)) (unless (or (string-empty-p string) (string-equal (substring string -1) tramp-rsh-end-of-line)) (setq string (concat string tramp-rsh-end-of-line))) @@ -5750,7 +5968,7 @@ the remote host use line-endings as defined in the variable (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." (unless (process-live-p proc) - (let ((vec (process-get proc 'vector)) + (let ((vec (process-get proc 'tramp-vector)) (buf (process-buffer proc)) (prompt (tramp-get-connection-property proc "prompt"))) (when vec @@ -5759,8 +5977,7 @@ the remote host use line-endings as defined in the variable (tramp-flush-directory-properties vec "/")) (when (buffer-live-p buf) (with-current-buffer buf - (when (and prompt - (tramp-search-regexp (tramp-compat-rx (literal prompt)))) + (when (and prompt (tramp-search-regexp (rx (literal prompt)))) (delete-region (point) (point-max)))))))) (defun tramp-get-inode (vec) @@ -5945,9 +6162,7 @@ ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property nil (format "gid-%s" id-format) (cond ((equal id-format 'integer) (group-gid)) - ;; `group-name' has been introduced with Emacs 27.1. - ((and (fboundp 'group-name) (equal id-format 'string)) - (tramp-compat-funcall 'group-name (group-gid))) + ((equal id-format 'string) (group-name (group-gid))) ((file-attribute-group-id (file-attributes "~/" id-format)))))) (defun tramp-get-local-locale (&optional vec) @@ -5964,7 +6179,7 @@ VEC is used for tracing." (while candidates (goto-char (point-min)) (if (string-match-p - (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -6295,7 +6510,7 @@ this file, if that variable is non-nil." ("|" . "__") ("[" . "_l") ("]" . "_r")) - (tramp-compat-file-name-unquote (buffer-file-name))) + (file-name-unquote (buffer-file-name))) tramp-auto-save-directory))) result) (prog1 ;; Run plain `make-auto-save-file-name'. @@ -6324,7 +6539,7 @@ ALIST is of the form ((FROM . TO) ...)." (let* ((pr (car alist)) (from (car pr)) (to (cdr pr))) - (while (string-match (tramp-compat-rx (literal from)) string) + (while (string-match (rx (literal from)) string) (setq string (replace-match to t t string))) (setq alist (cdr alist)))) string)) @@ -6353,6 +6568,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (destination (if (eq destination t) (current-buffer) destination)) (vec (or vec (car tramp-current-connection))) @@ -6373,7 +6589,7 @@ are written with verbosity of 6." (error (setq error (error-message-string err) result 1))) - (if (zerop (length error)) + (if (tramp-string-empty-or-nil-p error) (tramp-message vec 6 "%s\n%s" result output) (tramp-message vec 6 "%s\n%s\n%s" result output error)) result)) @@ -6385,6 +6601,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) result) @@ -6426,7 +6643,7 @@ verbosity of 6." (apply #'process-lines program args) (error (tramp-error vec (car err) (cdr err))))) - (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n")) + (tramp-message vec 6 "\n%s" (string-join result "\n")) result)) (defun tramp-process-running-p (process-name) @@ -6458,7 +6675,7 @@ Consults the auth-source package." ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. (vec (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector))) + proc "password-vector" (process-get proc 'tramp-vector))) (key (tramp-make-tramp-file-name vec 'noloc)) (method (tramp-file-name-method vec)) (user (or (tramp-file-name-user-domain vec) @@ -6509,7 +6726,7 @@ Consults the auth-source package." ;; Workaround. Prior Emacs 28.1, auth-source has saved empty ;; passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) + (when (tramp-string-empty-or-nil-p auth-passwd) (setq tramp-password-save-function nil)) (tramp-set-connection-property vec "first-password-request" nil) @@ -6559,7 +6776,7 @@ T1 and T2 are time values (as returned by `current-time' for example)." Suppress `shell-file-name'. This is needed on w32 systems, which would use a wrong quoting for local file names. See `w32-shell-name'." (let (shell-file-name) - (shell-quote-argument (tramp-compat-file-name-unquote s)))) + (shell-quote-argument (file-name-unquote s)))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -6592,7 +6809,7 @@ Only works for Bourne-like shells." (string= (substring result 0 2) "\\~")) (setq result (substring result 1))) (replace-regexp-in-string - (tramp-compat-rx "\\" (literal tramp-rsh-end-of-line)) + (rx "\\" (literal tramp-rsh-end-of-line)) (format "'%s'" tramp-rsh-end-of-line) result))))) ;;; Signal handling. This works for remote processes, which have set @@ -6621,13 +6838,14 @@ name of a process or buffer, or nil to default to the current buffer." ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command - (process-get proc 'vector) + (process-get proc 'tramp-vector) (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" pid pid - (tramp-get-remote-null-device (process-get proc 'vector)))) + (tramp-get-remote-null-device + (process-get proc 'tramp-vector)))) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (not (process-live-p proc)))))) (add-hook 'interrupt-process-functions #'tramp-interrupt-process) @@ -6650,7 +6868,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name." (cond ((processp process) (setq pid (process-get process 'remote-pid) - vec (process-get process 'vector))) + vec (process-get process 'tramp-vector))) ((numberp process) (setq pid process vec (and (stringp remote) (tramp-dissect-file-name remote)))) |