diff options
Diffstat (limited to 'lisp/net/tramp-cache.el')
| -rw-r--r-- | lisp/net/tramp-cache.el | 252 |
1 files changed, 131 insertions, 121 deletions
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 0f2d7a1800f..970e2eea0ac 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -31,13 +31,13 @@ ;; 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 @@ -45,21 +45,32 @@ ;; 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: @@ -96,25 +107,31 @@ details see the info pages." (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)) @@ -122,31 +139,32 @@ Returns DEFAULT if not set." (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 ;; We take the value only if there is any, and - ;; `remote-file-name-inhibit-cache' indicates that it is still - ;; valid. Otherwise, DEFAULT is set. - (and (consp value) + (cached (and (hash-table-p hash) (gethash property hash))) + (cached-at (and (consp cached) (format-time-string "%T" (car cached)))) + (value default) + cache-used) + + (when ;; We take the value only if there is any, and + ;; `remote-file-name-inhibit-cache' indicates that it is + ;; still valid. Otherwise, DEFAULT is set. + (and (consp cached) (or (null remote-file-name-inhibit-cache) (and (integerp remote-file-name-inhibit-cache) (time-less-p - ;; `current-time' can be nil once we get rid of Emacs 24. - (current-time) - (time-add - (car value) - ;; `seconds-to-time' can be removed once we get - ;; rid of Emacs 24. - (seconds-to-time remote-file-name-inhibit-cache)))) + nil + (time-add (car cached) remote-file-name-inhibit-cache))) (and (consp remote-file-name-inhibit-cache) (time-less-p - remote-file-name-inhibit-cache (car value))))) - (setq value (cdr value)) - (setq value default)) + remote-file-name-inhibit-cache (car cached))))) + (setq value (cdr cached) + cache-used t)) - (tramp-message key 8 "%s %s %s" file property value) + (tramp-message + key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" + file property value remote-file-name-inhibit-cache cache-used cached-at) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (bound-and-true-p var) + (val (or (numberp (bound-and-true-p var)) (progn (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) @@ -157,7 +175,7 @@ Returns DEFAULT if not set." ;;;###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)) @@ -170,7 +188,7 @@ Returns VALUE." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (bound-and-true-p var) + (val (or (numberp (bound-and-true-p var)) (progn (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) @@ -202,13 +220,11 @@ Returns VALUE." key (copy-tramp-file-name key)) (setf (tramp-file-name-localname key) file (tramp-file-name-hop key) nil) - (maphash - (lambda (property _value) - (when (string-match-p - "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" - property) - (tramp-flush-file-property key file property))) - (tramp-get-hash-table key))))) + (dolist (property (hash-table-keys (tramp-get-hash-table key))) + (when (string-match-p + "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" + property) + (tramp-flush-file-property key file property)))))) ;;;###tramp-autoload (defun tramp-flush-file-properties (key file) @@ -239,14 +255,12 @@ Remove also properties of all files in subdirectories." #'directory-file-name (list directory))) (truename (tramp-get-file-property key directory "file-truename" nil))) (tramp-message key 8 "%s" directory) - (maphash - (lambda (key _value) - (when (and (tramp-file-name-p key) - (stringp (tramp-file-name-localname key)) - (string-match-p (regexp-quote directory) - (tramp-file-name-localname key))) - (remhash key tramp-cache-data))) - tramp-cache-data) + (dolist (key (hash-table-keys tramp-cache-data)) + (when (and (tramp-file-name-p key) + (stringp (tramp-file-name-localname key)) + (string-match-p (regexp-quote directory) + (tramp-file-name-localname key))) + (remhash key tramp-cache-data))) ;; Remove file properties of symlinks. (when (and (stringp truename) (not (string-equal directory (directory-file-name truename)))) @@ -292,8 +306,9 @@ This is suppressed for temporary buffers." "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) @@ -301,15 +316,19 @@ value is not set for the connection, returns DEFAULT." (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 - ;; the process is still alive. - (if (and (processp key) (not (process-live-p key))) - default - (if (hash-table-p hash) - (gethash property hash default) - default)))) - (tramp-message key 7 "%s %s" property value) + (cached (if (hash-table-p hash) + (gethash property hash tramp-cache-undefined) + tramp-cache-undefined)) + (value default) + cache-used) + + (when (and (not (eq cached tramp-cache-undefined)) + ;; If the key is an auxiliary process object, check + ;; whether the process is still alive. + (not (and (processp key) (not (process-live-p key))))) + (setq value cached + cache-used t)) + (tramp-message key 7 "%s %s; cache used: %s" property value cache-used) value)) ;;;###tramp-autoload @@ -317,19 +336,22 @@ value is not set for the connection, returns DEFAULT." "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-file-name-p key))) + (tramp-message key 7 "%s %s" property value) + value) ;;;###tramp-autoload (defun tramp-connection-property-p (key property) @@ -337,7 +359,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure." 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) @@ -352,8 +375,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure." (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-file-name-p key))) (tramp-message key 7 "%s" property)) ;;;###tramp-autoload @@ -370,12 +395,10 @@ used to cache connection properties of the local machine." (tramp-file-name-hop key) nil)) (tramp-message key 7 "%s %s" key - (let ((hash (gethash key tramp-cache-data)) - properties) - (when (hash-table-p hash) - (maphash (lambda (x _y) (push x properties)) hash)) - properties)) - (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-file-name-p key))) (remhash key tramp-cache-data)) ;;;###tramp-autoload @@ -386,20 +409,15 @@ used to cache connection properties of the local machine." (maphash (lambda (key value) ;; Remove text properties from KEY and VALUE. - ;; `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 (elt key i)) - (setf (elt key i) (substring-no-properties (elt key i)))))) - (when (stringp 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)))))) + (when (stringp key) (setq key (substring-no-properties key))) (when (stringp value) (setq value (substring-no-properties value))) @@ -421,18 +439,18 @@ used to cache connection properties of the local machine." ;;;###tramp-autoload (defun tramp-list-connections () "Return all known `tramp-file-name' structs according to `tramp-cache'." - (let (result tramp-verbose) - (maphash - (lambda (key _value) - (when (and (tramp-file-name-p key) - (null (tramp-file-name-localname key)) - (tramp-connection-property-p key "process-buffer")) - (push key result))) - tramp-cache-data) - result)) + (let ((tramp-verbose 0)) + (delq nil (mapcar + (lambda (key) + (and (tramp-file-name-p key) + (null (tramp-file-name-localname key)) + (tramp-connection-property-p key "process-buffer") + key)) + (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) @@ -464,15 +482,10 @@ used to cache connection properties of the local machine." ;; Dump it. (with-temp-file tramp-persistency-file-name (insert - ";; -*- emacs-lisp -*-" - ;; `time-stamp-string' might not exist in all Emacs flavors. - (condition-case nil - (progn - (format - " <%s %s>\n" - (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") - tramp-persistency-file-name)) - (error "\n")) + ;; Starting with Emacs 28, we could use `lisp-data'. + (format ";; -*- emacs-lisp -*- <%s %s>\n" + (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") + tramp-persistency-file-name) ";; Tramp connection history. Don't change this file.\n" ";; Run `M-x tramp-cleanup-all-connections' instead.\n\n" (with-output-to-string @@ -490,17 +503,14 @@ used to cache connection properties of the local machine." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." - (let (res) - (maphash - (lambda (key _value) - (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) - (tramp-file-name-host key)) - res))) - tramp-cache-data) - res)) + (mapcar + (lambda (key) + (and (tramp-file-name-p key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key)) + (list (tramp-file-name-user key) + (tramp-file-name-host key)))) + (hash-table-keys tramp-cache-data))) ;; When "emacs -Q" has been called, both variables are nil. We do not ;; load the persistency file then, in order to have a clean test environment. |