diff options
Diffstat (limited to 'lisp/net/tramp-cache.el')
-rw-r--r-- | lisp/net/tramp-cache.el | 136 |
1 files changed, 76 insertions, 60 deletions
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 64268cfc25a..a9a1c6615ea 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -27,9 +27,9 @@ ;; An implementation of information caching for remote files. -;; Each connection, identified by a vector [method user host -;; localname] or by a process, has a unique cache. We distinguish 3 -;; kind of caches, depending on the key: +;; Each connection, identified by a `tramp-file-name' structure or by +;; a process, has a unique cache. We distinguish 3 kind of caches, +;; depending on the key: ;; ;; - localname is NIL. This are reusable properties. Examples: ;; "remote-shell" identifies the POSIX shell to be called on the @@ -94,12 +94,14 @@ 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 (vectorp key) + (when (tramp-file-name-p key) (dolist (elt tramp-connection-properties) (when (string-match (or (nth 0 elt) "") (tramp-make-tramp-file-name - (aref key 0) (aref key 1) (aref key 2) nil)) + (tramp-file-name-method key) (tramp-file-name-user key) + (tramp-file-name-domain key) (tramp-file-name-host key) + (tramp-file-name-port key) nil)) (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) hash))) @@ -107,11 +109,12 @@ matching entries of `tramp-connection-properties'." (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." - ;; Unify localname. Remove hop from vector. - (setq file (tramp-compat-file-name-unquote file)) - (setq key (copy-sequence key)) - (aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) - (aset key 4 nil) + ;; Unify localname. Remove hop from `tramp-file-name' structure. + (setq file (tramp-compat-file-name-unquote file) + key (copy-tramp-file-name key)) + (setf (tramp-file-name-localname key) + (tramp-run-real-handler 'directory-file-name (list file)) + (tramp-file-name-hop key) nil) (let* ((hash (tramp-get-hash-table key)) (value (when (hash-table-p hash) (gethash property hash)))) (if @@ -141,11 +144,12 @@ Returns DEFAULT if not set." (defun tramp-set-file-property (key file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. Returns VALUE." - ;; Unify localname. Remove hop from vector. - (setq file (tramp-compat-file-name-unquote file)) - (setq key (copy-sequence key)) - (aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) - (aset key 4 nil) + ;; Unify localname. Remove hop from `tramp-file-name' structure. + (setq file (tramp-compat-file-name-unquote file) + key (copy-tramp-file-name key)) + (setf (tramp-file-name-localname key) + (tramp-run-real-handler 'directory-file-name (list file)) + (tramp-file-name-hop key) nil) (let ((hash (tramp-get-hash-table key))) ;; We put the timestamp there. (puthash property (cons (current-time) value) hash) @@ -162,11 +166,11 @@ Returns VALUE." (let* ((file (tramp-run-real-handler 'directory-file-name (list file))) (truename (tramp-get-file-property key file "file-truename" nil))) - ;; Unify localname. Remove hop from vector. - (setq file (tramp-compat-file-name-unquote file)) - (setq key (copy-sequence key)) - (aset key 3 file) - (aset key 4 nil) + ;; Unify localname. Remove hop from `tramp-file-name' structure. + (setq file (tramp-compat-file-name-unquote file) + key (copy-tramp-file-name key)) + (setf (tramp-file-name-localname key) file + (tramp-file-name-hop key) nil) (tramp-message key 8 "%s" file) (remhash key tramp-cache-data) ;; Remove file properties of symlinks. @@ -185,7 +189,8 @@ Remove also properties of all files in subdirectories." (tramp-message key 8 "%s" directory) (maphash (lambda (key _value) - (when (and (stringp (tramp-file-name-localname key)) + (when (and (tramp-file-name-p key) + (stringp (tramp-file-name-localname key)) (string-match (regexp-quote directory) (tramp-file-name-localname key))) (remhash key tramp-cache-data))) @@ -232,15 +237,15 @@ This is suppressed for temporary buffers." (defun tramp-get-connection-property (key property default) "Get the named PROPERTY for the connection. KEY identifies the connection, it is either a process or a -vector. 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." - ;; Unify key by removing localname and hop from vector. Work with a - ;; copy in order to avoid side effects. - (when (vectorp key) - (setq key (copy-sequence key)) - (aset key 3 nil) - (aset key 4 nil)) +`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." + ;; 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)) (value ;; If the key is an auxiliary process object, check whether @@ -257,15 +262,15 @@ connection, returns DEFAULT." (defun tramp-set-connection-property (key property value) "Set the named PROPERTY of a connection to VALUE. KEY identifies the connection, it is either a process or a -vector. A special case is nil, which is used to cache connection -properties of the local machine. PROPERTY is set persistent when -KEY is a vector." - ;; Unify key by removing localname and hop from vector. Work with a - ;; copy in order to avoid side effects. - (when (vectorp key) - (setq key (copy-sequence key)) - (aset key 3 nil) - (aset key 4 nil)) +`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." + ;; 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) @@ -276,22 +281,22 @@ KEY is a vector." (defun tramp-connection-property-p (key property) "Check whether named PROPERTY of a connection is defined. KEY identifies the connection, it is either a process or a -vector. A special case is nil, which is used to cache connection -properties of the local machine." +`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))) ;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. KEY identifies the connection, it is either a process or a -vector. A special case is nil, which is used to cache connection -properties of the local machine." - ;; Unify key by removing localname and hop from vector. Work with a - ;; copy in order to avoid side effects. - (when (vectorp key) - (setq key (copy-sequence key)) - (aset key 3 nil) - (aset key 4 nil)) +`tramp-file-name' structure. A special case is nil, which is +used to cache connection properties of the local machine." + ;; 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)) (tramp-message key 7 "%s %s" key (let ((hash (gethash key tramp-cache-data)) @@ -310,7 +315,16 @@ properties of the local machine." (maphash (lambda (key value) ;; Remove text properties from KEY and VALUE. - (when (vectorp key) + ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we + ;; ignore errors. + (when (tramp-file-name-p key) + ;; (dolist + ;; (slot + ;; (mapcar 'car (cdr (cl-struct-slot-info 'tramp-file-name)))) + ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key)) + ;; (setf (cl-struct-slot-value 'tramp-file-name slot key) + ;; (substring-no-properties + ;; (cl-struct-slot-value 'tramp-file-name slot key)))))) (dotimes (i (length key)) (when (stringp (aref key i)) (aset key i (substring-no-properties (aref key i)))))) @@ -335,11 +349,12 @@ properties of the local machine." ;;;###tramp-autoload (defun tramp-list-connections () - "Return a list of all known connection vectors according to `tramp-cache'." + "Return all known `tramp-file-name' structs according to `tramp-cache'." (let (result tramp-verbose) (maphash (lambda (key _value) - (when (and (vectorp key) (null (aref key 3)) + (when (and (tramp-file-name-p key) + (null (tramp-file-name-localname key)) (tramp-connection-property-p key "process-buffer")) (add-to-list 'result key))) tramp-cache-data) @@ -361,7 +376,7 @@ properties of the local machine." ;; possibility to use another login name later on. (maphash (lambda (key value) - (if (and (vectorp key) + (if (and (tramp-file-name-p key) (not (tramp-file-name-localname key)) (not (gethash "login-as" value))) (progn @@ -402,7 +417,7 @@ for all methods. Resulting data are derived from connection history." (let (res) (maphash (lambda (key _value) - (if (and (vectorp key) + (if (and (tramp-file-name-p key) (string-equal method (tramp-file-name-method key)) (not (tramp-file-name-localname key))) (push (list (tramp-file-name-user key) @@ -427,12 +442,13 @@ for all methods. Resulting data are derived from connection history." element key item) (while (setq element (pop list)) (setq key (pop element)) - (while (setq item (pop element)) - ;; We set only values which are not contained in - ;; `tramp-connection-properties'. The cache is - ;; initialized properly by side effect. - (unless (tramp-connection-property-p key (car item)) - (tramp-set-connection-property key (pop item) (car item)))))) + (when (tramp-file-name-p key) + (while (setq item (pop element)) + ;; We set only values which are not contained in + ;; `tramp-connection-properties'. The cache is + ;; initialized properly by side effect. + (unless (tramp-connection-property-p key (car item)) + (tramp-set-connection-property key (pop item) (car item))))))) (setq tramp-cache-data-changed nil)) (file-error ;; Most likely because the file doesn't exist yet. No message. |