"Like `exec-path' for Tramp files."
(append
(with-parsed-tramp-file-name default-directory nil
- (with-tramp-connection-property v "remote-path"
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
(tramp-adb-send-command v "echo \\\"$PATH\\\"")
(split-string
(with-current-buffer (tramp-get-connection-buffer v)
"Return full host name from VEC to be used in shell execution.
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
a host name \"R38273882DE\" returns \"R38273882DE\"."
- ;; Sometimes this is called before there is a connection process
- ;; yet. In order to work with the connection cache, we flush all
- ;; unwanted entries first.
- (tramp-flush-connection-properties nil)
- (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (with-tramp-connection-property (tramp-get-process vec) "device"
(let* ((host (tramp-file-name-host vec))
(port (tramp-file-name-port-or-default vec))
(devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
;; a process, has a unique cache. We distinguish 4 kind of caches,
;; depending on the key:
;;
-;; - localname is NIL. This are reusable properties. Examples:
+;; - localname is nil. These are reusable properties. Examples:
;; "remote-shell" identifies the POSIX shell to be called on the
;; remote host, or "perl" is the command to be called on the remote
;; host when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
-;; - localname is a string. This are temporary properties, which are
+;; - localname is a string. These are temporary properties, which are
;; related to the file localname is referring to. Examples:
;; "file-exists-p" is t or nil, depending on the file existence, or
;; "file-attributes" caches the result of the function
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
;;
-;; - The key is a process. This are temporary properties related to
+;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
;;
-;; - The key is nil. This are temporary properties related to the
+;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
;; the results of parsing "/etc/passwd" and "/etc/group",
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
;; "locale" is the used shell locale.
+;;
+;; - The key is `tramp-cache-undefined'. All functions return the
+;; expected values, but nothing is cached.
;; Some properties are handled special:
;;
;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name'.
+;; not saved in the file `tramp-persistency-file-name', although
+;; being connection properties related to a `tramp-file-name'
+;; structure.
+;;
+;; - Reusable properties, which should not be saved, are kept in the
+;; process key retrieved by `tramp-get-process' (the main connection
+;; process). Other processes could reuse these properties, avoiding
+;; recomputation when a new asynchronous process is created by
+;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
;;; Code:
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+;;;###tramp-autoload
+(defconst tramp-cache-undefined 'undef
+ "The symbol marking undefined hash keys and values.")
+
(defun tramp-get-hash-table (key)
"Return the hash table for KEY.
If it doesn't exist yet, it is created and initialized with
-matching entries of `tramp-connection-properties'."
- (or (gethash key tramp-cache-data)
- (let ((hash
- (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
- (when (tramp-file-name-p key)
- (dolist (elt tramp-connection-properties)
- (when (string-match-p
- (or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
- (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
- hash)))
+matching entries of `tramp-connection-properties'.
+If KEY is `tramp-cache-undefined', don't create anything, and return nil."
+ (unless (eq key tramp-cache-undefined)
+ (or (gethash key tramp-cache-data)
+ (let ((hash
+ (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
+ (when (tramp-file-name-p key)
+ (dolist (elt tramp-connection-properties)
+ (when (string-match-p
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+ hash))))
;;;###tramp-autoload
(defun tramp-get-file-property (key file property default)
"Get the PROPERTY of FILE from the cache context of KEY.
-Returns DEFAULT if not set."
+Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
-Returns VALUE."
+Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine. If the
-value is not set for the connection, returns DEFAULT."
+used to cache connection properties of the local machine.
+If KEY is `tramp-cache-undefined', or if the value is not set for
+the connection, return DEFAULT."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine.
-PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+used to cache connection properties of the local machine. If KEY
+is `tramp-cache-undefined', nothing is set.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
+Return VALUE."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (let ((hash (tramp-get-hash-table key)))
- (puthash property value hash)
- (setq tramp-cache-data-changed t)
- (tramp-message key 7 "%s %s" property value)
- value))
+ (when-let ((hash (tramp-get-hash-table key)))
+ (puthash property value hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-tramp-file-p key)))
+ (tramp-message key 7 "%s %s" property value)
+ value)
;;;###tramp-autoload
(defun tramp-connection-property-p (key property)
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine."
- (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
+ (not (eq (tramp-get-connection-property key property tramp-cache-undefined)
+ tramp-cache-undefined)))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key property)
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (remhash property (tramp-get-hash-table key))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (tramp-get-hash-table key)))
+ (remhash property hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-tramp-file-p key)))
(tramp-message key 7 "%s" property))
;;;###tramp-autoload
(tramp-file-name-hop key) nil))
(tramp-message
key 7 "%s %s" key
- (let ((hash (gethash key tramp-cache-data)))
- (when (hash-table-p hash) (hash-table-keys hash))))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (gethash key tramp-cache-data)))
+ (hash-table-keys hash)))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-tramp-file-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
(hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
- "Write persistent connection properties into file `tramp-persistency-file-name'."
+ "Write persistent connection properties into file \
+`tramp-persistency-file-name'."
;; We shouldn't fail, otherwise Emacs might not be able to be closed.
(ignore-errors
(when (and (hash-table-p tramp-cache-data)
;; suppressed.
(setq tramp-current-connection nil)
- ;; Flush file cache.
- (tramp-flush-directory-properties vec "")
-
- ;; Flush connection cache.
- (when (processp (tramp-get-connection-process vec))
- (tramp-flush-connection-properties (tramp-get-connection-process vec))
- (delete-process (tramp-get-connection-process vec)))
- (tramp-flush-connection-properties vec)
-
;; Cancel timer.
(dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer)))
+ ;; Delete processes.
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (processp key)
+ (tramp-file-name-equal-p (process-get key 'vector) vec))
+ (tramp-flush-connection-properties key)
+ (delete-process key)))
+
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))
+ ;; Flush file cache.
+ (tramp-flush-directory-properties vec "")
+
+ ;; Flush connection cache.
+ (tramp-flush-connection-properties vec)
+
;; The end.
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
(list
t ;; handled.
nil ;; no abort of D-Bus.
- (with-tramp-connection-property
- (tramp-get-connection-process v) message
+ (with-tramp-connection-property (tramp-get-process v) message
;; In theory, there can be several choices.
;; Until now, there is only the question whether
;; to accept an unknown host signature or certificate.
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
(while (tramp-gvfs-connection-mounted-p vec)
(read-event nil nil 0.1))
- (tramp-flush-connection-properties vec)
- (tramp-flush-connection-properties (tramp-get-connection-process vec)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
(defun tramp-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(tramp-send-command-and-check vec "selinuxenabled")))
(defun tramp-sh-handle-file-selinux-context (filename)
(defun tramp-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(tramp-send-command-and-check vec "getfacl /")))
(defun tramp-sh-handle-file-acl (filename)
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
;; process calls.
- (when (and (memq 'Bzr vc-handled-backends)
- (boundp 'vc-bzr-program)
- (not (with-tramp-connection-property v vc-bzr-program
- (tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v)))))
+ (when (and
+ (memq 'Bzr vc-handled-backends)
+ (not (and
+ (bound-and-true-p vc-bzr-program)
+ (with-tramp-connection-property v vc-bzr-program
+ (tramp-find-executable
+ v vc-bzr-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
- (when (and (memq 'Git vc-handled-backends)
- (boundp 'vc-git-program)
- (not (with-tramp-connection-property v vc-git-program
- (tramp-find-executable
- v vc-git-program (tramp-get-remote-path v)))))
+ (when (and
+ (memq 'Git vc-handled-backends)
+ (not (and
+ (bound-and-true-p vc-git-program)
+ (with-tramp-connection-property v vc-git-program
+ (tramp-find-executable
+ v vc-git-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
- (when (and (memq 'Hg vc-handled-backends)
- (boundp 'vc-hg-program)
- (not (with-tramp-connection-property v vc-hg-program
- (tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v)))))
+ (when (and
+ (memq 'Hg vc-handled-backends)
+ (not (and
+ (bound-and-true-p vc-hg-program)
+ (with-tramp-connection-property v vc-hg-program
+ (tramp-find-executable
+ v vc-hg-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
;; connection properties. We start again with
;; `tramp-maybe-open-connection', it will be caught there.
(tramp-message vec 5 "Checking system information")
- (let ((old-uname (tramp-get-connection-property vec "uname" nil))
- (uname
- (tramp-set-connection-property
- vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (uname
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-uname
+ (tramp-get-connection-property vec "process-name" nil))
+ old-uname
+ (tramp-set-connection-property
+ vec "uname"
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
(when (and (stringp old-uname) (not (string-equal old-uname uname)))
(tramp-message
vec 3
;; we cannot use `tramp-get-connection-process'.
(tmpfile
(with-tramp-connection-property
- (get-process (tramp-buffer-name vec)) "temp-file"
+ (tramp-get-process vec) "temp-file"
(make-temp-name
(expand-file-name
tramp-temp-name-prefix
;; cache the result for the session only. Otherwise, the
;; result is cached persistently.
(if (memq 'tramp-own-remote-path tramp-remote-path)
- (tramp-get-connection-process vec)
+ (tramp-get-process vec)
vec)
"remote-path"
(let* ((remote-path (copy-tree tramp-remote-path))
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-tramp-connection-property (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-tramp-connection-property
- (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil)))
(prop1 (if (string-match-p "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
(if (and (process-live-p (tramp-get-connection-process vec))
(tramp-get-connection-property vec "posix" t))
(with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
+ (tramp-get-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
(with-current-buffer (tramp-get-connection-buffer vec)
;; When we are not logged in yet, we return nil.
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "stat-capability"
+ (with-tramp-connection-property (tramp-get-process vec) "stat-capability"
(tramp-smb-send-command vec "stat \"/\""))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
(defun tramp-sudoedit-handle-file-acl (filename)
(defun tramp-sudoedit-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(zerop (tramp-call-process vec "selinuxenabled"))))
(defun tramp-sudoedit-handle-file-selinux-context (filename)
;; For more detailed instructions, please see the info file.
;;
;; Notes:
-;; -----
+;; ------
;;
;; Also see the todo list at the bottom of this file.
;;
;;
;; There's a mailing list for this, as well. Its name is:
;; tramp-devel@gnu.org
+
;; You can use the Web to subscribe, under the following URL:
;; https://lists.gnu.org/mailman/listinfo/tramp-devel
;;
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec)))
+(defun tramp-get-process (vec-or-proc)
+ "Get the default connection process to be used for VEC-OR-PROC.
+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-cache-undefined))
+
(defun tramp-get-connection-process (vec)
"Get the connection process to be used for VEC.
In case a second asynchronous communication has been started, it is different
projects / emacs.git / commitdiff