;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2013 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
;; - 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
;;; Code:
-;; Pacify byte-compiler.
-(eval-when-compile
- (require 'cl)
- (autoload 'tramp-message "tramp")
- (autoload 'tramp-tramp-file-p "tramp")
- ;; We cannot autoload macro `with-parsed-tramp-file-name', it
- ;; results in problems of byte-compiled code.
- (autoload 'tramp-dissect-file-name "tramp")
- (autoload 'tramp-file-name-method "tramp")
- (autoload 'tramp-file-name-user "tramp")
- (autoload 'tramp-file-name-host "tramp")
- (autoload 'tramp-file-name-localname "tramp")
- (autoload 'time-stamp-string "time-stamp"))
+(require 'tramp)
+(autoload 'time-stamp-string "time-stamp")
;;; -- Cache --
+;;;###tramp-autoload
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
(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)))
:group 'tramp
:type 'file)
+(defvar tramp-cache-data-changed nil
+ "Whether persistent cache data have been changed.")
+
+;;;###tramp-autoload
(defun tramp-get-file-property (vec file property default)
"Get the PROPERTY of FILE from the cache context of VEC.
Returns DEFAULT if not set."
(let* ((hash (or (gethash vec tramp-cache-data)
(puthash vec (make-hash-table :test 'equal)
tramp-cache-data)))
- (value (if (hash-table-p hash)
- (gethash property hash default)
- default)))
+ (value (when (hash-table-p hash) (gethash property hash))))
+ (if
+ ;; 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 value)
+ (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
+ remote-file-name-inhibit-cache (car value)))))
+ (setq value (cdr value))
+ (setq value default))
+
(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
(defun tramp-set-file-property (vec file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
Returns VALUE."
(let ((hash (or (gethash vec tramp-cache-data)
(puthash vec (make-hash-table :test 'equal)
tramp-cache-data))))
- (puthash property value hash)
+ ;; 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
(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)))
(tramp-message vec 8 "%s" file)
(remhash vec tramp-cache-data))
+;;;###tramp-autoload
(defun tramp-flush-directory-property (vec directory)
"Remove all properties of DIRECTORY in the cache context of VEC.
Remove also properties of all files in subdirectories."
'directory-file-name (list directory))))
(tramp-message vec 8 "%s" directory)
(maphash
- '(lambda (key value)
- (when (and (stringp 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.
(buffer-file-name)
default-directory)))
(when (tramp-tramp-file-p bfn)
- (let* ((v (tramp-dissect-file-name bfn))
- (localname (tramp-file-name-localname v)))
+ (with-parsed-tramp-file-name bfn nil
(tramp-flush-file-property v localname)))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
(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 --
+;;;###tramp-autoload
(defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a vector.
(aset key 3 nil))
(let* ((hash (gethash key tramp-cache-data))
(value (if (hash-table-p hash)
- (gethash property hash default)
- default)))
+ (gethash property hash default)
+ default)))
(tramp-message key 7 "%s %s" property value)
value))
+;;;###tramp-autoload
(defun tramp-set-connection-property (key property value)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a vector.
(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)
- ;; This function is called also during initialization of
- ;; tramp-cache.el. `tramp-message´ is not defined yet at this
- ;; time, so we ignore the corresponding error.
- (condition-case nil
- (tramp-message key 7 "%s %s" property value)
- (error nil))
+ (setq tramp-cache-data-changed t)
+ (tramp-message key 7 "%s %s" property value)
value))
+;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
+ (tramp-message
+ key 7 "%s %s" key
+ (let ((hash (gethash key tramp-cache-data))
+ properties)
+ (if (hash-table-p hash)
+ (maphash
+ (lambda (x y) (add-to-list 'properties x 'append))
+ (gethash key tramp-cache-data)))
+ properties))
+ (setq tramp-cache-data-changed t)
(remhash key tramp-cache-data))
+;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
(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)))
+;;;###tramp-autoload
(defun tramp-list-connections ()
"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))
(defun tramp-dump-connection-properties ()
"Write persistent connection properties into file `tramp-persistency-file-name'."
;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
- (condition-case nil
- (when (and (hash-table-p tramp-cache-data)
- (not (zerop (hash-table-count tramp-cache-data)))
- (stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data)))
- ;; Remove temporary data.
- (maphash
- '(lambda (key value)
- (if (and (vectorp key) (not (tramp-file-name-localname key)))
- (progn
- (remhash "process-name" value)
- (remhash "process-buffer" value))
- (remhash key cache)))
- cache)
- ;; Dump it.
- (with-temp-buffer
- (insert
- ";; -*- emacs-lisp -*-"
- ;; `time-stamp-string' might not exist in all (X)Emacs flavors.
- (condition-case nil
- (progn
- (format
- " <%s %s>\n"
- (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
- tramp-persistency-file-name))
- (error "\n"))
- ";; Tramp connection history. Don't change this file.\n"
- ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
- (with-output-to-string
- (pp (read (format "(%s)" (tramp-cache-print cache))))))
- (write-region
- (point-min) (point-max) tramp-persistency-file-name))))
- (error nil)))
-
-(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)
+ (ignore-errors
+ (when (and (hash-table-p tramp-cache-data)
+ (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))
+ 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))
+ (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
+ (insert
+ ";; -*- emacs-lisp -*-"
+ ;; `time-stamp-string' might not exist in all (X)Emacs flavors.
+ (condition-case nil
+ (progn
+ (format
+ " <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name))
+ (error "\n"))
+ ";; Tramp connection history. Don't change this file.\n"
+ ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
+ (with-output-to-string
+ (pp (read (format "(%s)" (tramp-cache-print cache))))))
+ (write-region
+ (point-min) (point-max) tramp-persistency-file-name))))))
+
+(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)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
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)
(while (setq element (pop list))
(setq key (pop element))
(while (setq item (pop element))
- (tramp-set-connection-property key (pop item) (car item))))))
+ (tramp-set-connection-property key (pop item) (car item)))))
+ (setq tramp-cache-data-changed nil))
(file-error
;; Most likely because the file doesn't exist yet. No message.
(clrhash tramp-cache-data))
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-cache 'force)))
+
(provide 'tramp-cache)
-;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
;;; tramp-cache.el ends here