From: Michael Albinus Date: Sun, 11 Sep 2022 12:53:14 +0000 (+0200) Subject: Disable Tramp cache for relative file names X-Git-Tag: emacs-29.0.90~1856^2~596 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cba83d989359d667e52dad4e0e9eadf6f77cc38f;p=emacs.git Disable Tramp cache for relative file names * lisp/net/tramp.el (tramp-file-name-unify): Return `tramp-cache-undefined' if LOCALNAME is a relative file name. * lisp/net/tramp-cache.el (tramp-get-file-property) (tramp-set-file-property, tramp-file-property-p) (tramp-flush-file-property, tramp-flush-file-upper-properties) (tramp-flush-file-properties): Handle KEY being `tramp-cache-undefined'. (tramp-flush-file-function): Revert last change. --- diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 93bcdf4b973..58954c238e0 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -28,7 +28,7 @@ ;; An implementation of information caching for remote files. ;; Each connection, identified by a `tramp-file-name' structure or by -;; a process, has a unique cache. We distinguish 4 kind of caches, +;; a process, has a unique cache. We distinguish 5 kind of caches, ;; depending on the key: ;; ;; - localname is nil. These are reusable properties. Examples: @@ -37,13 +37,14 @@ ;; host when starting a Perl script. These properties are saved in ;; the file `tramp-persistency-file-name'. ;; -;; - 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 +;; - localname is an absolute file name. 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 ;; `file-attributes'. These entries have a timestamp, and they ;; expire after `remote-file-name-inhibit-cache' seconds if this -;; variable is set. +;; variable is set. These properties are taken into account only if +;; the connection is established, or `non-essential' is nil. ;; ;; - The key is a process. These are temporary properties related to ;; an open connection. Examples: "scripts" keeps shell script @@ -135,39 +136,41 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." Return DEFAULT if not set." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (let* ((hash (tramp-get-hash-table key)) - (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 - 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 cached))))) - (setq value (cdr cached) - cache-used t)) - - (tramp-message - key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" - (tramp-file-name-localname key) - property value remote-file-name-inhibit-cache cache-used cached-at) - ;; For analysis purposes, count the number of getting this file attribute. - (when (>= tramp-verbose 10) - (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (and (boundp var) (numberp (symbol-value var)) - (symbol-value var)) - 0))) - (set var (1+ val)))) - value)) + (if (eq key tramp-cache-undefined) default + (let* ((hash (tramp-get-hash-table key)) + (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 + 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 cached))))) + (setq value (cdr cached) + cache-used t)) + + (tramp-message + key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" + (tramp-file-name-localname key) + property value remote-file-name-inhibit-cache cache-used cached-at) + ;; For analysis purposes, count the number of getting this file attribute. + (when (>= tramp-verbose 10) + (let* ((var (intern (concat "tramp-cache-get-count-" property))) + (val (or (and (boundp var) (numberp (symbol-value var)) + (symbol-value var)) + 0))) + (set var (1+ val)))) + value))) (add-hook 'tramp-cache-unload-hook (lambda () @@ -180,19 +183,20 @@ Return DEFAULT if not set." Return VALUE." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (let ((hash (tramp-get-hash-table key))) - ;; We put the timestamp there. - (puthash property (cons (current-time) value) hash) - (tramp-message - key 8 "%s %s %s" (tramp-file-name-localname key) property value) - ;; For analysis purposes, count the number of setting this file attribute. - (when (>= tramp-verbose 10) - (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (and (boundp var) (numberp (symbol-value var)) - (symbol-value var)) - 0))) - (set var (1+ val)))) - value)) + (if (eq key tramp-cache-undefined) value + (let ((hash (tramp-get-hash-table key))) + ;; We put the timestamp there. + (puthash property (cons (current-time) value) hash) + (tramp-message + key 8 "%s %s %s" (tramp-file-name-localname key) property value) + ;; For analysis purposes, count the number of setting this file attribute. + (when (>= tramp-verbose 10) + (let* ((var (intern (concat "tramp-cache-set-count-" property))) + (val (or (and (boundp var) (numberp (symbol-value var)) + (symbol-value var)) + 0))) + (set var (1+ val)))) + value))) (add-hook 'tramp-cache-unload-hook (lambda () @@ -202,19 +206,22 @@ Return VALUE." ;;;###tramp-autoload (defun tramp-file-property-p (key file property) "Check whether PROPERTY of FILE is defined in the cache context of KEY." - (not (eq (tramp-get-file-property key file property tramp-cache-undefined) - tramp-cache-undefined))) + (and + (not (eq key tramp-cache-undefined)) + (not (eq (tramp-get-file-property key file property tramp-cache-undefined) + tramp-cache-undefined)))) ;;;###tramp-autoload (defun tramp-flush-file-property (key file property) "Remove PROPERTY of FILE in the cache context of KEY." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (remhash property (tramp-get-hash-table key)) - (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property) - (when (>= tramp-verbose 10) - (let ((var (intern (concat "tramp-cache-set-count-" property)))) - (makunbound var)))) + (unless (eq key tramp-cache-undefined) + (remhash property (tramp-get-hash-table key)) + (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property) + (when (>= tramp-verbose 10) + (let ((var (intern (concat "tramp-cache-set-count-" property)))) + (makunbound var))))) (defun tramp-flush-file-upper-properties (key file) "Remove some properties of FILE's upper directory." @@ -224,12 +231,14 @@ Return VALUE." (file (directory-file-name file))) ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (dolist (property (hash-table-keys (tramp-get-hash-table key))) - (when (string-match-p - (rx - bos (| "directory-" "file-name-all-completions" "file-entries")) - property) - (tramp-flush-file-property key file property)))))) + (unless (eq key tramp-cache-undefined) + (dolist (property (hash-table-keys (tramp-get-hash-table key))) + (when (string-match-p + (rx + bos (| "directory-" "file-name-all-completions" + "file-entries")) + property) + (tramp-flush-file-property key file property))))))) ;;;###tramp-autoload (defun tramp-flush-file-properties (key file) @@ -237,14 +246,15 @@ Return VALUE." (let ((truename (tramp-get-file-property key file "file-truename"))) ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (tramp-message key 8 "%s" (tramp-file-name-localname key)) - (remhash key tramp-cache-data) - ;; Remove file properties of symlinks. - (when (and (stringp truename) - (not (string-equal file (directory-file-name truename)))) - (tramp-flush-file-properties key truename)) - ;; Remove selected properties of upper directory. - (tramp-flush-file-upper-properties key file))) + (unless (eq key tramp-cache-undefined) + (tramp-message key 8 "%s" (tramp-file-name-localname key)) + (remhash key tramp-cache-data) + ;; Remove file properties of symlinks. + (when (and (stringp truename) + (not (string-equal file (directory-file-name truename)))) + (tramp-flush-file-properties key truename)) + ;; Remove selected properties of upper directory. + (tramp-flush-file-upper-properties key file)))) ;;;###tramp-autoload (defun tramp-flush-directory-properties (key directory) @@ -285,8 +295,7 @@ This is suppressed for temporary buffers." (tramp-verbose 0)) (when (tramp-tramp-file-p bfn) (tramp-flush-file-properties - (tramp-dissect-file-name bfn) - (tramp-file-local-name (expand-file-name bfn)))))))) + (tramp-dissect-file-name bfn) (tramp-file-local-name bfn))))))) (add-hook 'before-revert-hook #'tramp-flush-file-function) (add-hook 'eshell-pre-command-hook #'tramp-flush-file-function) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 15380ed94dd..90cc03c188e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1504,23 +1504,21 @@ If nil, return `tramp-default-port'." ;;;###tramp-autoload (defun tramp-file-name-unify (vec &optional localname) "Unify VEC by removing localname and hop from `tramp-file-name' structure. -If LOCALNAME is a string, set it as localname. +If LOCALNAME is an absolute file name, set it as localname. If +LOCALNAME is a relative file name, return `tramp-cache-undefined'. Objects returned by this function compare `equal' if they refer to the same connection. Make a copy in order to avoid side effects." - (when (tramp-file-name-p vec) - (setq vec (copy-tramp-file-name vec)) - (setf (tramp-file-name-localname vec) - (and (stringp localname) - ;; FIXME: This is a sanity check. When this error - ;; doesn't happen for a while, it can be removed. - (or (file-name-absolute-p localname) - (tramp-error - vec 'file-error - "File `%s' must be absolute, please report a bug!" - localname)) - (tramp-compat-file-name-unquote (directory-file-name localname))) - (tramp-file-name-hop vec) nil)) - vec) + (if (and (stringp localname) + (not (file-name-absolute-p localname))) + (setq vec tramp-cache-undefined) + (when (tramp-file-name-p vec) + (setq vec (copy-tramp-file-name vec)) + (setf (tramp-file-name-localname vec) + (and (stringp localname) + (tramp-compat-file-name-unquote + (directory-file-name localname))) + (tramp-file-name-hop vec) nil)) + vec)) (put #'tramp-file-name-unify 'tramp-suppress-trace t)