1;;; tramp-cache.el --- file information caching for Tramp -*- lexical-binding:t -*- 2 3;; Copyright (C) 2000, 2005-2021 Free Software Foundation, Inc. 4 5;; Author: Daniel Pittman <daniel@inanna.danann.net> 6;; Michael Albinus <michael.albinus@gmx.de> 7;; Maintainer: Michael Albinus <michael.albinus@gmx.de> 8;; Keywords: comm, processes 9;; Package: tramp 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software: you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation, either version 3 of the License, or 16;; (at your option) any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 26;;; Commentary: 27 28;; An implementation of information caching for remote files. 29 30;; Each connection, identified by a `tramp-file-name' structure or by 31;; a process, has a unique cache. We distinguish 4 kind of caches, 32;; depending on the key: 33;; 34;; - localname is nil. These are reusable properties. Examples: 35;; "remote-shell" identifies the POSIX shell to be called on the 36;; remote host, or "perl" is the command to be called on the remote 37;; host when starting a Perl script. These properties are saved in 38;; the file `tramp-persistency-file-name'. 39;; 40;; - localname is a string. These are temporary properties, which are 41;; related to the file localname is referring to. Examples: 42;; "file-exists-p" is t or nil, depending on the file existence, or 43;; "file-attributes" caches the result of the function 44;; `file-attributes'. These entries have a timestamp, and they 45;; expire after `remote-file-name-inhibit-cache' seconds if this 46;; variable is set. 47;; 48;; - The key is a process. These are temporary properties related to 49;; an open connection. Examples: "scripts" keeps shell script 50;; definitions already sent to the remote shell, "last-cmd-time" is 51;; the time stamp a command has been sent to the remote process. 52;; 53;; - The key is nil. These are temporary properties related to the 54;; local machine. Examples: "parse-passwd" and "parse-group" keep 55;; the results of parsing "/etc/passwd" and "/etc/group", 56;; "{uid,gid}-{integer,string}" are the local uid and gid, and 57;; "locale" is the used shell locale. 58;; 59;; - The key is `tramp-cache-undefined'. All functions return the 60;; expected values, but nothing is cached. 61 62;; Some properties are handled special: 63;; 64;; - "process-name", "process-buffer" and "first-password-request" are 65;; not saved in the file `tramp-persistency-file-name', although 66;; being connection properties related to a `tramp-file-name' 67;; structure. 68;; 69;; - Reusable properties, which should not be saved, are kept in the 70;; process key retrieved by `tramp-get-process' (the main connection 71;; process). Other processes could reuse these properties, avoiding 72;; recomputation when a new asynchronous process is created by 73;; `make-process'. Examples are "unsafe-temporary-file", 74;; "remote-path", "device" (tramp-adb.el) or "share" (tramp-gvfs.el). 75 76;;; Code: 77 78(require 'tramp) 79(autoload 'time-stamp-string "time-stamp") 80 81;;; -- Cache -- 82 83;;;###tramp-autoload 84(defvar tramp-cache-data (make-hash-table :test #'equal) 85 "Hash table for remote files properties.") 86 87;;;###tramp-autoload 88(defcustom tramp-connection-properties nil 89 "List of static connection properties. 90Every entry has the form (REGEXP PROPERTY VALUE). The regexp 91matches remote file names. It can be nil. PROPERTY is a string, 92and VALUE the corresponding value. They are used, if there is no 93matching entry for PROPERTY in `tramp-cache-data'. For more 94details see the info pages." 95 :group 'tramp 96 :version "24.4" 97 :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil)) 98 (choice :tag " Property" string) 99 (choice :tag " Value" sexp)))) 100 101;;;###tramp-autoload 102(defcustom tramp-persistency-file-name (locate-user-emacs-file "tramp") 103 "File which keeps connection history for Tramp connections." 104 :group 'tramp 105 :type 'file) 106 107(defvar tramp-cache-data-changed nil 108 "Whether persistent cache data have been changed.") 109 110;;;###tramp-autoload 111(defconst tramp-cache-undefined 'undef 112 "The symbol marking undefined hash keys and values.") 113 114(defun tramp-get-hash-table (key) 115 "Return the hash table for KEY. 116If it doesn't exist yet, it is created and initialized with 117matching entries of `tramp-connection-properties'. 118If KEY is `tramp-cache-undefined', don't create anything, and return nil." 119 (unless (eq key tramp-cache-undefined) 120 (or (gethash key tramp-cache-data) 121 (let ((hash 122 (puthash key (make-hash-table :test #'equal) tramp-cache-data))) 123 (when (tramp-file-name-p key) 124 (dolist (elt tramp-connection-properties) 125 (when (tramp-compat-string-search 126 (or (nth 0 elt) "") 127 (tramp-make-tramp-file-name key 'noloc 'nohop)) 128 (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) 129 hash)))) 130 131;;;###tramp-autoload 132(defun tramp-get-file-property (key file property default) 133 "Get the PROPERTY of FILE from the cache context of KEY. 134Return DEFAULT if not set." 135 ;; Unify localname. Remove hop from `tramp-file-name' structure. 136 (setq file (tramp-compat-file-name-unquote file) 137 key (copy-tramp-file-name key)) 138 (setf (tramp-file-name-localname key) 139 (tramp-run-real-handler #'directory-file-name (list file)) 140 (tramp-file-name-hop key) nil) 141 (let* ((hash (tramp-get-hash-table key)) 142 (cached (and (hash-table-p hash) (gethash property hash))) 143 (cached-at (and (consp cached) (format-time-string "%T" (car cached)))) 144 (value default) 145 cache-used) 146 147 (when ;; We take the value only if there is any, and 148 ;; `remote-file-name-inhibit-cache' indicates that it is 149 ;; still valid. Otherwise, DEFAULT is set. 150 (and (consp cached) 151 (or (null remote-file-name-inhibit-cache) 152 (and (integerp remote-file-name-inhibit-cache) 153 (time-less-p 154 nil 155 (time-add (car cached) remote-file-name-inhibit-cache))) 156 (and (consp remote-file-name-inhibit-cache) 157 (time-less-p 158 remote-file-name-inhibit-cache (car cached))))) 159 (setq value (cdr cached) 160 cache-used t)) 161 162 (tramp-message 163 key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" 164 file property value remote-file-name-inhibit-cache cache-used cached-at) 165 ;; For analysis purposes, count the number of getting this file attribute. 166 (when (>= tramp-verbose 10) 167 (let* ((var (intern (concat "tramp-cache-get-count-" property))) 168 (val (or (and (boundp var) (numberp (symbol-value var)) 169 (symbol-value var)) 170 0))) 171 (set var (1+ val)))) 172 value)) 173 174(add-hook 'tramp-cache-unload-hook 175 (lambda () 176 (dolist (var (all-completions "tramp-cache-get-count-" obarray)) 177 (unintern var obarray)))) 178 179;;;###tramp-autoload 180(defun tramp-set-file-property (key file property value) 181 "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. 182Return VALUE." 183 ;; Unify localname. Remove hop from `tramp-file-name' structure. 184 (setq file (tramp-compat-file-name-unquote file) 185 key (copy-tramp-file-name key)) 186 (setf (tramp-file-name-localname key) 187 (tramp-run-real-handler #'directory-file-name (list file)) 188 (tramp-file-name-hop key) nil) 189 (let ((hash (tramp-get-hash-table key))) 190 ;; We put the timestamp there. 191 (puthash property (cons (current-time) value) hash) 192 (tramp-message key 8 "%s %s %s" file property value) 193 ;; For analysis purposes, count the number of setting this file attribute. 194 (when (>= tramp-verbose 10) 195 (let* ((var (intern (concat "tramp-cache-set-count-" property))) 196 (val (or (and (boundp var) (numberp (symbol-value var)) 197 (symbol-value var)) 198 0))) 199 (set var (1+ val)))) 200 value)) 201 202(add-hook 'tramp-cache-unload-hook 203 (lambda () 204 (dolist (var (all-completions "tramp-cache-set-count-" obarray)) 205 (unintern var obarray)))) 206 207;;;###tramp-autoload 208(defun tramp-flush-file-property (key file property) 209 "Remove PROPERTY of FILE in the cache context of KEY." 210 ;; Unify localname. Remove hop from `tramp-file-name' structure. 211 (setq file (tramp-compat-file-name-unquote file) 212 key (copy-tramp-file-name key)) 213 (setf (tramp-file-name-localname key) 214 (tramp-run-real-handler #'directory-file-name (list file)) 215 (tramp-file-name-hop key) nil) 216 (remhash property (tramp-get-hash-table key)) 217 (tramp-message key 8 "%s %s" file property) 218 (when (>= tramp-verbose 10) 219 (let ((var (intern (concat "tramp-cache-set-count-" property)))) 220 (makunbound var)))) 221 222(defun tramp-flush-file-upper-properties (key file) 223 "Remove some properties of FILE's upper directory." 224 (when (file-name-absolute-p file) 225 ;; `file-name-directory' can return nil, for example for "~". 226 (when-let ((file (file-name-directory file)) 227 (file (directory-file-name file))) 228 ;; Unify localname. Remove hop from `tramp-file-name' structure. 229 (setq file (tramp-compat-file-name-unquote file) 230 key (copy-tramp-file-name key)) 231 (setf (tramp-file-name-localname key) file 232 (tramp-file-name-hop key) nil) 233 (dolist (property (hash-table-keys (tramp-get-hash-table key))) 234 (when (string-match-p 235 "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" 236 property) 237 (tramp-flush-file-property key file property)))))) 238 239;;;###tramp-autoload 240(defun tramp-flush-file-properties (key file) 241 "Remove all properties of FILE in the cache context of KEY." 242 (let* ((file (tramp-run-real-handler #'directory-file-name (list file))) 243 (truename (tramp-get-file-property key file "file-truename" nil))) 244 ;; Unify localname. Remove hop from `tramp-file-name' structure. 245 (setq file (tramp-compat-file-name-unquote file) 246 key (copy-tramp-file-name key)) 247 (setf (tramp-file-name-localname key) file 248 (tramp-file-name-hop key) nil) 249 (tramp-message key 8 "%s" file) 250 (remhash key tramp-cache-data) 251 ;; Remove file properties of symlinks. 252 (when (and (stringp truename) 253 (not (string-equal file (directory-file-name truename)))) 254 (tramp-flush-file-properties key truename)) 255 ;; Remove selected properties of upper directory. 256 (tramp-flush-file-upper-properties key file))) 257 258;;;###tramp-autoload 259(defun tramp-flush-directory-properties (key directory) 260 "Remove all properties of DIRECTORY in the cache context of KEY. 261Remove also properties of all files in subdirectories." 262 (setq directory (tramp-compat-file-name-unquote directory)) 263 (let* ((directory (tramp-run-real-handler 264 #'directory-file-name (list directory))) 265 (truename (tramp-get-file-property key directory "file-truename" nil))) 266 (tramp-message key 8 "%s" directory) 267 (dolist (key (hash-table-keys tramp-cache-data)) 268 (when (and (tramp-file-name-p key) 269 (stringp (tramp-file-name-localname key)) 270 (tramp-compat-string-search 271 directory (tramp-file-name-localname key))) 272 (remhash key tramp-cache-data))) 273 ;; Remove file properties of symlinks. 274 (when (and (stringp truename) 275 (not (string-equal directory (directory-file-name truename)))) 276 (tramp-flush-directory-properties key truename)) 277 ;; Remove selected properties of upper directory. 278 (tramp-flush-file-upper-properties key directory))) 279 280;; Reverting or killing a buffer should also flush file properties. 281;; They could have been changed outside Tramp. In eshell, "ls" would 282;; not show proper directory contents when a file has been copied or 283;; deleted before. We must apply `save-match-data', because it would 284;; corrupt other packages otherwise (reported from org). 285(defun tramp-flush-file-function () 286 "Flush all Tramp cache properties from `buffer-file-name'. 287This is suppressed for temporary buffers." 288 (save-match-data 289 (unless (or (null (buffer-name)) 290 (string-match-p "^\\( \\|\\*\\)" (buffer-name))) 291 (let ((bfn (if (stringp (buffer-file-name)) 292 (buffer-file-name) 293 default-directory)) 294 (tramp-verbose 0)) 295 (when (tramp-tramp-file-p bfn) 296 (with-parsed-tramp-file-name bfn nil 297 (tramp-flush-file-properties v localname))))))) 298 299(add-hook 'before-revert-hook #'tramp-flush-file-function) 300(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function) 301(add-hook 'kill-buffer-hook #'tramp-flush-file-function) 302(add-hook 'tramp-cache-unload-hook 303 (lambda () 304 (remove-hook 'before-revert-hook 305 #'tramp-flush-file-function) 306 (remove-hook 'eshell-pre-command-hook 307 #'tramp-flush-file-function) 308 (remove-hook 'kill-buffer-hook 309 #'tramp-flush-file-function))) 310 311;;; -- Properties -- 312 313;;;###tramp-autoload 314(defun tramp-get-connection-property (key property default) 315 "Get the named PROPERTY for the connection. 316KEY identifies the connection, it is either a process or a 317`tramp-file-name' structure. A special case is nil, which is 318used to cache connection properties of the local machine. 319If KEY is `tramp-cache-undefined', or if the value is not set for 320the connection, return DEFAULT." 321 (setq key (tramp-file-name-unify key)) 322 (let* ((hash (tramp-get-hash-table key)) 323 (cached (if (hash-table-p hash) 324 (gethash property hash tramp-cache-undefined) 325 tramp-cache-undefined)) 326 (value default) 327 cache-used) 328 329 (when (and (not (eq cached tramp-cache-undefined)) 330 ;; If the key is an auxiliary process object, check 331 ;; whether the process is still alive. 332 (not (and (processp key) (not (process-live-p key))))) 333 (setq value cached 334 cache-used t)) 335 (tramp-message key 7 "%s %s; cache used: %s" property value cache-used) 336 value)) 337 338;;;###tramp-autoload 339(defun tramp-set-connection-property (key property value) 340 "Set the named PROPERTY of a connection to VALUE. 341KEY identifies the connection, it is either a process or a 342`tramp-file-name' structure. A special case is nil, which is 343used to cache connection properties of the local machine. If KEY 344is `tramp-cache-undefined', nothing is set. 345PROPERTY is set persistent when KEY is a `tramp-file-name' structure. 346Return VALUE." 347 (setq key (tramp-file-name-unify key)) 348 (when-let ((hash (tramp-get-hash-table key))) 349 (puthash property value hash)) 350 (setq tramp-cache-data-changed 351 (or tramp-cache-data-changed (tramp-file-name-p key))) 352 (tramp-message key 7 "%s %s" property value) 353 value) 354 355;;;###tramp-autoload 356(defun tramp-connection-property-p (key property) 357 "Check whether named PROPERTY of a connection is defined. 358KEY identifies the connection, it is either a process or a 359`tramp-file-name' structure. A special case is nil, which is 360used to cache connection properties of the local machine." 361 (not (eq (tramp-get-connection-property key property tramp-cache-undefined) 362 tramp-cache-undefined))) 363 364;;;###tramp-autoload 365(defun tramp-flush-connection-property (key property) 366 "Remove the named PROPERTY of a connection identified by KEY. 367KEY identifies the connection, it is either a process or a 368`tramp-file-name' structure. A special case is nil, which is 369used to cache connection properties of the local machine. 370PROPERTY is set persistent when KEY is a `tramp-file-name' structure." 371 (setq key (tramp-file-name-unify key)) 372 (when-let ((hash (tramp-get-hash-table key))) 373 (remhash property hash)) 374 (setq tramp-cache-data-changed 375 (or tramp-cache-data-changed (tramp-file-name-p key))) 376 (tramp-message key 7 "%s" property)) 377 378;;;###tramp-autoload 379(defun tramp-flush-connection-properties (key) 380 "Remove all properties identified by KEY. 381KEY identifies the connection, it is either a process or a 382`tramp-file-name' structure. A special case is nil, which is 383used to cache connection properties of the local machine." 384 (setq key (tramp-file-name-unify key)) 385 (tramp-message 386 key 7 "%s %s" key 387 (when-let ((hash (gethash key tramp-cache-data))) 388 (hash-table-keys hash))) 389 (setq tramp-cache-data-changed 390 (or tramp-cache-data-changed (tramp-file-name-p key))) 391 (remhash key tramp-cache-data)) 392 393;;;###tramp-autoload 394(defun tramp-cache-print (table) 395 "Print hash table TABLE." 396 (when (hash-table-p table) 397 (let (result) 398 (maphash 399 (lambda (key value) 400 ;; Remove text properties from KEY and VALUE. 401 (when (tramp-file-name-p key) 402 (dolist 403 (slot 404 (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name)))) 405 (when (stringp (cl-struct-slot-value 'tramp-file-name slot key)) 406 (setf (cl-struct-slot-value 'tramp-file-name slot key) 407 (substring-no-properties 408 (cl-struct-slot-value 'tramp-file-name slot key)))))) 409 (when (stringp key) 410 (setq key (substring-no-properties key))) 411 (when (stringp value) 412 (setq value (substring-no-properties value))) 413 ;; Dump. 414 (let ((tmp (format 415 "(%s %s)" 416 (if (processp key) 417 (prin1-to-string (prin1-to-string key)) 418 (prin1-to-string key)) 419 (if (hash-table-p value) 420 (tramp-cache-print value) 421 (if (bufferp value) 422 (prin1-to-string (prin1-to-string value)) 423 (prin1-to-string value)))))) 424 (setq result (if result (concat result " " tmp) tmp)))) 425 table) 426 result))) 427 428;;;###tramp-autoload 429(defun tramp-list-connections () 430 "Return all known `tramp-file-name' structs according to `tramp-cache'." 431 (let ((tramp-verbose 0)) 432 (delq nil (mapcar 433 (lambda (key) 434 (and (tramp-file-name-p key) 435 (null (tramp-file-name-localname key)) 436 (tramp-connection-property-p key "process-buffer") 437 key)) 438 (hash-table-keys tramp-cache-data))))) 439 440(defun tramp-dump-connection-properties () 441 "Write persistent connection properties into file \ 442`tramp-persistency-file-name'." 443 ;; We shouldn't fail, otherwise Emacs might not be able to be closed. 444 (ignore-errors 445 (when (and (hash-table-p tramp-cache-data) 446 (not (zerop (hash-table-count tramp-cache-data))) 447 tramp-cache-data-changed 448 (stringp tramp-persistency-file-name)) 449 (let ((cache (copy-hash-table tramp-cache-data)) 450 print-length print-level) 451 ;; Remove temporary data. If there is the key "login-as", we 452 ;; don't save either, because all other properties might 453 ;; depend on the login name, and we want to give the 454 ;; possibility to use another login name later on. Key 455 ;; "started" exists for the "ftp" method only, which must not 456 ;; be kept persistent. 457 (maphash 458 (lambda (key value) 459 (if (and (tramp-file-name-p key) (hash-table-p value) 460 (not (string-equal 461 (tramp-file-name-method key) tramp-archive-method)) 462 (not (tramp-file-name-localname key)) 463 (not (gethash "login-as" value)) 464 (not (gethash "started" value))) 465 (progn 466 (remhash "process-name" value) 467 (remhash "process-buffer" value) 468 (remhash "first-password-request" value)) 469 (remhash key cache))) 470 cache) 471 ;; Dump it. 472 (with-temp-file tramp-persistency-file-name 473 (insert 474 ;; Starting with Emacs 28, we could use `lisp-data'. 475 (format ";; -*- emacs-lisp -*- <%s %s>\n" 476 (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") 477 tramp-persistency-file-name) 478 ";; Tramp connection history. Don't change this file.\n" 479 ";; Run `M-x tramp-cleanup-all-connections' instead.\n\n" 480 (with-output-to-string 481 (pp (read (format "(%s)" (tramp-cache-print cache))))))))))) 482 483(unless noninteractive 484 (add-hook 'kill-emacs-hook #'tramp-dump-connection-properties)) 485(add-hook 'tramp-cache-unload-hook 486 (lambda () 487 (remove-hook 'kill-emacs-hook 488 #'tramp-dump-connection-properties))) 489 490;;;###tramp-autoload 491(defun tramp-parse-connection-properties (method) 492 "Return a list of (user host) tuples allowed to access for METHOD. 493This function is added always in `tramp-get-completion-function' 494for all methods. Resulting data are derived from connection history." 495 (mapcar 496 (lambda (key) 497 (and (tramp-file-name-p key) 498 (string-equal method (tramp-file-name-method key)) 499 (not (tramp-file-name-localname key)) 500 (list (tramp-file-name-user key) 501 (tramp-file-name-host key)))) 502 (hash-table-keys tramp-cache-data))) 503 504;; When "emacs -Q" has been called, both variables are nil. We do not 505;; load the persistency file then, in order to have a clean test environment. 506;;;###tramp-autoload 507(defvar tramp-cache-read-persistent-data (or init-file-user site-run-file) 508 "Whether to read persistent data at startup time.") 509 510;; Read persistent connection history. 511(when (and (stringp tramp-persistency-file-name) 512 (zerop (hash-table-count tramp-cache-data)) 513 tramp-cache-read-persistent-data) 514 (condition-case err 515 (with-temp-buffer 516 (insert-file-contents-literally tramp-persistency-file-name) 517 (let ((list (read (current-buffer))) 518 (tramp-verbose 0) 519 element key item) 520 (while (setq element (pop list)) 521 (setq key (pop element)) 522 (when (tramp-file-name-p key) 523 (while (setq item (pop element)) 524 ;; We set only values which are not contained in 525 ;; `tramp-connection-properties'. The cache is 526 ;; initialized properly by side effect. 527 (unless (tramp-connection-property-p key (car item)) 528 (tramp-set-connection-property key (pop item) (car item))))))) 529 (setq tramp-cache-data-changed nil)) 530 (file-error 531 ;; Most likely because the file doesn't exist yet. No message. 532 (clrhash tramp-cache-data)) 533 (error 534 ;; File is corrupted. 535 (message "Tramp persistency file `%s' is corrupted: %s" 536 tramp-persistency-file-name (error-message-string err)) 537 (clrhash tramp-cache-data)))) 538 539(add-hook 'tramp-unload-hook 540 (lambda () 541 (unload-feature 'tramp-cache 'force))) 542 543(provide 'tramp-cache) 544 545;;; tramp-cache.el ends here 546