X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e946faaf51d3b5a1f6f9bc061546dd195c132a93..73b0cd50031a714347109169ceb8bacae338612a:/lisp/net/tramp-cache.el?ds=sidebyside diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 1bb29d1766..c893ce797e 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -1,11 +1,11 @@ ;;; tramp-cache.el --- file information caching for Tramp -;; Copyright (C) 2000, 2005, 2006, 2007, 2008, -;; 2009 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2005-2011 Free Software Foundation, Inc. ;; Author: Daniel Pittman ;; Michael Albinus ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -49,37 +49,20 @@ ;;; 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 'tramp-run-real-handler "tramp") - (autoload 'tramp-time-less-p "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.") -(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))) @@ -102,6 +85,7 @@ time.") (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." @@ -114,21 +98,28 @@ Returns DEFAULT if not set." (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 (defun tramp-set-file-property (vec file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of VEC. Returns VALUE." @@ -141,8 +132,34 @@ Returns VALUE." ;; 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 +(defmacro with-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +;;;###tramp-autoload +(put 'with-file-property 'lisp-indent-function 3) +(put 'with-file-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\")) + +;;;###tramp-autoload (defun tramp-flush-file-property (vec file) "Remove all properties of FILE in the cache context of VEC." ;; Unify localname. @@ -151,6 +168,7 @@ Returns VALUE." (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." @@ -174,8 +192,7 @@ Remove also properties of all files in subdirectories." (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) @@ -192,6 +209,7 @@ Remove also properties of all files in subdirectories." ;;; -- 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. @@ -208,6 +226,7 @@ If the value is not set for the connection, returns 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. @@ -222,14 +241,28 @@ PROPERTY is set persistent when KEY is a vector." tramp-cache-data)))) (puthash property value hash) (setq tramp-cache-data-changed t) - ;; 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)) + (tramp-message key 7 "%s %s" property value) + value)) + +;;;###tramp-autoload +(defmacro with-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) value)) +;;;###tramp-autoload +(put 'with-connection-property 'lisp-indent-function 2) +(put 'with-connection-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\")) + +;;;###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." @@ -240,14 +273,17 @@ KEY identifies the connection, it is either a process or a vector." (aset key 3 nil)) (tramp-message key 7 "%s %s" key - (let (properties) - (maphash - (lambda (x y) (add-to-list 'properties x 'append)) - (gethash key tramp-cache-data)) + (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) @@ -268,6 +304,7 @@ KEY identifies the connection, it is either a process or a vector." table) result))) +;;;###tramp-autoload (defun tramp-list-connections () "Return a list of all known connection vectors according to `tramp-cache'." (let (result) @@ -281,40 +318,40 @@ KEY identifies the connection, it is either a process or a vector." (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))) - tramp-cache-data-changed - (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))) + (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))) + ;; 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 "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)))))) (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties) (add-hook 'tramp-cache-unload-hook @@ -322,6 +359,7 @@ KEY identifies the connection, it is either a process or a vector." (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' @@ -360,7 +398,10 @@ for all methods. Resulting data are derived from connection history." 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