diff options
Diffstat (limited to 'lisp/net/tramp.el')
| -rw-r--r-- | lisp/net/tramp.el | 1189 |
1 files changed, 786 insertions, 403 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 88715e3230b..37259107147 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -257,6 +257,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: argument if it is supported. - \"%y\" is replaced by the `tramp-scp-force-scp-protocol' argument if it is supported. + - \"%z\" is replaced by the `tramp-scp-direct-remote-copying' + argument if it is supported. The existence of `tramp-login-args', combined with the absence of `tramp-copy-args', is an indication that the @@ -315,14 +317,20 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-connection-timeout' This is the maximum time to be spent for establishing a connection. In general, the global default value shall be used, but for - some methods, like \"su\" or \"sudo\", a shorter timeout - might be desirable. + some methods, like \"doas\", \"su\" or \"sudo\", a shorter + timeout might be desirable. * `tramp-session-timeout' How long a Tramp connection keeps open before being disconnected. - This is useful for methods like \"su\" or \"sudo\", which + This is useful for methods like \"doas\" or \"sudo\", which shouldn't run an open connection in the background forever. + * `tramp-password-previous-hop' + The password for this connection is the same like the + password for the previous hop. If there is no previous hop, + the password of the local user is applied. This is needed + for methods like \"doas\", \"sudo\" or \"sudoedit\". + * `tramp-case-insensitive' Whether the remote file system handles file names case insensitive. Only a non-nil value counts, the default value nil means to @@ -514,11 +522,12 @@ host runs a restricted shell, it shall be added to this list, too." (concat "\\`" (regexp-opt - (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t) + `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1" "::1") + t) "\\'") "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "27.1" + :version "29.1" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) @@ -754,11 +763,11 @@ The answer will be provided by `tramp-action-process-alive', (defconst tramp-temp-name-prefix "tramp." "Prefix to use for temporary files. -If this is a relative file name (such as \"tramp.\"), it is considered -relative to the directory name returned by the function -`tramp-compat-temporary-file-directory' (which see). It may also be an -absolute file name; don't forget to include a prefix for the filename -part, though.") +If this is a relative file name (such as \"tramp.\"), it is +considered relative to the directory name returned by the +function `temporary-file-directory' (which see). It may also be +an absolute file name; don't forget to include a prefix for the +filename part, though.") (defconst tramp-temp-buffer-name " *tramp temp*" "Buffer name for a temporary buffer. @@ -825,11 +834,10 @@ to be set, depending on VALUE." (tramp-register-file-name-handlers)) ;; Initialize the Tramp syntax variables. We want to override initial -;; value of `tramp-file-name-regexp'. Other Tramp syntax variables -;; must be initialized as well to proper values. We do not call +;; value of `tramp-file-name-regexp'. We do not call ;; `custom-set-variable', this would load Tramp via custom.el. (tramp--with-startup - (tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax))) + (tramp-set-syntax 'tramp-syntax tramp-syntax)) (defun tramp-syntax-values () "Return possible values of `tramp-syntax', a list." @@ -839,9 +847,9 @@ to be set, depending on VALUE." values)) (defun tramp-lookup-syntax (alist) - "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax'. -Raise an error if `tramp-syntax' is invalid." - (or (cdr (assq (tramp-compat-tramp-syntax) alist)) + "Look up a syntax string in ALIST according to `tramp-syntax'. +Raise an error if it is invalid." + (or (cdr (assq tramp-syntax alist)) (error "Wrong `tramp-syntax' %s" tramp-syntax))) (defconst tramp-prefix-format-alist @@ -1376,7 +1384,8 @@ 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") + 'tramp-completion-reread-directory-timeout + 'remote-file-name-inhibit-cache "27.2") ;;; Internal Variables: @@ -1391,6 +1400,11 @@ 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 + "Whether several passwords might be requested. +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 . tramp-completion-handle-file-name-all-completions) @@ -1412,8 +1426,7 @@ calling HANDLER.") ;; internal data structure. Convenience functions for internal ;; data structure. -;; The basic structure for remote file names. We use a list :type, in -;; order to be compatible with Emacs 25. We must autoload it in +;; The basic structure for remote file names. We must autoload it in ;; tramp-loaddefs.el, because some functions, which need it, wouldn't ;; work otherwise when unloading / reloading Tramp. (Bug#50869) ;;;###tramp-autoload @@ -1428,6 +1441,11 @@ calling HANDLER.") (put #'tramp-file-name-localname 'tramp-suppress-trace t) (put #'tramp-file-name-hop 'tramp-suppress-trace t) +;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'. +(defconst tramp-null-hop + (make-tramp-file-name :user (user-login-name) :host tramp-system-name) +"Connection hop which identifies the virtual hop before the first one.") + (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)) @@ -1484,7 +1502,7 @@ entry does not exist, return nil." (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. - (tramp-get-connection-property vec hash-entry nil) + (tramp-get-connection-property vec hash-entry) ;; Use the static value from `tramp-methods'. (when-let ((methods-entry (assoc @@ -1528,7 +1546,7 @@ of `process-file', `start-file-process', or `shell-command'." (or (and (tramp-tramp-file-p name) (string-match (nth 0 tramp-file-name-structure) name) (match-string (nth 4 tramp-file-name-structure) name)) - (tramp-compat-file-local-name name))) + (file-local-name name))) ;; The localname can be quoted with "/:". Extract this. (defun tramp-unquote-file-local-name (name) @@ -1675,6 +1693,18 @@ default values are used." (put #'tramp-dissect-file-name 'tramp-suppress-trace t) +(defun tramp-ensure-dissected-file-name (vec-or-filename) + "Return a `tramp-file-name' structure for VEC-OR-FILENAME. + +VEC-OR-FILENAME may be either a string or a `tramp-file-name'. +If it's not a Tramp filename, return nil." + (cond + ((tramp-file-name-p vec-or-filename) vec-or-filename) + ((tramp-tramp-file-p vec-or-filename) + (tramp-dissect-file-name vec-or-filename)))) + +(put #'tramp-ensure-dissected-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." @@ -1709,13 +1739,10 @@ See `tramp-dissect-file-name' for details." "Construct a Tramp file name from ARGS. ARGS could have two different signatures. The first one is of -type (VEC &optional LOCALNAME HOP). +type (VEC &optional LOCALNAME). If LOCALNAME is nil, the value in VEC is used. If it is a symbol, a null localname will be used. Otherwise, LOCALNAME is expected to be a string, which will be used. -If HOP is nil, the value in VEC is used. If it is a symbol, a -null hop will be used. Otherwise, HOP is expected to be a -string, which will be used. The other signature exists for backward compatibility. It has the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." @@ -1731,8 +1758,13 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." hop (tramp-file-name-hop (car args))) (when (cadr args) (setq localname (and (stringp (cadr args)) (cadr args)))) - (when (cl-caddr args) - (setq hop (and (stringp (cl-caddr args)) (cl-caddr args))))) + (when hop + (setq hop nil) + ;; Assure that the hops are in `tramp-default-proxies-alist'. + ;; In tramp-archive.el, the slot `hop' is used for the archive + ;; file name. + (unless (string-equal method "archive") + (tramp-add-hops (car args))))) (t (setq method (nth 0 args) user (nth 1 args) @@ -1765,15 +1797,17 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." localname))) (set-advertised-calling-convention - #'tramp-make-tramp-file-name '(vec &optional localname hop) "27.1") + #'tramp-make-tramp-file-name '(vec &optional localname) "29.1") (defun tramp-make-tramp-hop-name (vec) "Construct a Tramp hop name from VEC." - (replace-regexp-in-string - tramp-prefix-regexp "" + (concat + (tramp-file-name-hop vec) (replace-regexp-in-string - (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format - (tramp-make-tramp-file-name vec 'noloc)))) + tramp-prefix-regexp "" + (replace-regexp-in-string + (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format + (tramp-make-tramp-file-name vec 'noloc))))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. @@ -1804,10 +1838,10 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet." ;; as indication, whether a connection is active. (tramp-set-connection-property vec "process-buffer" - (tramp-get-connection-property vec "process-buffer" nil)) + (tramp-get-connection-property vec "process-buffer")) (setq buffer-undo-list t default-directory - (tramp-make-tramp-file-name vec 'noloc 'nohop)) + (tramp-make-tramp-file-name vec 'noloc)) (current-buffer))))) (defun tramp-get-connection-buffer (vec &optional dont-create) @@ -1815,14 +1849,14 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet." Unless DONT-CREATE, the buffer is created when it doesn't exist yet. In case a second asynchronous communication has been started, it is different from `tramp-get-buffer'." - (or (tramp-get-connection-property vec "process-buffer" nil) + (or (tramp-get-connection-property vec "process-buffer") (tramp-get-buffer vec dont-create))) (defun tramp-get-connection-name (vec) "Get the connection name to be used for VEC. In case a second asynchronous communication has been started, it is different from the default one." - (or (tramp-get-connection-property vec "process-name" nil) + (or (tramp-get-connection-property vec "process-name") (tramp-buffer-name vec))) (defun tramp-get-process (vec-or-proc) @@ -1845,9 +1879,7 @@ from the default one." If connection-local variables are not supported by this Emacs version, the function does nothing." (with-current-buffer (tramp-get-connection-buffer vec) - ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. - (tramp-compat-funcall - 'hack-connection-local-variables-apply + (hack-connection-local-variables-apply `(:application tramp :protocol ,(tramp-file-name-method vec) :user ,(tramp-file-name-user-domain vec) @@ -1858,14 +1890,27 @@ version, the function does nothing." If connection-local variables are not supported by this Emacs version, the function does nothing." (when (tramp-tramp-file-p default-directory) - ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. - (tramp-compat-funcall - 'hack-connection-local-variables-apply + (hack-connection-local-variables-apply `(:application tramp :protocol ,(file-remote-p default-directory 'method) :user ,(file-remote-p default-directory 'user) :machine ,(file-remote-p default-directory 'host))))) +(defsubst tramp-get-default-directory (buffer) + "Return `default-directory' of BUFFER." + (buffer-local-value 'default-directory buffer)) + +(put #'tramp-get-default-directory 'tramp-suppress-trace t) + +(defsubst tramp-get-buffer-string (&optional buffer) + "Return contents of BUFFER. +If BUFFER is not a buffer or a buffer name, return the contents +of `current-buffer'." + (with-current-buffer (or buffer (current-buffer)) + (substring-no-properties (buffer-string)))) + +(put #'tramp-get-buffer-string 'tramp-suppress-trace t) + (defun tramp-debug-buffer-name (vec) "A name for the debug buffer for VEC." (let ((method (tramp-file-name-method vec)) @@ -1904,29 +1949,56 @@ The outline level is equal to the verbosity of the Tramp message." (put #'tramp-debug-outline-level 'tramp-suppress-trace t) +;; This function takes action since Emacs 28.1, when +;; `read-extended-command-predicate' is set to +;; `command-completion-default-include-p'. +(defun tramp-debug-buffer-command-completion-p (_symbol buffer) + "A predicate for Tramp interactive commands. +They are completed by \"M-x TAB\" only in Tramp debug buffers." + (with-current-buffer buffer + (string-equal + (buffer-substring (point-min) (min (+ (point-min) 10) (point-max))) ";; Emacs:"))) + +(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t) + +(defun tramp-setup-debug-buffer () + "Function to setup debug buffers." + ;; (declare (completion tramp-debug-buffer-command-completion-p)) + (interactive) + (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 die. + ;; Yes: I've seen `flyspell-mode', which starts "ispell". + ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises + ;; on error in `(outline-mode)', we don't want to see it in the + ;; traces. + (let ((default-directory tramp-compat-temporary-file-directory)) + (outline-mode)) + (setq-local outline-level 'tramp-debug-outline-level) + (setq-local 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) + ;; For debugging purposes. + (local-set-key "\M-n" 'clone-buffer) + (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local)) + +(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t) + +(function-put + #'tramp-setup-debug-buffer 'completion-predicate + #'tramp-debug-buffer-command-completion-p) + (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 - ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". - ;; `(custom-declare-variable outline-minor-mode-prefix ...)' - ;; raises on error in `(outline-mode)', we don't want to see it - ;; in the traces. - (let ((default-directory tramp-compat-temporary-file-directory)) - (outline-mode)) - (setq-local outline-level 'tramp-debug-outline-level) - (setq-local 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)) + (tramp-setup-debug-buffer)) (current-buffer))) (put #'tramp-get-debug-buffer 'tramp-suppress-trace t) @@ -1988,9 +2060,7 @@ ARGUMENTS to actually emit the message (if applicable)." (unless (bolp) (insert "\n")) ;; Timestamp. - (let ((now (current-time))) - (insert (format-time-string "%T." now)) - (insert (format "%06d " (nth 2 now)))) + (insert (format-time-string "%T.%6N ")) ;; Calling Tramp function. We suppress compat and trace ;; functions from being displayed. (let ((btn 1) btf fn) @@ -2060,12 +2130,15 @@ applicable)." ;; Append connection buffer for error messages, if exists. (when (= level 1) (ignore-errors - (with-current-buffer - (if (processp vec-or-proc) - (process-buffer vec-or-proc) - (tramp-get-connection-buffer vec-or-proc 'dont-create)) - (setq fmt-string (concat fmt-string "\n%s") - arguments (append arguments (list (buffer-string))))))) + (setq fmt-string (concat fmt-string "\n%s") + arguments + (append + arguments + `(,(tramp-get-buffer-string + (if (processp vec-or-proc) + (process-buffer vec-or-proc) + (tramp-get-connection-buffer + vec-or-proc 'dont-create)))))))) ;; Translate proc to vec. (when (processp vec-or-proc) (setq vec-or-proc (process-get vec-or-proc 'vector)))) @@ -2078,15 +2151,17 @@ applicable)." (put #'tramp-message 'tramp-suppress-trace t) -(defsubst tramp-backtrace (&optional vec-or-proc) +(defsubst tramp-backtrace (&optional vec-or-proc force) "Dump a backtrace into the debug buffer. -If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This -function is meant for debugging purposes." - (when (>= tramp-verbose 10) - (if vec-or-proc - (tramp-message - vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) - (with-output-to-temp-buffer "*debug tramp*" (backtrace))))) +If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE +forces the backtrace even if `tramp-verbose' is less than 10. +This function is meant for debugging purposes." + (let ((tramp-verbose (if force 10 tramp-verbose))) + (when (>= tramp-verbose 10) + (if vec-or-proc + (tramp-message + vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) + (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))) (put #'tramp-backtrace 'tramp-suppress-trace t) @@ -2116,6 +2191,11 @@ FMT-STRING and ARGUMENTS." (put #'tramp-error 'tramp-suppress-trace t) +(defvar tramp-error-show-message-timeout 30 + "Time to show the Tramp buffer in case of an error. +If it is bound to nil, the buffer is not shown. This is used in +tramp-tests.el.") + (defsubst tramp-error-with-buffer (buf vec-or-proc signal fmt-string &rest arguments) "Emit an error, and show BUF. @@ -2127,12 +2207,13 @@ an input event arrives. The other arguments are passed to `tramp-error'." (and (tramp-file-name-p vec-or-proc) (tramp-get-connection-buffer vec-or-proc)))) (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc) - (and buf (with-current-buffer buf - (tramp-dissect-file-name default-directory)))))) + (and buf (tramp-dissect-file-name + (tramp-get-default-directory buf)))))) (unwind-protect (apply #'tramp-error vec-or-proc signal fmt-string arguments) ;; Save exit. (when (and buf + (natnump tramp-error-show-message-timeout) (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) @@ -2146,7 +2227,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; Show buffer. (pop-to-buffer buf) (discard-input) - (sit-for 30))) + (sit-for tramp-error-show-message-timeout))) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) @@ -2159,7 +2240,8 @@ an input event arrives. The other arguments are passed to `tramp-error'." (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. - (when (and (not (zerop tramp-verbose)) + (when (and (natnump tramp-error-show-message-timeout) + (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) ;; Show only when Emacs has started already. @@ -2169,7 +2251,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; `tramp-error' does not show messages. So we must do it ourselves. (apply #'message fmt-string arguments) (discard-input) - (sit-for 30) + (sit-for tramp-error-show-message-timeout) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) @@ -2249,8 +2331,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (ignore ,@(mapcar #'car bindings)) ,@body))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) - (defun tramp-progress-reporter-update (reporter &optional value suffix) "Report progress of an operation for Tramp." (let* ((parameters (cdr reporter)) @@ -2273,7 +2353,7 @@ without a visible progress reporter." ;; running, and when there is a minimum level. (when-let ((pr (and (null tramp-inhibit-progress-reporter) (<= ,level (min tramp-verbose 3)) - (make-progress-reporter ,message nil nil)))) + (make-progress-reporter ,message)))) (run-at-time 3 0.1 #'tramp-progress-reporter-update pr)))) (unwind-protect ;; Execute the body. @@ -2287,9 +2367,6 @@ without a visible progress reporter." (if tm (cancel-timer tm)) (tramp-message ,vec ,level "%s...%s" ,message cookie))))) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) - (defmacro with-tramp-file-property (vec file property &rest body) "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. FILE must be a local file name on a connection identified via VEC." @@ -2306,8 +2383,6 @@ FILE must be a local file name on a connection identified via VEC." value) ,@body)) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) - (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)) @@ -2321,8 +2396,15 @@ FILE must be a local file name on a connection identified via VEC." (tramp-set-connection-property ,key ,property value)) value)) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) +(defmacro with-tramp-saved-connection-property (key property &rest body) + "Save PROPERTY, run BODY, reset PROPERTY." + (declare (indent 2) (debug t)) + `(let ((value (tramp-get-connection-property + ,key ,property tramp-cache-undefined))) + (unwind-protect (progn ,@body) + (if (eq value tramp-cache-undefined) + (tramp-flush-connection-property ,key ,property) + (tramp-set-connection-property ,key ,property value))))) (defun tramp-drop-volume-letter (name) "Cut off unnecessary drive letter from file NAME. @@ -2417,7 +2499,7 @@ For definition of that list see `tramp-set-completion-function'." (defun tramp-default-file-modes (filename &optional flag) "Return file modes of FILENAME as integer. -If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a +If optional FLAG is `nofollow', do not follow FILENAME if it is a symbolic link. If the file modes of FILENAME cannot be determined, return the value of `default-file-modes', without execute permissions." @@ -2459,6 +2541,7 @@ arguments to pass to the OPERATION." ,(and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation) + (args (if (tramp-file-name-p (car args)) (cons nil (cdr args)) args)) signal-hook-function) (apply operation args))) @@ -2486,19 +2569,17 @@ Must be handled by the callers." file-accessible-directory-p file-attributes file-directory-p file-executable-p file-exists-p file-local-copy file-modes file-name-as-directory - file-name-directory 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 + file-name-case-insensitive-p file-name-directory + 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 make-directory-internal set-file-acl set-file-modes set-file-selinux-context set-file-times substitute-in-file-name unhandled-file-name-directory vc-registered - ;; Emacs 26+ only. - file-name-case-insensitive-p ;; Emacs 27+ only. file-system-info ;; Emacs 28+ only. @@ -2511,8 +2592,6 @@ Must be handled by the callers." (nth 0 args) default-directory)) ;; STRING FILE. - ;; Starting with Emacs 26.1, just the 2nd argument of - ;; `make-symbolic-link' matters. ((eq operation 'make-symbolic-link) (nth 1 args)) ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation @@ -2543,32 +2622,43 @@ Must be handled by the callers." (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. ((member operation - '(process-file shell-command start-file-process - ;; Emacs 26+ only. - make-nearby-temp-file temporary-file-directory + '(make-nearby-temp-file process-file shell-command + start-file-process temporary-file-directory ;; Emacs 27+ only. - exec-path make-process)) + exec-path make-process + ;; Emacs 29+ only. + list-system-processes process-attributes)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) (when (processp (nth 0 args)) - (with-current-buffer (process-buffer (nth 0 args)) - default-directory))) + (tramp-get-default-directory (process-buffer (nth 0 args))))) ;; VEC. - ((member operation '(tramp-get-remote-gid tramp-get-remote-uid)) + ((member operation + '(tramp-get-home-directory + tramp-get-remote-gid tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) ;; Unknown file primitive. (t (error "Unknown file I/O primitive: %s" operation)))) -(defun tramp-find-foreign-file-name-handler (filename &optional _operation) +(defun tramp-find-foreign-file-name-handler (vec &optional _operation) "Return foreign file name handler if exists." - (when (tramp-tramp-file-p filename) + (when (tramp-file-name-p vec) (let ((handler tramp-foreign-file-name-handler-alist) - elt res) + elt func res) (while handler (setq elt (car handler) handler (cdr handler)) - (when (funcall (car elt) filename) + ;; Previously, this function was called with FILENAME, but now + ;; it's called with the VEC. + (when (condition-case nil + (funcall (setq func (car elt)) vec) + (error + (setcar elt #'ignore) + (unless (member 'remote-file-error debug-ignored-errors) + (tramp-error + vec 'remote-file-error + "Not a valid Tramp file name function `%s'" func)))) (setq handler nil res (cdr elt)))) res))) @@ -2587,7 +2677,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (with-parsed-tramp-file-name filename nil (let ((current-connection tramp-current-connection) (foreign - (tramp-find-foreign-file-name-handler filename operation)) + (tramp-find-foreign-file-name-handler v operation)) (signal-hook-function #'tramp-signal-hook-function) result) ;; Set `tramp-current-connection'. @@ -2634,6 +2724,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (tramp-message v 5 "Non-essential received in operation %s" (cons operation args)) + (let ((tramp-verbose 10)) (tramp-backtrace v)) (tramp-run-real-handler operation args)) ((eq result 'suppress) (let ((inhibit-message t)) @@ -2771,8 +2862,9 @@ remote file names." (defun tramp-register-foreign-file-name-handler (func handler &optional append) "Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'. -FUNC is the function, which determines whether HANDLER is to be called. -Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." +FUNC is the function, which takes a dissected filename and determines +whether HANDLER is to be called. Add operations defined in +`HANDLER-alist' to `tramp-file-name-handler'." (add-to-list 'tramp-foreign-file-name-handler-alist `(,func . ,handler) append) ;; Mark `operations' the handler is responsible for. @@ -2824,18 +2916,14 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." (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))) + (tramp-tramp-file-p (tramp-get-default-directory buffer))) (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 not in completion mode." (let ((tramp-verbose 0) - (vec - (cond - ((tramp-file-name-p vec-or-filename) vec-or-filename) - ((tramp-tramp-file-p vec-or-filename) - (tramp-dissect-file-name vec-or-filename))))) + (vec (tramp-ensure-dissected-file-name vec-or-filename))) (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. @@ -2881,7 +2969,7 @@ not in completion mode." (m (tramp-find-method method user host)) all-user-hosts) - (unless localname ;; Nothing to complete. + (unless localname ;; Nothing to complete. (if (or user host) @@ -3285,6 +3373,129 @@ User is always nil." (forward-line 1) result)) +;;; Skeleton macros for file name handler functions. + +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +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))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + +(defmacro tramp-skeleton-write-region + (start end filename append visit lockname mustbenew &rest body) + "Skeleton for `tramp-*-handle-write-region'. +BODY is the backend specific code." + (declare (indent 7) (debug t)) + ;; Sometimes, there is another file name handler responsible for + ;; VISIT, for example `jka-compr-handler'. We must respect this. + ;; See Bug#55166. + `(let* ((filename (expand-file-name ,filename)) + (lockname (file-truename (or ,lockname filename))) + (handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + `(tramp-file-name-handler + tramp-crypt-file-name-handler + . inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) + (with-parsed-tramp-file-name filename nil + (if handler + (progn + (tramp-message + v 5 "Calling handler `%s' for visiting `%s'" handler ,visit) + (funcall + handler 'write-region + ,start ,end filename ,append ,visit lockname ,mustbenew)) + + (when (and ,mustbenew (file-exists-p filename) + (or (eq ,mustbenew 'excl) + (not + (y-or-n-p + (format + "File %s exists; overwrite anyway?" filename))))) + (tramp-error v 'file-already-exists filename)) + + (let ((file-locked (eq (file-locked-p lockname) t)) + (uid (or (file-attribute-user-id + (file-attributes filename 'integer)) + (tramp-get-remote-uid v 'integer))) + (gid (or (file-attribute-group-id + (file-attributes filename 'integer)) + (tramp-get-remote-gid v 'integer))) + (attributes (file-extended-attributes filename)) + (curbuf (current-buffer))) + + ;; 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)) + + ;; The body. + ,@body + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ;; We must protect `last-coding-system-used', now we have + ;; set it to its correct value. + (let (last-coding-system-used (need-chown t)) + ;; Set file modification time. + (when (or (eq ,visit t) (stringp ,visit)) + (when-let ((file-attr (file-attributes filename 'integer))) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME + ;; can be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))) + (when (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid filename uid gid))) + + ;; Set extended attributes. We ignore possible errors, + ;; because ACL strings could be incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes filename attributes))) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook)))))) + +(put #'tramp-skeleton-write-region 'tramp-suppress-trace t) + ;;; Common file name handler functions for different backends: (defvar tramp-handle-file-local-copy-hook nil @@ -3293,6 +3504,42 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defvar tramp-tolerate-tilde nil + "Indicator, that not expandable tilde shall be tolerated. +Let-bind it when necessary.") + +;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists +;; since Emacs 29.1. Since this handler isn't called for older +;; Emacsen, it is save to invoke them via `tramp-compat-funcall'. +(defun tramp-handle-abbreviate-file-name (filename) + "Like `abbreviate-file-name' for Tramp files." + (let* ((case-fold-search (file-name-case-insensitive-p filename)) + (vec (tramp-dissect-file-name filename)) + (tramp-tolerate-tilde t) + (home-dir + (if (let ((non-essential t)) (tramp-connectable-p vec)) + ;; If a connection has already been established, get the + ;; home directory. + (tramp-get-home-directory vec) + ;; Otherwise, just use the cached value. + (tramp-get-connection-property vec "~")))) + (when home-dir + (setq home-dir + (tramp-compat-funcall + 'directory-abbrev-apply + (tramp-make-tramp-file-name vec home-dir)))) + ;; If any elt of `directory-abbrev-alist' matches this name, + ;; abbreviate accordingly. + (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) + ;; Abbreviate home directory. + (if (and home-dir + (string-match + (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) + filename)) + (tramp-make-tramp-file-name + vec (concat "~" (substring filename (match-beginning 1)))) + (tramp-make-tramp-file-name (tramp-dissect-file-name filename))))) + (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) @@ -3303,10 +3550,11 @@ User is always nil." (if (file-directory-p filename) #'file-accessible-directory-p #'file-readable-p) filename) - (tramp-error - v 'file-error (format "%s: Permission denied, %s" string filename))) - (tramp-compat-file-missing - v (format "%s: No such file or directory, %s" string filename))))) + (tramp-compat-permission-denied + v (format "%s: Permission denied, %s" string filename))) + (tramp-error + v 'file-missing + (format "%s: No such file or directory, %s" string filename))))) (defun tramp-handle-add-name-to-file (filename newname &optional ok-if-already-exists) @@ -3340,7 +3588,7 @@ User is always nil." ;; `copy-directory' creates NEWNAME before running this check. So ;; we do it ourselves. (unless (file-exists-p directory) - (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) + (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) ;; We must do it file-wise. (tramp-run-real-handler #'copy-directory @@ -3361,7 +3609,7 @@ User is always nil." (defun tramp-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) + (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) @@ -3393,10 +3641,6 @@ User is always nil." (if (file-directory-p dir) dir (file-name-directory dir)) nil (tramp-flush-directory-properties v localname))) -(defvar tramp-tolerate-tilde nil - "Indicator, that not expandable tilde shall be tolerated. -Let-bind it when necessary.") - (defun tramp-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". @@ -3408,11 +3652,22 @@ Let-bind it when necessary.") (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)) + (tramp-run-real-handler #'expand-file-name (list name)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; Expand tilde. Usually, the methods applying this handler do + ;; not support tilde expansion. But users could declare a + ;; respective connection property. (Bug#53847) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) @@ -3437,9 +3692,7 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (eq (tramp-compat-file-attribute-type - (file-attributes (file-truename filename))) - t)) + (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." @@ -3471,7 +3724,7 @@ Let-bind it when necessary.") "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) - (tramp-compat-file-missing v filename)) + (tramp-error v 'file-missing filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) @@ -3479,7 +3732,7 @@ Let-bind it when necessary.") (defun tramp-handle-file-modes (filename &optional flag) "Like `file-modes' for Tramp files." (when-let ((attrs (file-attributes filename)) - (mode-string (tramp-compat-file-attribute-modes attrs))) + (mode-string (file-attribute-modes attrs))) (if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0))) (file-modes (file-truename filename)) (tramp-mode-string-to-int mode-string)))) @@ -3511,7 +3764,7 @@ Let-bind it when necessary.") (tramp-get-method-parameter v 'tramp-case-insensitive) ;; There isn't. So we must check, in case there's a connection already. - (and (file-remote-p filename nil 'connected) + (and (let ((non-essential t)) (tramp-connectable-p v)) (with-tramp-connection-property v "case-insensitive" (ignore-errors (with-tramp-progress-reporter v 5 "Checking case-insensitive" @@ -3532,16 +3785,13 @@ Let-bind it when necessary.") (directory-file-name (file-name-directory candidate)))) ;; Nothing found, so we must use a temporary file - ;; for comparison. `make-nearby-temp-file' is added - ;; to Emacs 26+ like `file-name-case-insensitive-p', - ;; so there is no compatibility problem calling it. + ;; for comparison. (unless (string-match-p "[[:lower:]]" (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory - (file-name-directory filename))) - (tramp-compat-funcall - 'make-nearby-temp-file "tramp.")) + (file-name-directory filename))) + (make-nearby-temp-file "tramp.")) candidate tmpfile)) ;; Check for the existence of the same file with ;; upper case letters. @@ -3602,9 +3852,8 @@ Let-bind it when necessary.") ((not (file-exists-p file1)) nil) ((not (file-exists-p file2)) t) (t (time-less-p - (tramp-compat-file-attribute-modification-time (file-attributes file2)) - (tramp-compat-file-attribute-modification-time - (file-attributes file1)))))) + (file-attribute-modification-time (file-attributes file2)) + (file-attribute-modification-time (file-attributes file1)))))) (defun tramp-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -3623,17 +3872,17 @@ Let-bind it when necessary.") ;; Sometimes, `file-attributes' does not return a proper value ;; even if `file-exists-p' does. (when-let ((attr (file-attributes filename))) - (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0))))) + (eq ?- (aref (file-attribute-modes attr) 0))))) (defun tramp-handle-file-remote-p (filename &optional identification connected) "Like `file-remote-p' for Tramp files." ;; We do not want traces in the debug buffer. (let ((tramp-verbose (min tramp-verbose 3))) (when (tramp-tramp-file-p filename) - (let* ((v (tramp-dissect-file-name filename)) - (p (tramp-get-connection-process v)) + (let* ((o (tramp-dissect-file-name filename)) + (p (tramp-get-connection-process o)) (c (and (process-live-p p) - (tramp-get-connection-property p "connected" nil)))) + (tramp-get-connection-property p "connected")))) ;; We expand the file name only, if there is already a connection. (with-parsed-tramp-file-name (if c (expand-file-name filename) filename) nil @@ -3645,7 +3894,8 @@ Let-bind it when necessary.") ((eq identification 'user) (tramp-file-name-user-domain v)) ((eq identification 'host) (tramp-file-name-host-port v)) ((eq identification 'localname) localname) - ((eq identification 'hop) hop) + ;; Hop exists only in original dissected file name. + ((eq identification 'hop) (tramp-file-name-hop o)) (t (tramp-make-tramp-file-name v 'noloc))))))))) (defun tramp-handle-file-selinux-context (_filename) @@ -3655,7 +3905,7 @@ Let-bind it when necessary.") (defun tramp-handle-file-symlink-p (filename) "Like `file-symlink-p' for Tramp files." - (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) + (let ((x (file-attribute-type (file-attributes filename)))) (and (stringp x) x))) (defun tramp-handle-file-truename (filename) @@ -3696,8 +3946,7 @@ Let-bind it when necessary.") (expand-file-name symlink-target (file-name-directory v2-localname)))) - v2-localname) - 'nohop))) + v2-localname)))) (when (>= numchase numchase-limit) (tramp-error v1 'file-error @@ -3744,7 +3993,7 @@ Let-bind it when necessary.") (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 + (zerop (or (file-attribute-user-id (file-attributes filename 'integer)) tramp-unknown-id-integer)) (not (with-tramp-connection-property @@ -3801,7 +4050,7 @@ Let-bind it when necessary.") (unwind-protect (if (not (file-exists-p filename)) (let ((tramp-verbose (if visit 0 tramp-verbose))) - (tramp-compat-file-missing v filename)) + (tramp-error v 'file-missing filename)) (with-tramp-progress-reporter v 3 (format-message "Inserting `%s'" filename) @@ -3856,8 +4105,7 @@ Let-bind it when necessary.") (cond ((stringp remote-copy) (file-local-copy - (tramp-make-tramp-file-name - v remote-copy 'nohop))) + (tramp-make-tramp-file-name v remote-copy))) ((stringp tramp-temp-buffer-file-name) (copy-file filename tramp-temp-buffer-file-name 'ok) @@ -3900,11 +4148,162 @@ Let-bind it when necessary.") (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)))) + (delete-file (tramp-make-tramp-file-name v remote-copy)))) ;; Result. (cons filename (cdr result))))) +(defun tramp-ps-time () + "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\". +Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." + (search-forward-regexp "\\s-+") + (search-forward-regexp + (concat + "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?" + "\\([0-9]+\\):" "\\)?" + "\\([0-9]+\\):" + ;; Seconds can also be a floating point number. + "\\([0-9.]+\\)") + (line-end-position) 'noerror) + (+ (* 24 60 60 (string-to-number (or (match-string 1) "0"))) + (* 60 60 (string-to-number (or (match-string 2) "0"))) + (* 60 (string-to-number (or (match-string 3) "0"))) + (string-to-number (or (match-string 4) "0")))) + +(defconst tramp-process-attributes-ps-args + `("-eww" + "-o" + ,(mapconcat + #'identity + '("pid" + "euid" + "euser" + "egid" + "egroup" + "comm:80" + "state" + "ppid" + "pgrp" + "sess" + "tname" + "tpgid" + "min_flt" + "maj_flt" + "times" + "pri" + "nice" + "thcount" + "vsize" + "rss" + "etimes" + "pcpu" + "pmem" + "args") + ",")) + "List of arguments for calling \"ps\". +See `tramp-get-process-attributes'. + +This list is the default value on remote GNU/Linux systems.") + +(defconst tramp-process-attributes-ps-format + '((pid . number) + (euid . number) + (user . string) + (egid . number) + (group . string) + (comm . 80) + (state . string) + (ppid . number) + (pgrp . number) + (sess . number) + (ttname . string) + (tpgid . number) + (minflt . number) + (majflt . number) + (time . number) + (pri . number) + (nice . number) + (thcount . number) + (vsize . number) + (rss . number) + (etime . number) + (pcpu . number) + (pmem . number) + (args . nil)) + "Alist where each element is a cons cell of the form `\(KEY . TYPE)'. +KEY is a key (symbol) used in `process-attributes'. TYPE is the +printed result for KEY of the \"ps\" command, it can be `number', +`string', a number (string of that length), a symbol (a function +to be applied), or nil (for the last column of the \"ps\" output. + +This alist is used to parse the output of calling \"ps\" in +`tramp-get-process-attributes'. + +This alist is the default value on remote GNU/Linux systems.") + +(defun tramp-get-process-attributes (vec) + "Return all process attributes for connection VEC. +Parsing the remote \"ps\" output is controlled by +`tramp-process-attributes-ps-args' and +`tramp-process-attributes-ps-format'. + +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 + "[[: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 "\\S-+") + (match-string 0)) + ((numberp (cdr elt)) + (search-forward-regexp "\\s-+") + (search-forward-regexp ".+" (+ (point) (cdr elt))) + (string-trim (match-string 0))) + ((fboundp (cdr elt)) + (funcall (cdr elt))) + ((null (cdr elt)) + (search-forward-regexp "\\s-+") + (buffer-substring (point) (line-end-position))) + (t nil))) + 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." + (let ((v (tramp-dissect-file-name default-directory))) + (tramp-flush-file-property v "/" "process-attributes") + (mapcar (lambda (x) (cdr (assq 'pid x))) (tramp-get-process-attributes v)))) + (defun tramp-get-lock-file (file) "Read lockfile info of FILE. Return nil when there is no lockfile." @@ -3979,7 +4378,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (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 + (zerop (or (file-attribute-user-id (file-attributes file 'integer)) tramp-unknown-id-integer)) (not (with-tramp-connection-property @@ -3997,7 +4396,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (make-symbolic-link info lockname 'ok-if-already-exists) (error (with-file-modes #o0644 - (write-region info nil lockname))))))))) + (write-region info nil lockname nil 'no-message))))))))) (defun tramp-handle-make-lock-file-name (file) "Like `make-lock-file-name' for Tramp files." @@ -4031,7 +4430,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) (unless (or noerror (file-exists-p file)) - (tramp-compat-file-missing v file)) + (tramp-error v 'file-missing file)) (if (not (file-exists-p file)) nil (let ((signal-hook-function (unless noerror signal-hook-function)) @@ -4048,15 +4447,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (and (tramp-sh-file-name-handler-p vec) (not (tramp-get-method-parameter vec 'tramp-copy-program)))) -(defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'." - (let ((saved-tdpa tramp-default-proxies-alist) - (target-alist `(,vec)) - (hops (or (tramp-file-name-hop vec) "")) - (item vec) - choices proxy) - - ;; Ad-hoc proxy definitions. +(defun tramp-add-hops (vec) + "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'." + (when-let ((hops (tramp-file-name-hop vec)) + (item vec)) (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) (let* ((host-port (tramp-file-name-host-port item)) (user-domain (tramp-file-name-user-domain item)) @@ -4073,9 +4467,19 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (add-to-list 'tramp-default-proxies-alist entry) (setq item (tramp-dissect-file-name proxy)))) ;; Save the new value. - (when (and hops tramp-save-ad-hoc-proxies) + (when tramp-save-ad-hoc-proxies (customize-save-variable - 'tramp-default-proxies-alist tramp-default-proxies-alist)) + 'tramp-default-proxies-alist tramp-default-proxies-alist)))) + +(defun tramp-compute-multi-hops (vec) + "Expands VEC according to `tramp-default-proxies-alist'." + (let ((saved-tdpa tramp-default-proxies-alist) + (target-alist `(,vec)) + (item vec) + choices proxy) + + ;; Ad-hoc proxy definitions. + (tramp-add-hops vec) ;; Look for proxy hosts to be passed. (setq choices tramp-default-proxies-alist) @@ -4164,7 +4568,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (and ;; The method supports it. (tramp-get-method-parameter v 'tramp-direct-async) ;; It has been indicated. - (tramp-get-connection-property v "direct-async-process" nil) + (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)) @@ -4215,6 +4619,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) + (orig-command command) (env (mapcar (lambda (elt) (when (tramp-compat-string-search "=" elt) elt)) @@ -4290,23 +4695,28 @@ 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 'remote-command orig-command) + (tramp-set-connection-property p "remote-command" orig-command) (tramp-message v 6 "%s" (string-join (process-command p) " ")) p)))))) (defun tramp-handle-make-symbolic-link - (target linkname &optional ok-if-already-exists) + (_target linkname &optional _ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. This is the fallback implementation for backends which do not support symbolic links." - (if (tramp-tramp-file-p (expand-file-name linkname)) - (tramp-error - (tramp-dissect-file-name (expand-file-name linkname)) 'file-error - "make-symbolic-link not supported") - ;; This is needed prior Emacs 26.1, where TARGET has also be - ;; checked for a file name handler. - (tramp-run-real-handler - #'make-symbolic-link (list target linkname ok-if-already-exists)))) + (tramp-error + (tramp-dissect-file-name (expand-file-name linkname)) 'file-error + "make-symbolic-link not supported")) + +(defun tramp-handle-process-attributes (pid) + "Like `process-attributes' for Tramp files." + (catch 'result + (dolist (elt (tramp-get-process-attributes + (tramp-dissect-file-name default-directory))) + (when (= (cdr (assq 'pid elt)) pid) + (throw 'result elt))))) (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." @@ -4439,7 +4849,7 @@ support symbolic links." (prog1 ;; Run the process. - (process-file-shell-command command nil buffer nil) + (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file (with-current-buffer error-buffer @@ -4521,7 +4931,7 @@ BUFFER might be a list, in this case STDERR is separated." (unless time-list (let ((remote-file-name-inhibit-cache t)) (setq time-list - (or (tramp-compat-file-attribute-modification-time + (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) @@ -4545,7 +4955,7 @@ of." t (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (tramp-compat-file-attribute-modification-time attr)) + (modtime (file-attribute-modification-time attr)) (mt (visited-file-modtime))) (cond @@ -4562,35 +4972,10 @@ 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) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (tmpfile (tramp-compat-make-temp-file filename)) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((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 - (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (tramp-compat-file-attribute-group-id - (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + filename (and (eq mustbenew 'excl) 'nofollow)))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4609,30 +4994,7 @@ of." (error (delete-file tmpfile) (tramp-error - v 'file-error "Couldn't write region to `%s'" filename))) - - (tramp-flush-file-properties v localname) - - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime - (or (tramp-compat-file-attribute-modification-time - (file-attributes filename)) - (current-time)))) - - ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + v 'file-error "Couldn't write region to `%s'" filename)))))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" @@ -4698,8 +5060,8 @@ of." (save-window-excursion (pop-to-buffer (tramp-get-connection-buffer vec)) (read-string (match-string 0))))))) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-message + vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec))) (tramp-message vec 3 "Sending login name `%s'" user) (tramp-send-string vec (concat user tramp-local-end-of-line))) t) @@ -4711,7 +5073,8 @@ of." ;; Let's check whether a wrong password has been sent already. ;; Sometimes, the process returns a new password request ;; immediately after rejecting the previous (wrong) one. - (unless (tramp-get-connection-property vec "first-password-request" nil) + (unless (or tramp-password-prompt-not-unique + (tramp-get-connection-property vec "first-password-request")) (tramp-clear-passwd vec)) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) @@ -4719,7 +5082,13 @@ of." ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. (process-send-string - proc (concat (tramp-read-passwd proc) tramp-local-end-of-line)) + proc + (concat + (funcall + (if tramp-password-prompt-not-unique + #'tramp-read-passwd-without-cache #'tramp-read-passwd) + proc) + tramp-local-end-of-line)) ;; Hide password prompt. (narrow-to-region (point-max) (point-max)))) t) @@ -4742,8 +5111,8 @@ See also `tramp-action-yn'." (unless (yes-or-no-p (match-string 0)) (kill-process proc) (throw 'tramp-action 'permission-denied)) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-message + vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec))) (tramp-send-string vec (concat "yes" tramp-local-end-of-line))) t) @@ -4756,8 +5125,8 @@ See also `tramp-action-yesno'." (unless (y-or-n-p (match-string 0)) (kill-process proc) (throw 'tramp-action 'permission-denied)) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-message + vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec))) (tramp-send-string vec (concat "y" tramp-local-end-of-line))) t) @@ -4765,15 +5134,15 @@ See also `tramp-action-yesno'." "Tell the remote host which terminal type to use. The terminal type can be configured with `tramp-terminal-type'." (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-message + vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec))) (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line)) t) (defun tramp-action-confirm-message (_proc vec) "Return RET in order to confirm the message." - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-message vec 6 "\n%s" (buffer-string))) + (tramp-message + vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec))) (tramp-send-string vec tramp-local-end-of-line) t) @@ -4949,7 +5318,7 @@ performed successfully. Any other value means an error." "Lock PROC for other communication, and run BODY. Mostly useful to protect BODY from being interrupted by timers." (declare (indent 1) (debug t)) - `(if (tramp-get-connection-property ,proc "locked" nil) + `(if (tramp-get-connection-property ,proc "locked") ;; Be kind for older Emacsen. (if (member 'remote-file-error debug-ignored-errors) (throw 'non-essential 'non-essential) @@ -4961,9 +5330,6 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>")) - (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 @@ -5005,7 +5371,7 @@ Erase echoed commands if exists." ;; Check whether we need to remove echo output. The max length of ;; the echo mark regexp is taken for search. We restrict the ;; search for the second echo mark to PIPE_BUF characters. - (when (and (tramp-get-connection-property proc "check-remote-echo" nil) + (when (and (tramp-get-connection-property proc "check-remote-echo") (re-search-forward tramp-echoed-echo-mark-regexp (+ (point) (* 5 tramp-echo-mark-marker-length)) t)) @@ -5021,7 +5387,7 @@ Erase echoed commands if exists." (delete-region begin (point)) (goto-char (point-min))))) - (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil)) + (when (or (not (tramp-get-connection-property proc "check-remote-echo")) ;; Sometimes, the echo string is suppressed on the remote side. (not (string-equal (substring-no-properties @@ -5062,8 +5428,8 @@ nil." ;; The process could have timed out, for example due to session ;; timeout of sudo. The process buffer does not exist any longer then. (ignore-errors - (with-current-buffer (process-buffer proc) - (tramp-message proc 6 "\n%s" (buffer-string)))) + (tramp-message + proc 6 "\n%s" (tramp-get-buffer-string (process-buffer proc)))) (unless found (if timeout (tramp-error @@ -5083,7 +5449,7 @@ The STRING is expected to use Unix line-endings, but the lines sent to the remote host use line-endings as defined in the variable `tramp-rsh-end-of-line'. The communication buffer is erased before sending." (let* ((p (tramp-get-connection-process vec)) - (chunksize (tramp-get-connection-property p "chunksize" nil))) + (chunksize (tramp-get-connection-property p "chunksize"))) (unless p (tramp-error vec 'file-error "Can't send string to remote host -- not logged in")) @@ -5121,7 +5487,7 @@ the remote host use line-endings as defined in the variable (unless (process-live-p proc) (let ((vec (process-get proc 'vector)) (buf (process-buffer proc)) - (prompt (tramp-get-connection-property proc "prompt" nil))) + (prompt (tramp-get-connection-property proc "prompt"))) (when vec (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) (tramp-flush-connection-properties proc) @@ -5285,10 +5651,12 @@ If FILENAME is remote, a file name handler is called." (let* ((dir (file-name-directory filename)) (modes (file-modes dir))) (when (and modes (not (zerop (logand modes #o2000)))) - (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir))))) + (setq gid (file-attribute-group-id (file-attributes dir))))) - (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid))) - (funcall handler #'tramp-set-file-uid-gid filename uid gid) + (if (tramp-tramp-file-p filename) + (funcall (if (tramp-crypt-file-name-p filename) + #'tramp-crypt-file-name-handler #'tramp-file-name-handler) + #'tramp-set-file-uid-gid filename uid gid) ;; On W32 systems, "chown" does not work. (unless (memq system-type '(ms-dos windows-nt)) (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) @@ -5314,8 +5682,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; `group-name' has been introduced with Emacs 27.1. ((and (fboundp 'group-name) (equal id-format 'string)) (tramp-compat-funcall 'group-name (group-gid))) - ((tramp-compat-file-attribute-group-id - (file-attributes "~/" id-format)))))) + ((file-attribute-group-id (file-attributes "~/" id-format)))))) (defun tramp-get-local-locale (&optional vec) "Determine locale, supporting UTF8 if possible. @@ -5344,7 +5711,7 @@ VEC is used for tracing." "Check `file-attributes' caches for VEC. Return t if according to the cache access type ACCESS is known to be granted." - (let ((result nil) + (let (result (offset (cond ((eq ?r access) 1) ((eq ?w access) 2) @@ -5371,59 +5738,53 @@ be granted." file-attr (or ;; Not a symlink. - (eq t (tramp-compat-file-attribute-type file-attr)) - (null (tramp-compat-file-attribute-type file-attr))) + (eq t (file-attribute-type file-attr)) + (null (file-attribute-type file-attr))) (or ;; World accessible. - (eq access - (aref (tramp-compat-file-attribute-modes file-attr) - (+ offset 6))) + (eq access (aref (file-attribute-modes file-attr) (+ offset 6))) ;; User accessible and owned by user. (and - (eq access - (aref (tramp-compat-file-attribute-modes file-attr) offset)) + (eq access (aref (file-attribute-modes file-attr) offset)) (or (equal remote-uid unknown-id) - (equal remote-uid - (tramp-compat-file-attribute-user-id file-attr)) - (equal unknown-id - (tramp-compat-file-attribute-user-id file-attr)))) + (equal remote-uid (file-attribute-user-id file-attr)) + (equal unknown-id (file-attribute-user-id file-attr)))) ;; Group accessible and owned by user's principal group. (and (eq access - (aref (tramp-compat-file-attribute-modes file-attr) - (+ offset 3))) + (aref (file-attribute-modes file-attr) (+ offset 3))) (or (equal remote-gid unknown-id) - (equal remote-gid - (tramp-compat-file-attribute-group-id file-attr)) - (equal unknown-id - (tramp-compat-file-attribute-group-id - file-attr)))))))))))) + (equal remote-gid (file-attribute-group-id file-attr)) + (equal unknown-id (file-attribute-group-id file-attr)))))))))))) + +(defun tramp-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (and (tramp-file-name-p vec) + (with-tramp-connection-property vec (concat "~" user) + (tramp-file-name-handler #'tramp-get-home-directory vec user)))) (defun tramp-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." - (with-tramp-connection-property vec (format "uid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid))) - (funcall handler #'tramp-get-remote-uid vec id-format)) - ;; Ensure there is a valid result. - (and (equal id-format 'integer) tramp-unknown-id-integer) - (and (equal id-format 'string) tramp-unknown-id-string)))) + (or (and (tramp-file-name-p vec) + (with-tramp-connection-property vec (format "uid-%s" id-format) + (tramp-file-name-handler #'tramp-get-remote-uid vec id-format))) + ;; Ensure there is a valid result. + (and (equal id-format 'integer) tramp-unknown-id-integer) + (and (equal id-format 'string) tramp-unknown-id-string))) (defun tramp-get-remote-gid (vec id-format) "The gid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." - (with-tramp-connection-property vec (format "gid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (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) - (and (equal id-format 'string) tramp-unknown-id-string)))) + (or (and (tramp-file-name-p vec) + (with-tramp-connection-property vec (format "gid-%s" id-format) + (tramp-file-name-handler #'tramp-get-remote-gid vec id-format))) + ;; Ensure there is a valid result. + (and (equal id-format 'integer) tramp-unknown-id-integer) + (and (equal id-format 'string) tramp-unknown-id-string))) (defun tramp-local-host-p (vec) "Return t if this points to the local host, nil otherwise. @@ -5443,8 +5804,7 @@ This handles also chrooted environments, which are not regarded as local." (null tramp-crypt-enabled) ;; The local temp directory must be writable for the other user. (file-writable-p - (tramp-make-tramp-file-name - vec tramp-compat-temporary-file-directory 'nohop)) + (tramp-make-tramp-file-name vec tramp-compat-temporary-file-directory)) ;; On some systems, chown runs only for root. (or (zerop (user-uid)) (zerop (tramp-get-remote-uid vec 'integer)))))) @@ -5538,7 +5898,7 @@ this file, if that variable is non-nil." (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 + (zerop (or (file-attribute-user-id (file-attributes filename 'integer)) tramp-unknown-id-integer)) (not (with-tramp-connection-property @@ -5574,8 +5934,7 @@ ALIST is of the form ((FROM . TO) ...)." (defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix) "Like `make-nearby-temp-file' for Tramp files." - (let ((temporary-file-directory - (tramp-compat-temporary-file-directory-function))) + (let ((temporary-file-directory (temporary-file-directory))) (make-temp-file prefix dir-flag suffix))) ;;; Compatibility functions section: @@ -5598,14 +5957,12 @@ are written with verbosity of 6." (with-temp-buffer (setq result (apply - #'call-process program infile (or destination t) display args)) + #'call-process program infile (or destination t) display args) + output (tramp-get-buffer-string destination)) ;; `result' could also be an error string. (when (stringp result) (setq error result - result 1)) - (with-current-buffer - (if (bufferp destination) destination (current-buffer)) - (setq output (buffer-string)))) + result 1))) (error (setq error (error-message-string err) result 1))) @@ -5636,10 +5993,10 @@ are written with verbosity of 6." ;; `result' could also be an error string. (when (stringp result) (signal 'file-error (list result))) - (with-current-buffer (if (bufferp buffer) buffer (current-buffer)) - (if (zerop result) - (tramp-message vec 6 "%d" result) - (tramp-message vec 6 "%d\n%s" result (buffer-string))))) + (if (zerop result) + (tramp-message vec 6 "%d" result) + (tramp-message + vec 6 "%d\n%s" result (tramp-get-buffer-string buffer)))) (error (setq result 1) (tramp-message vec 6 "%d\n%s" result (error-message-string err)))) @@ -5684,20 +6041,22 @@ verbosity of 6." ;; tramp-cache-read-persistent-data t)'" instead. (defun tramp-read-passwd (proc &optional prompt) "Read a password from user (compat function). -Consults the auth-source package. -Invokes `password-read' if available, `read-passwd' else." +Consults the auth-source package." (let* (;; If `auth-sources' contains "~/.authinfo.gpg", and ;; `exec-path' contains a relative file name like ".", it ;; could happen that the "gpg" command is not found. So we ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - (key (tramp-make-tramp-file-name - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. - (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) - 'noloc 'nohop)) + ;; 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))) + (key (tramp-make-tramp-file-name vec 'noloc)) + (method (tramp-file-name-method vec)) + (user (or (tramp-file-name-user-domain vec) + (tramp-get-connection-property key "login-as"))) + (host (tramp-file-name-host-port vec)) (pw-prompt (or prompt (with-current-buffer (process-buffer proc) @@ -5707,68 +6066,66 @@ Invokes `password-read' if available, `read-passwd' else." (format "%s for %s " (capitalize (match-string 1)) key))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. - (auth-sources (with-current-buffer (process-buffer proc) auth-sources)) + (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) ;; We suspend the timers while reading the password. (stimers (with-timeout-suspend)) auth-info auth-passwd) (unwind-protect - (with-parsed-tramp-file-name key nil - (setq tramp-password-save-function nil - user - (or user (tramp-get-connection-property key "login-as" nil))) - (prog1 - (or - ;; See if auth-sources contains something useful. - (ignore-errors - (and (tramp-get-connection-property - v "first-password-request" nil) - ;; Try with Tramp's current method. - (setq auth-info - (car - (auth-source-search - :max 1 - (and user :user) - (if domain - (concat - user tramp-prefix-domain-format domain) - user) - :host - (if port - (concat - host tramp-prefix-port-format port) - host) - :port method - :require (cons :secret (and user '(:user))) - :create t)) - tramp-password-save-function - (plist-get auth-info :save-function) - auth-passwd (plist-get auth-info :secret))) - (while (functionp auth-passwd) - (setq auth-passwd (funcall auth-passwd))) - auth-passwd) - - ;; Try the password cache. Exists since Emacs 26.1. - (progn - (setq auth-passwd (password-read pw-prompt key) - tramp-password-save-function - (lambda () (password-cache-add key auth-passwd))) - auth-passwd) - - ;; Else, get the password interactively w/o cache. - (read-passwd pw-prompt)) + ;; We cannot use `with-parsed-tramp-file-name', because it + ;; expands the file name. + (or + (setq tramp-password-save-function nil) + ;; See if auth-sources contains something useful. + (ignore-errors + (and (tramp-get-connection-property vec "first-password-request") + ;; Try with Tramp's current method. If there is no + ;; user name, `:create' triggers to ask for. We + ;; suppress it. + (setq auth-info + (car + (auth-source-search + :max 1 :user user :host host :port method + :require (cons :secret (and user '(:user))) + :create (and user t))) + tramp-password-save-function + (plist-get auth-info :save-function) + auth-passwd + (tramp-compat-auth-info-password auth-info)))) + + ;; Try the password cache. + (progn + (setq auth-passwd (password-read pw-prompt key) + tramp-password-save-function + (lambda () (password-cache-add key auth-passwd))) + auth-passwd)) - ;; Workaround. Prior Emacs 28.1, auth-source has saved - ;; empty passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) - (setq tramp-password-save-function nil)) - (tramp-set-connection-property v "first-password-request" nil))) + ;; Workaround. Prior Emacs 28.1, auth-source has saved empty + ;; passwords. See discussion in Bug#50399. + (when (zerop (length auth-passwd)) + (setq tramp-password-save-function nil)) + (tramp-set-connection-property vec "first-password-request" nil) ;; Reenable the timers. (with-timeout-unsuspend stimers)))) (put #'tramp-read-passwd 'tramp-suppress-trace t) +(defun tramp-read-passwd-without-cache (proc &optional prompt) + "Read a password from user (compat function)." + ;; We suspend the timers while reading the password. + (let ((stimers (with-timeout-suspend))) + (unwind-protect + (password-read + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (match-string 0)))) + ;; Reenable the timers. + (with-timeout-unsuspend stimers)))) + +(put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t) + (defun tramp-clear-passwd (vec) "Clear password cache for connection related to VEC." (let ((method (tramp-file-name-method vec)) @@ -5781,7 +6138,7 @@ Invokes `password-read' if available, `read-passwd' else." (auth-source-forget `(:max 1 ,(and user-domain :user) ,user-domain :host ,host-port :port ,method)) - (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop)))) + (password-cache-remove (tramp-make-tramp-file-name vec 'noloc)))) (put #'tramp-clear-passwd 'tramp-suppress-trace t) @@ -5868,40 +6225,60 @@ name of a process or buffer, or nil to default to the current buffer." (while (tramp-accept-process-output proc 0)) (not (process-live-p proc)))))) -;; `interrupt-process-functions' exists since Emacs 26.1. -(when (boundp 'interrupt-process-functions) - (add-hook 'interrupt-process-functions #'tramp-interrupt-process) +(add-hook 'interrupt-process-functions #'tramp-interrupt-process) +(add-hook + 'tramp-unload-hook + (lambda () + (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))) + +(defun tramp-signal-process (process sigcode &optional remote) + "Send PROCESS the signal with code SIGCODE. +PROCESS may also be a number specifying the process id of the +process to signal; in this case, the process need not be a child of +this Emacs. +If PROCESS is a process object which contains the property +`remote-pid', or PROCESS is a number and REMOTE is a remote file name, +PROCESS is interpreted as process on the respective remote host, which +will be the process to signal. +SIGCODE may be an integer, or a symbol whose name is a signal name." + (let (pid vec) + (cond + ((processp process) + (setq pid (process-get process 'remote-pid) + vec (process-get process 'vector))) + ((numberp process) + (setq pid process + vec (and (stringp remote) (tramp-dissect-file-name remote)))) + (t (signal 'wrong-type-argument (list #'processp process)))) + (unless (or (numberp sigcode) (symbolp sigcode)) + (signal 'wrong-type-argument (list #'numberp sigcode))) + ;; If it's a Tramp process, send SIGCODE remotely. + (when (and pid vec) + (tramp-message + vec 5 "Send signal %s to process %s with pid %s" sigcode process pid) + ;; This is for tramp-sh.el. Other backends do not support this (yet). + (if (tramp-compat-funcall + 'tramp-send-command-and-check + vec (format "\\kill -%s %d" sigcode pid)) + 0 -1)))) + +;; `signal-process-functions' exists since Emacs 29.1. +(when (boundp 'signal-process-functions) + (add-hook 'signal-process-functions #'tramp-signal-process) (add-hook 'tramp-unload-hook (lambda () - (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) + (remove-hook 'signal-process-functions #'tramp-signal-process)))) (defun tramp-get-remote-null-device (vec) "Return null device on the remote host identified by VEC. -If VEC is nil, return local null device." - (if (null vec) +If VEC is `tramp-null-hop', return local null device." + (if (equal vec tramp-null-hop) null-device (with-tramp-connection-property vec "null-device" (let ((default-directory (tramp-make-tramp-file-name vec))) (tramp-compat-null-device))))) -(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) - "Skeleton for `tramp-*-handle-delete-directory'. -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))) - -(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' @@ -5940,5 +6317,11 @@ BODY is the backend specific code." ;; and friends, for most of the handlers this is the major ;; difference between the different backends. Other handlers but ;; *-process-file would profit from this as well. +;; +;; * Implement file name abbreviation for a different user. That is, +;; (abbreviate-file-name "/ssh:user1@host:/home/user2") => +;; "/ssh:user1@host:~user2". +;; +;; * Implement file name abbreviation for user and host names. ;;; tramp.el ends here |