Commit | Line | Data |
---|---|---|
00d6fd04 MA |
1 | ;;; tramp-cache.el --- file information caching for Tramp |
2 | ||
7540f029 | 3 | ;; Copyright (C) 2000, 2005, 2006, 2007, 2008, 2009, |
5df4f04c | 4 | ;; 2010, 2011 Free Software Foundation, Inc. |
00d6fd04 MA |
5 | |
6 | ;; Author: Daniel Pittman <daniel@inanna.danann.net> | |
7 | ;; Michael Albinus <michael.albinus@gmx.de> | |
8 | ;; Keywords: comm, processes | |
bd78fa1d | 9 | ;; Package: tramp |
00d6fd04 MA |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
874a927a | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
00d6fd04 | 14 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
00d6fd04 MA |
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 | |
874a927a | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
00d6fd04 MA |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; An implementation of information caching for remote files. | |
29 | ||
30 | ;; Each connection, identified by a vector [method user host | |
31 | ;; localname] or by a process, has a unique cache. We distinguish 3 | |
32 | ;; kind of caches, depending on the key: | |
33 | ;; | |
34 | ;; - localname is NIL. This 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. This are temporary properties, which are | |
41 | ;; related to the file localname is referring to. Examples: | |
42 | ;; "file-exists-p" is t or nile, depending on the file existence, or | |
43 | ;; "file-attributes" caches the result of the function | |
44 | ;; `file-attributes'. | |
45 | ;; | |
46 | ;; - The key is a process. This are temporary properties related to | |
47 | ;; an open connection. Examples: "scripts" keeps shell script | |
48 | ;; definitions already sent to the remote shell, "last-cmd-time" is | |
49 | ;; the time stamp a command has been sent to the remote process. | |
50 | ||
51 | ;;; Code: | |
52 | ||
0f34aa77 MA |
53 | (require 'tramp) |
54 | (autoload 'time-stamp-string "time-stamp") | |
00d6fd04 MA |
55 | |
56 | ;;; -- Cache -- | |
57 | ||
0f34aa77 | 58 | ;;;###tramp-autoload |
00d6fd04 MA |
59 | (defvar tramp-cache-data (make-hash-table :test 'equal) |
60 | "Hash table for remote files properties.") | |
61 | ||
62 | (defcustom tramp-persistency-file-name | |
63 | (cond | |
64 | ;; GNU Emacs. | |
d68b0220 MA |
65 | ((and (fboundp 'locate-user-emacs-file)) |
66 | (expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp"))) | |
00d6fd04 MA |
67 | ((and (boundp 'user-emacs-directory) |
68 | (stringp (symbol-value 'user-emacs-directory)) | |
69 | (file-directory-p (symbol-value 'user-emacs-directory))) | |
70 | (expand-file-name "tramp" (symbol-value 'user-emacs-directory))) | |
71 | ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/")) | |
72 | "~/.emacs.d/tramp") | |
73 | ;; XEmacs. | |
74 | ((and (boundp 'user-init-directory) | |
75 | (stringp (symbol-value 'user-init-directory)) | |
76 | (file-directory-p (symbol-value 'user-init-directory))) | |
77 | (expand-file-name "tramp" (symbol-value 'user-init-directory))) | |
78 | ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/")) | |
79 | "~/.xemacs/tramp") | |
80 | ;; For users without `~/.emacs.d/' or `~/.xemacs/'. | |
81 | (t "~/.tramp")) | |
82 | "File which keeps connection history for Tramp connections." | |
83 | :group 'tramp | |
84 | :type 'file) | |
85 | ||
7c3404ec MA |
86 | (defvar tramp-cache-data-changed nil |
87 | "Whether persistent cache data have been changed.") | |
88 | ||
0f34aa77 | 89 | ;;;###tramp-autoload |
00d6fd04 MA |
90 | (defun tramp-get-file-property (vec file property default) |
91 | "Get the PROPERTY of FILE from the cache context of VEC. | |
92 | Returns DEFAULT if not set." | |
93 | ;; Unify localname. | |
94 | (setq vec (copy-sequence vec)) | |
87bdd2c7 | 95 | (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) |
00d6fd04 MA |
96 | (let* ((hash (or (gethash vec tramp-cache-data) |
97 | (puthash vec (make-hash-table :test 'equal) | |
98 | tramp-cache-data))) | |
d5b5c94a MA |
99 | (value (when (hash-table-p hash) (gethash property hash)))) |
100 | (if | |
101 | ;; We take the value only if there is any, and | |
4bc3c53d | 102 | ;; `remote-file-name-inhibit-cache' indicates that it is still |
d5b5c94a MA |
103 | ;; valid. Otherwise, DEFAULT is set. |
104 | (and (consp value) | |
4bc3c53d MA |
105 | (or (null remote-file-name-inhibit-cache) |
106 | (and (integerp remote-file-name-inhibit-cache) | |
107 | (<= | |
108 | (tramp-time-diff (current-time) (car value)) | |
109 | remote-file-name-inhibit-cache)) | |
110 | (and (consp remote-file-name-inhibit-cache) | |
d5b5c94a | 111 | (tramp-time-less-p |
4bc3c53d | 112 | remote-file-name-inhibit-cache (car value))))) |
d5b5c94a MA |
113 | (setq value (cdr value)) |
114 | (setq value default)) | |
115 | ||
00d6fd04 | 116 | (tramp-message vec 8 "%s %s %s" file property value) |
4bc3c53d MA |
117 | (when (>= tramp-verbose 10) |
118 | (let* ((var (intern (concat "tramp-cache-get-count-" property))) | |
119 | (val (or (ignore-errors (symbol-value var)) 0))) | |
120 | (set var (1+ val)))) | |
00d6fd04 MA |
121 | value)) |
122 | ||
0f34aa77 | 123 | ;;;###tramp-autoload |
00d6fd04 MA |
124 | (defun tramp-set-file-property (vec file property value) |
125 | "Set the PROPERTY of FILE to VALUE, in the cache context of VEC. | |
126 | Returns VALUE." | |
127 | ;; Unify localname. | |
128 | (setq vec (copy-sequence vec)) | |
87bdd2c7 | 129 | (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) |
00d6fd04 MA |
130 | (let ((hash (or (gethash vec tramp-cache-data) |
131 | (puthash vec (make-hash-table :test 'equal) | |
132 | tramp-cache-data)))) | |
d5b5c94a MA |
133 | ;; We put the timestamp there. |
134 | (puthash property (cons (current-time) value) hash) | |
00d6fd04 | 135 | (tramp-message vec 8 "%s %s %s" file property value) |
4bc3c53d MA |
136 | (when (>= tramp-verbose 10) |
137 | (let* ((var (intern (concat "tramp-cache-set-count-" property))) | |
138 | (val (or (ignore-errors (symbol-value var)) 0))) | |
139 | (set var (1+ val)))) | |
00d6fd04 MA |
140 | value)) |
141 | ||
0f34aa77 MA |
142 | ;;;###tramp-autoload |
143 | (defmacro with-file-property (vec file property &rest body) | |
144 | "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. | |
145 | FILE must be a local file name on a connection identified via VEC." | |
146 | `(if (file-name-absolute-p ,file) | |
147 | (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) | |
148 | (when (eq value 'undef) | |
149 | ;; We cannot pass @body as parameter to | |
150 | ;; `tramp-set-file-property' because it mangles our | |
151 | ;; debug messages. | |
152 | (setq value (progn ,@body)) | |
153 | (tramp-set-file-property ,vec ,file ,property value)) | |
154 | value) | |
155 | ,@body)) | |
156 | ||
03c1ad43 | 157 | ;;;###tramp-autoload |
0f34aa77 MA |
158 | (put 'with-file-property 'lisp-indent-function 3) |
159 | (put 'with-file-property 'edebug-form-spec t) | |
6139f995 MA |
160 | (tramp-compat-font-lock-add-keywords |
161 | 'emacs-lisp-mode '("\\<with-file-property\\>")) | |
0f34aa77 MA |
162 | |
163 | ;;;###tramp-autoload | |
00d6fd04 MA |
164 | (defun tramp-flush-file-property (vec file) |
165 | "Remove all properties of FILE in the cache context of VEC." | |
166 | ;; Unify localname. | |
167 | (setq vec (copy-sequence vec)) | |
87bdd2c7 | 168 | (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) |
00d6fd04 MA |
169 | (tramp-message vec 8 "%s" file) |
170 | (remhash vec tramp-cache-data)) | |
171 | ||
0f34aa77 | 172 | ;;;###tramp-autoload |
00d6fd04 MA |
173 | (defun tramp-flush-directory-property (vec directory) |
174 | "Remove all properties of DIRECTORY in the cache context of VEC. | |
175 | Remove also properties of all files in subdirectories." | |
87bdd2c7 MA |
176 | (let ((directory (tramp-run-real-handler |
177 | 'directory-file-name (list directory)))) | |
00d6fd04 MA |
178 | (tramp-message vec 8 "%s" directory) |
179 | (maphash | |
180 | '(lambda (key value) | |
5ec2288f | 181 | (when (and (stringp (tramp-file-name-localname key)) |
00d6fd04 MA |
182 | (string-match directory (tramp-file-name-localname key))) |
183 | (remhash key tramp-cache-data))) | |
184 | tramp-cache-data))) | |
185 | ||
00d6fd04 | 186 | ;; Reverting or killing a buffer should also flush file properties. |
a7580c1c MA |
187 | ;; They could have been changed outside Tramp. In eshell, "ls" would |
188 | ;; not show proper directory contents when a file has been copied or | |
189 | ;; deleted before. | |
00d6fd04 | 190 | (defun tramp-flush-file-function () |
06207091 | 191 | "Flush all Tramp cache properties from `buffer-file-name'." |
a7580c1c MA |
192 | (let ((bfn (if (stringp (buffer-file-name)) |
193 | (buffer-file-name) | |
194 | default-directory))) | |
195 | (when (tramp-tramp-file-p bfn) | |
0f34aa77 | 196 | (with-parsed-tramp-file-name bfn nil |
00d6fd04 MA |
197 | (tramp-flush-file-property v localname))))) |
198 | ||
199 | (add-hook 'before-revert-hook 'tramp-flush-file-function) | |
a7580c1c | 200 | (add-hook 'eshell-pre-command-hook 'tramp-flush-file-function) |
00d6fd04 MA |
201 | (add-hook 'kill-buffer-hook 'tramp-flush-file-function) |
202 | (add-hook 'tramp-cache-unload-hook | |
203 | '(lambda () | |
204 | (remove-hook 'before-revert-hook | |
205 | 'tramp-flush-file-function) | |
a7580c1c MA |
206 | (remove-hook 'eshell-pre-command-hook |
207 | 'tramp-flush-file-function) | |
00d6fd04 MA |
208 | (remove-hook 'kill-buffer-hook |
209 | 'tramp-flush-file-function))) | |
210 | ||
211 | ;;; -- Properties -- | |
212 | ||
0f34aa77 | 213 | ;;;###tramp-autoload |
00d6fd04 MA |
214 | (defun tramp-get-connection-property (key property default) |
215 | "Get the named PROPERTY for the connection. | |
216 | KEY identifies the connection, it is either a process or a vector. | |
217 | If the value is not set for the connection, returns DEFAULT." | |
218 | ;; Unify key by removing localname from vector. Work with a copy in | |
219 | ;; order to avoid side effects. | |
220 | (when (vectorp key) | |
221 | (setq key (copy-sequence key)) | |
222 | (aset key 3 nil)) | |
223 | (let* ((hash (gethash key tramp-cache-data)) | |
224 | (value (if (hash-table-p hash) | |
afae3a37 MA |
225 | (gethash property hash default) |
226 | default))) | |
00d6fd04 MA |
227 | (tramp-message key 7 "%s %s" property value) |
228 | value)) | |
229 | ||
0f34aa77 | 230 | ;;;###tramp-autoload |
00d6fd04 MA |
231 | (defun tramp-set-connection-property (key property value) |
232 | "Set the named PROPERTY of a connection to VALUE. | |
233 | KEY identifies the connection, it is either a process or a vector. | |
234 | PROPERTY is set persistent when KEY is a vector." | |
235 | ;; Unify key by removing localname from vector. Work with a copy in | |
236 | ;; order to avoid side effects. | |
237 | (when (vectorp key) | |
238 | (setq key (copy-sequence key)) | |
239 | (aset key 3 nil)) | |
240 | (let ((hash (or (gethash key tramp-cache-data) | |
241 | (puthash key (make-hash-table :test 'equal) | |
242 | tramp-cache-data)))) | |
243 | (puthash property value hash) | |
7c3404ec | 244 | (setq tramp-cache-data-changed t) |
03c1ad43 | 245 | (tramp-message key 7 "%s %s" property value) |
00d6fd04 MA |
246 | value)) |
247 | ||
0f34aa77 MA |
248 | ;;;###tramp-autoload |
249 | (defmacro with-connection-property (key property &rest body) | |
250 | "Check in Tramp for property PROPERTY, otherwise executes BODY and set." | |
251 | `(let ((value (tramp-get-connection-property ,key ,property 'undef))) | |
252 | (when (eq value 'undef) | |
253 | ;; We cannot pass ,@body as parameter to | |
254 | ;; `tramp-set-connection-property' because it mangles our debug | |
255 | ;; messages. | |
256 | (setq value (progn ,@body)) | |
257 | (tramp-set-connection-property ,key ,property value)) | |
258 | value)) | |
259 | ||
03c1ad43 | 260 | ;;;###tramp-autoload |
0f34aa77 MA |
261 | (put 'with-connection-property 'lisp-indent-function 2) |
262 | (put 'with-connection-property 'edebug-form-spec t) | |
6139f995 MA |
263 | (tramp-compat-font-lock-add-keywords |
264 | 'emacs-lisp-mode '("\\<with-connection-property\\>")) | |
0f34aa77 MA |
265 | |
266 | ;;;###tramp-autoload | |
1a0b96d3 | 267 | (defun tramp-flush-connection-property (key) |
00d6fd04 | 268 | "Remove all properties identified by KEY. |
1a0b96d3 | 269 | KEY identifies the connection, it is either a process or a vector." |
00d6fd04 MA |
270 | ;; Unify key by removing localname from vector. Work with a copy in |
271 | ;; order to avoid side effects. | |
272 | (when (vectorp key) | |
273 | (setq key (copy-sequence key)) | |
274 | (aset key 3 nil)) | |
e946faaf MA |
275 | (tramp-message |
276 | key 7 "%s %s" key | |
674a9263 MA |
277 | (let ((hash (gethash key tramp-cache-data)) |
278 | properties) | |
279 | (if (hash-table-p hash) | |
280 | (maphash | |
281 | (lambda (x y) (add-to-list 'properties x 'append)) | |
282 | (gethash key tramp-cache-data))) | |
e946faaf | 283 | properties)) |
7c3404ec | 284 | (setq tramp-cache-data-changed t) |
00d6fd04 MA |
285 | (remhash key tramp-cache-data)) |
286 | ||
0f34aa77 | 287 | ;;;###tramp-autoload |
726f0272 | 288 | (defun tramp-cache-print (table) |
b08104a0 | 289 | "Print hash table TABLE." |
726f0272 MA |
290 | (when (hash-table-p table) |
291 | (let (result) | |
292 | (maphash | |
293 | '(lambda (key value) | |
294 | (let ((tmp (format | |
295 | "(%s %s)" | |
296 | (if (processp key) | |
297 | (prin1-to-string (prin1-to-string key)) | |
298 | (prin1-to-string key)) | |
299 | (if (hash-table-p value) | |
300 | (tramp-cache-print value) | |
301 | (if (bufferp value) | |
302 | (prin1-to-string (prin1-to-string value)) | |
303 | (prin1-to-string value)))))) | |
304 | (setq result (if result (concat result " " tmp) tmp)))) | |
305 | table) | |
306 | result))) | |
307 | ||
0f34aa77 | 308 | ;;;###tramp-autoload |
b08104a0 MA |
309 | (defun tramp-list-connections () |
310 | "Return a list of all known connection vectors according to `tramp-cache'." | |
726f0272 MA |
311 | (let (result) |
312 | (maphash | |
313 | '(lambda (key value) | |
314 | (when (and (vectorp key) (null (aref key 3))) | |
315 | (add-to-list 'result key))) | |
316 | tramp-cache-data) | |
317 | result)) | |
318 | ||
00d6fd04 | 319 | (defun tramp-dump-connection-properties () |
b08104a0 | 320 | "Write persistent connection properties into file `tramp-persistency-file-name'." |
00d6fd04 | 321 | ;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed. |
03c1ad43 MA |
322 | (ignore-errors |
323 | (when (and (hash-table-p tramp-cache-data) | |
324 | (not (zerop (hash-table-count tramp-cache-data))) | |
325 | tramp-cache-data-changed | |
326 | (stringp tramp-persistency-file-name)) | |
327 | (let ((cache (copy-hash-table tramp-cache-data))) | |
328 | ;; Remove temporary data. | |
329 | (maphash | |
330 | '(lambda (key value) | |
331 | (if (and (vectorp key) (not (tramp-file-name-localname key))) | |
332 | (progn | |
333 | (remhash "process-name" value) | |
334 | (remhash "process-buffer" value) | |
335 | (remhash "first-password-request" value)) | |
336 | (remhash key cache))) | |
337 | cache) | |
338 | ;; Dump it. | |
339 | (with-temp-buffer | |
340 | (insert | |
341 | ";; -*- emacs-lisp -*-" | |
342 | ;; `time-stamp-string' might not exist in all (X)Emacs flavors. | |
343 | (condition-case nil | |
344 | (progn | |
345 | (format | |
346 | " <%s %s>\n" | |
347 | (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S") | |
348 | tramp-persistency-file-name)) | |
349 | (error "\n")) | |
350 | ";; Tramp connection history. Don't change this file.\n" | |
351 | ";; You can delete it, forcing Tramp to reapply the checks.\n\n" | |
352 | (with-output-to-string | |
353 | (pp (read (format "(%s)" (tramp-cache-print cache)))))) | |
354 | (write-region | |
355 | (point-min) (point-max) tramp-persistency-file-name)))))) | |
00d6fd04 MA |
356 | |
357 | (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties) | |
358 | (add-hook 'tramp-cache-unload-hook | |
359 | '(lambda () | |
360 | (remove-hook 'kill-emacs-hook | |
361 | 'tramp-dump-connection-properties))) | |
362 | ||
8fca3921 | 363 | ;;;###tramp-autoload |
00d6fd04 MA |
364 | (defun tramp-parse-connection-properties (method) |
365 | "Return a list of (user host) tuples allowed to access for METHOD. | |
366 | This function is added always in `tramp-get-completion-function' | |
06207091 | 367 | for all methods. Resulting data are derived from connection history." |
00d6fd04 MA |
368 | (let (res) |
369 | (maphash | |
370 | '(lambda (key value) | |
371 | (if (and (vectorp key) | |
372 | (string-equal method (tramp-file-name-method key)) | |
373 | (not (tramp-file-name-localname key))) | |
374 | (push (list (tramp-file-name-user key) | |
375 | (tramp-file-name-host key)) | |
376 | res))) | |
377 | tramp-cache-data) | |
378 | res)) | |
379 | ||
27e813fe | 380 | ;; Read persistent connection history. |
8a4438b6 MA |
381 | (when (and (stringp tramp-persistency-file-name) |
382 | (zerop (hash-table-count tramp-cache-data))) | |
00d6fd04 MA |
383 | (condition-case err |
384 | (with-temp-buffer | |
385 | (insert-file-contents tramp-persistency-file-name) | |
386 | (let ((list (read (current-buffer))) | |
387 | element key item) | |
388 | (while (setq element (pop list)) | |
389 | (setq key (pop element)) | |
390 | (while (setq item (pop element)) | |
7c3404ec MA |
391 | (tramp-set-connection-property key (pop item) (car item))))) |
392 | (setq tramp-cache-data-changed nil)) | |
00d6fd04 MA |
393 | (file-error |
394 | ;; Most likely because the file doesn't exist yet. No message. | |
395 | (clrhash tramp-cache-data)) | |
396 | (error | |
397 | ;; File is corrupted. | |
8a4438b6 MA |
398 | (message "Tramp persistency file '%s' is corrupted: %s" |
399 | tramp-persistency-file-name (error-message-string err)) | |
00d6fd04 MA |
400 | (clrhash tramp-cache-data)))) |
401 | ||
0f34aa77 MA |
402 | (add-hook 'tramp-unload-hook |
403 | (lambda () | |
404 | (unload-feature 'tramp-cache 'force))) | |
405 | ||
00d6fd04 MA |
406 | (provide 'tramp-cache) |
407 | ||
408 | ;;; tramp-cache.el ends here |