;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005, 2006, 2007, 2008, 2009,
-;; 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2012 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; - localname is NIL. This 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
+;; 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
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
-(defvar tramp-cache-inhibit-cache nil
- "Inhibit cache read access, when `t'.
-`nil' means to accept cache entries unconditionally. If the
-value is a timestamp (as returned by `current-time'), cache
-entries are not used when they have been written before this
-time.")
-
(defcustom tramp-persistency-file-name
(cond
;; GNU Emacs.
+ ((and (fboundp 'locate-user-emacs-file))
+ (expand-file-name (tramp-compat-funcall 'locate-user-emacs-file "tramp")))
((and (boundp 'user-emacs-directory)
(stringp (symbol-value 'user-emacs-directory))
(file-directory-p (symbol-value 'user-emacs-directory)))
(value (when (hash-table-p hash) (gethash property hash))))
(if
;; We take the value only if there is any, and
- ;; `tramp-cache-inhibit-cache' indicates that it is still
+ ;; `remote-file-name-inhibit-cache' indicates that it is still
;; valid. Otherwise, DEFAULT is set.
(and (consp value)
- (or (null tramp-cache-inhibit-cache)
- (and (consp tramp-cache-inhibit-cache)
+ (or (null remote-file-name-inhibit-cache)
+ (and (integerp remote-file-name-inhibit-cache)
+ (<=
+ (tramp-time-diff (current-time) (car value))
+ remote-file-name-inhibit-cache))
+ (and (consp remote-file-name-inhibit-cache)
(tramp-time-less-p
- tramp-cache-inhibit-cache (car value)))))
+ remote-file-name-inhibit-cache (car value)))))
(setq value (cdr value))
(setq value default))
- (if (consp tramp-cache-inhibit-cache)
- (tramp-message vec 1 "%s %s %s" file property value))
(tramp-message vec 8 "%s %s %s" file property value)
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-get-count-" property)))
+ (val (or (ignore-errors (symbol-value var)) 0)))
+ (set var (1+ val))))
value))
;;;###tramp-autoload
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(tramp-message vec 8 "%s %s %s" file property value)
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-set-count-" property)))
+ (val (or (ignore-errors (symbol-value var)) 0)))
+ (set var (1+ val))))
value))
;;;###tramp-autoload
;;;###tramp-autoload
(defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC."
+ ;; Remove file property of symlinks.
+ (let ((truename (tramp-get-file-property vec file "file-truename" nil)))
+ (when (and (stringp truename)
+ (not (string-equal file truename)))
+ (tramp-flush-file-property vec truename)))
;; Unify localname.
(setq vec (copy-sequence vec))
(aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
'directory-file-name (list directory))))
(tramp-message vec 8 "%s" directory)
(maphash
- '(lambda (key value)
- (when (and (stringp (tramp-file-name-localname key))
- (string-match directory (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
+ (lambda (key value)
+ (when (and (stringp (tramp-file-name-localname key))
+ (string-match directory (tramp-file-name-localname key)))
+ (remhash key tramp-cache-data)))
tramp-cache-data)))
;; Reverting or killing a buffer should also flush file properties.
(add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
(add-hook 'tramp-cache-unload-hook
- '(lambda ()
- (remove-hook 'before-revert-hook
- 'tramp-flush-file-function)
- (remove-hook 'eshell-pre-command-hook
- 'tramp-flush-file-function)
- (remove-hook 'kill-buffer-hook
- 'tramp-flush-file-function)))
+ (lambda ()
+ (remove-hook 'before-revert-hook
+ 'tramp-flush-file-function)
+ (remove-hook 'eshell-pre-command-hook
+ 'tramp-flush-file-function)
+ (remove-hook 'kill-buffer-hook
+ 'tramp-flush-file-function)))
;;; -- Properties --
(aset key 3 nil))
(let ((hash (or (gethash key tramp-cache-data)
(puthash key (make-hash-table :test 'equal)
- tramp-cache-data))))
+ tramp-cache-data))))
(puthash property value hash)
(setq tramp-cache-data-changed t)
(tramp-message key 7 "%s %s" property value)
(when (hash-table-p table)
(let (result)
(maphash
- '(lambda (key value)
- (let ((tmp (format
- "(%s %s)"
- (if (processp key)
- (prin1-to-string (prin1-to-string key))
- (prin1-to-string key))
- (if (hash-table-p value)
- (tramp-cache-print value)
- (if (bufferp value)
- (prin1-to-string (prin1-to-string value))
- (prin1-to-string value))))))
- (setq result (if result (concat result " " tmp) tmp))))
+ (lambda (key value)
+ (let ((tmp (format
+ "(%s %s)"
+ (if (processp key)
+ (prin1-to-string (prin1-to-string key))
+ (prin1-to-string key))
+ (if (hash-table-p value)
+ (tramp-cache-print value)
+ (if (bufferp value)
+ (prin1-to-string (prin1-to-string value))
+ (prin1-to-string value))))))
+ (setq result (if result (concat result " " tmp) tmp))))
table)
result)))
"Return a list of all known connection vectors according to `tramp-cache'."
(let (result)
(maphash
- '(lambda (key value)
- (when (and (vectorp key) (null (aref key 3)))
- (add-to-list 'result key)))
+ (lambda (key value)
+ (when (and (vectorp key) (null (aref key 3)))
+ (add-to-list 'result key)))
tramp-cache-data)
result))
(not (zerop (hash-table-count tramp-cache-data)))
tramp-cache-data-changed
(stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data)))
- ;; Remove temporary data.
+ (let ((cache (copy-hash-table tramp-cache-data))
+ print-length print-level)
+ ;; Remove temporary data. If there is the key "login-as", we
+ ;; don't save either, because all other properties might
+ ;; depend on the login name, and we want to give the
+ ;; possibility to use another login name later on.
(maphash
- '(lambda (key value)
- (if (and (vectorp key) (not (tramp-file-name-localname key)))
- (progn
- (remhash "process-name" value)
- (remhash "process-buffer" value)
- (remhash "first-password-request" value))
- (remhash key cache)))
+ (lambda (key value)
+ (if (and (vectorp key)
+ (not (tramp-file-name-localname key))
+ (not (gethash "login-as" value)))
+ (progn
+ (remhash "process-name" value)
+ (remhash "process-buffer" value)
+ (remhash "first-password-request" value))
+ (remhash key cache)))
cache)
;; Dump it.
(with-temp-buffer
(write-region
(point-min) (point-max) tramp-persistency-file-name))))))
-(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
+(unless noninteractive
+ (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
(add-hook 'tramp-cache-unload-hook
- '(lambda ()
- (remove-hook 'kill-emacs-hook
- 'tramp-dump-connection-properties)))
+ (lambda ()
+ (remove-hook 'kill-emacs-hook
+ 'tramp-dump-connection-properties)))
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
for all methods. Resulting data are derived from connection history."
(let (res)
(maphash
- '(lambda (key value)
- (if (and (vectorp 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)))
+ (lambda (key value)
+ (if (and (vectorp 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))
;; Read persistent connection history.
(when (and (stringp tramp-persistency-file-name)
- (zerop (hash-table-count tramp-cache-data)))
+ (zerop (hash-table-count 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.
+ (or (and (boundp 'init-file-user) (symbol-value 'init-file-user))
+ (and (boundp 'site-run-file) (symbol-value 'site-run-file))))
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
(provide 'tramp-cache)
-;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
;;; tramp-cache.el ends here