1 ;;; tramp-cache.el --- file information caching for Tramp
3 ;; Copyright (C) 2000, 2005-2013 Free Software Foundation, Inc.
5 ;; Author: Daniel Pittman <daniel@inanna.danann.net>
6 ;; Michael Albinus <michael.albinus@gmx.de>
7 ;; Keywords: comm, processes
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; An implementation of information caching for remote files.
29 ;; Each connection, identified by a vector [method user host
30 ;; localname] or by a process, has a unique cache. We distinguish 3
31 ;; kind of caches, depending on the key:
33 ;; - localname is NIL. This are reusable properties. Examples:
34 ;; "remote-shell" identifies the POSIX shell to be called on the
35 ;; remote host, or "perl" is the command to be called on the remote
36 ;; host when starting a Perl script. These properties are saved in
37 ;; the file `tramp-persistency-file-name'.
39 ;; - localname is a string. This are temporary properties, which are
40 ;; related to the file localname is referring to. Examples:
41 ;; "file-exists-p" is t or nile, depending on the file existence, or
42 ;; "file-attributes" caches the result of the function
45 ;; - The key is a process. This are temporary properties related to
46 ;; an open connection. Examples: "scripts" keeps shell script
47 ;; definitions already sent to the remote shell, "last-cmd-time" is
48 ;; the time stamp a command has been sent to the remote process.
53 (autoload 'time-stamp-string "time-stamp")
58 (defvar tramp-cache-data (make-hash-table :test 'equal)
59 "Hash table for remote files properties.")
62 (defcustom tramp-connection-properties nil
63 "List of static connection properties.
64 Every entry has the form (REGEXP PROPERTY VALUE). The regexp
65 matches remote file names. It can be nil. PROPERTY is a string,
66 and VALUE the corresponding value. They are used, if there is no
67 matching entry in for PROPERTY in `tramp-cache-data'."
70 :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
71 (choice :tag " Property" string)
72 (choice :tag " Value" sexp))))
74 (defcustom tramp-persistency-file-name
77 ((and (fboundp 'locate-user-emacs-file))
78 (expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp")))
79 ((and (boundp 'user-emacs-directory)
80 (stringp (symbol-value 'user-emacs-directory))
81 (file-directory-p (symbol-value 'user-emacs-directory)))
82 (expand-file-name "tramp" (symbol-value 'user-emacs-directory)))
83 ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
86 ((and (boundp 'user-init-directory)
87 (stringp (symbol-value 'user-init-directory))
88 (file-directory-p (symbol-value 'user-init-directory)))
89 (expand-file-name "tramp" (symbol-value 'user-init-directory)))
90 ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
92 ;; For users without `~/.emacs.d/' or `~/.xemacs/'.
94 "File which keeps connection history for Tramp connections."
98 (defvar tramp-cache-data-changed nil
99 "Whether persistent cache data have been changed.")
102 (defun tramp-get-file-property (vec file property default)
103 "Get the PROPERTY of FILE from the cache context of VEC.
104 Returns DEFAULT if not set."
106 (setq vec (copy-sequence vec))
107 (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
108 (let* ((hash (or (gethash vec tramp-cache-data)
109 (puthash vec (make-hash-table :test 'equal)
111 (value (when (hash-table-p hash) (gethash property hash))))
113 ;; We take the value only if there is any, and
114 ;; `remote-file-name-inhibit-cache' indicates that it is still
115 ;; valid. Otherwise, DEFAULT is set.
117 (or (null remote-file-name-inhibit-cache)
118 (and (integerp remote-file-name-inhibit-cache)
120 (tramp-time-diff (current-time) (car value))
121 remote-file-name-inhibit-cache))
122 (and (consp remote-file-name-inhibit-cache)
124 remote-file-name-inhibit-cache (car value)))))
125 (setq value (cdr value))
126 (setq value default))
128 (tramp-message vec 8 "%s %s %s" file property value)
129 (when (>= tramp-verbose 10)
130 (let* ((var (intern (concat "tramp-cache-get-count-" property)))
131 (val (or (ignore-errors (symbol-value var)) 0)))
136 (defun tramp-set-file-property (vec file property value)
137 "Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
140 (setq vec (copy-sequence vec))
141 (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
142 (let ((hash (or (gethash vec tramp-cache-data)
143 (puthash vec (make-hash-table :test 'equal)
145 ;; We put the timestamp there.
146 (puthash property (cons (current-time) value) hash)
147 (tramp-message vec 8 "%s %s %s" file property value)
148 (when (>= tramp-verbose 10)
149 (let* ((var (intern (concat "tramp-cache-set-count-" property)))
150 (val (or (ignore-errors (symbol-value var)) 0)))
155 (defun tramp-flush-file-property (vec file)
156 "Remove all properties of FILE in the cache context of VEC."
157 ;; Remove file property of symlinks.
158 (let ((truename (tramp-get-file-property vec file "file-truename" nil)))
159 (when (and (stringp truename)
160 (not (string-equal file truename)))
161 (tramp-flush-file-property vec truename)))
163 (setq vec (copy-sequence vec))
164 (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
165 (tramp-message vec 8 "%s" file)
166 (remhash vec tramp-cache-data))
169 (defun tramp-flush-directory-property (vec directory)
170 "Remove all properties of DIRECTORY in the cache context of VEC.
171 Remove also properties of all files in subdirectories."
172 (let ((directory (tramp-run-real-handler
173 'directory-file-name (list directory))))
174 (tramp-message vec 8 "%s" directory)
177 (when (and (stringp (tramp-file-name-localname key))
178 (string-match directory (tramp-file-name-localname key)))
179 (remhash key tramp-cache-data)))
182 ;; Reverting or killing a buffer should also flush file properties.
183 ;; They could have been changed outside Tramp. In eshell, "ls" would
184 ;; not show proper directory contents when a file has been copied or
186 (defun tramp-flush-file-function ()
187 "Flush all Tramp cache properties from `buffer-file-name'."
188 (let ((bfn (if (stringp (buffer-file-name))
191 (when (tramp-tramp-file-p bfn)
192 (with-parsed-tramp-file-name bfn nil
193 (tramp-flush-file-property v localname)))))
195 (add-hook 'before-revert-hook 'tramp-flush-file-function)
196 (add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
197 (add-hook 'kill-buffer-hook 'tramp-flush-file-function)
198 (add-hook 'tramp-cache-unload-hook
200 (remove-hook 'before-revert-hook
201 'tramp-flush-file-function)
202 (remove-hook 'eshell-pre-command-hook
203 'tramp-flush-file-function)
204 (remove-hook 'kill-buffer-hook
205 'tramp-flush-file-function)))
210 (defun tramp-get-connection-property (key property default)
211 "Get the named PROPERTY for the connection.
212 KEY identifies the connection, it is either a process or a vector.
213 If the value is not set for the connection, returns DEFAULT."
214 ;; Unify key by removing localname from vector. Work with a copy in
215 ;; order to avoid side effects.
217 (setq key (copy-sequence key))
219 (let* ((hash (gethash key tramp-cache-data))
223 ;; Check for dynamic properties.
227 (lambda (x y) (when (equal x property) (throw 'result y)))
229 ;; Check for static properties.
232 (dolist (elt tramp-connection-properties)
233 (when (and (string-match
235 (tramp-make-tramp-file-name
236 (aref key 0) (aref key 1) (aref key 2) nil))
237 (string-equal (or (nth 1 elt) "") (or property "")))
238 (throw 'result (nth 2 elt)))))
239 ;; The default value.
241 (tramp-message key 7 "%s %s" property value)
245 (defun tramp-set-connection-property (key property value)
246 "Set the named PROPERTY of a connection to VALUE.
247 KEY identifies the connection, it is either a process or a vector.
248 PROPERTY is set persistent when KEY is a vector."
249 ;; Unify key by removing localname from vector. Work with a copy in
250 ;; order to avoid side effects.
252 (setq key (copy-sequence key))
254 (let ((hash (or (gethash key tramp-cache-data)
255 (puthash key (make-hash-table :test 'equal)
257 (puthash property value hash)
258 (setq tramp-cache-data-changed t)
259 (tramp-message key 7 "%s %s" property value)
263 (defun tramp-flush-connection-property (key)
264 "Remove all properties identified by KEY.
265 KEY identifies the connection, it is either a process or a vector."
266 ;; Unify key by removing localname from vector. Work with a copy in
267 ;; order to avoid side effects.
269 (setq key (copy-sequence key))
273 (let ((hash (gethash key tramp-cache-data))
275 (if (hash-table-p hash)
277 (lambda (x y) (add-to-list 'properties x 'append))
278 (gethash key tramp-cache-data)))
280 (setq tramp-cache-data-changed t)
281 (remhash key tramp-cache-data))
284 (defun tramp-cache-print (table)
285 "Print hash table TABLE."
286 (when (hash-table-p table)
293 (prin1-to-string (prin1-to-string key))
294 (prin1-to-string key))
295 (if (hash-table-p value)
296 (tramp-cache-print value)
298 (prin1-to-string (prin1-to-string value))
299 (prin1-to-string value))))))
300 (setq result (if result (concat result " " tmp) tmp))))
305 (defun tramp-list-connections ()
306 "Return a list of all known connection vectors according to `tramp-cache'."
310 (when (and (vectorp key) (null (aref key 3)))
311 (add-to-list 'result key)))
315 (defun tramp-dump-connection-properties ()
316 "Write persistent connection properties into file `tramp-persistency-file-name'."
317 ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
319 (when (and (hash-table-p tramp-cache-data)
320 (not (zerop (hash-table-count tramp-cache-data)))
321 tramp-cache-data-changed
322 (stringp tramp-persistency-file-name))
323 (let ((cache (copy-hash-table tramp-cache-data))
324 print-length print-level)
325 ;; Remove temporary data. If there is the key "login-as", we
326 ;; don't save either, because all other properties might
327 ;; depend on the login name, and we want to give the
328 ;; possibility to use another login name later on.
331 (if (and (vectorp key)
332 (not (tramp-file-name-localname key))
333 (not (gethash "login-as" value)))
335 (remhash "process-name" value)
336 (remhash "process-buffer" value)
337 (remhash "first-password-request" value))
338 (remhash key cache)))
343 ";; -*- emacs-lisp -*-"
344 ;; `time-stamp-string' might not exist in all (X)Emacs flavors.
349 (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
350 tramp-persistency-file-name))
352 ";; Tramp connection history. Don't change this file.\n"
353 ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
354 (with-output-to-string
355 (pp (read (format "(%s)" (tramp-cache-print cache))))))
357 (point-min) (point-max) tramp-persistency-file-name))))))
359 (unless noninteractive
360 (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
361 (add-hook 'tramp-cache-unload-hook
363 (remove-hook 'kill-emacs-hook
364 'tramp-dump-connection-properties)))
367 (defun tramp-parse-connection-properties (method)
368 "Return a list of (user host) tuples allowed to access for METHOD.
369 This function is added always in `tramp-get-completion-function'
370 for all methods. Resulting data are derived from connection history."
374 (if (and (vectorp key)
375 (string-equal method (tramp-file-name-method key))
376 (not (tramp-file-name-localname key)))
377 (push (list (tramp-file-name-user key)
378 (tramp-file-name-host key))
383 ;; Read persistent connection history.
384 (when (and (stringp tramp-persistency-file-name)
385 (zerop (hash-table-count tramp-cache-data))
386 ;; When "emacs -Q" has been called, both variables are nil.
387 ;; We do not load the persistency file then, in order to
388 ;; have a clean test environment.
389 (or (and (boundp 'init-file-user) (symbol-value 'init-file-user))
390 (and (boundp 'site-run-file) (symbol-value 'site-run-file))))
393 (insert-file-contents tramp-persistency-file-name)
394 (let ((list (read (current-buffer)))
396 (while (setq element (pop list))
397 (setq key (pop element))
398 (while (setq item (pop element))
399 (tramp-set-connection-property key (pop item) (car item)))))
400 (setq tramp-cache-data-changed nil))
402 ;; Most likely because the file doesn't exist yet. No message.
403 (clrhash tramp-cache-data))
405 ;; File is corrupted.
406 (message "Tramp persistency file '%s' is corrupted: %s"
407 tramp-persistency-file-name (error-message-string err))
408 (clrhash tramp-cache-data))))
410 (add-hook 'tramp-unload-hook
412 (unload-feature 'tramp-cache 'force)))
414 (provide 'tramp-cache)
416 ;;; tramp-cache.el ends here