(require 'tramp-compat)
(require 'tramp-loaddefs)
(require 'time-stamp)
(defvar tramp-cache-data (make-hash-table :test #'equal)
"Hash table for remote files properties.")
(defcustom tramp-connection-properties nil
"List of static connection properties.
Every entry has the form (REGEXP PROPERTY VALUE). The regexp
matches remote file names. It can be nil. PROPERTY is a string,
and VALUE the corresponding value. They are used, if there is no
matching entry for PROPERTY in `tramp-cache-data'. For more
details see the info pages."
:group 'tramp
:version "24.4"
:type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
(choice :tag " Property" string)
(choice :tag " Value" sexp))))
(defcustom tramp-persistency-file-name (locate-user-emacs-file "tramp")
"File which keeps connection history for Tramp connections."
:group 'tramp
:type 'file)
(defconst tramp-cache-version (make-tramp-file-name :method "cache")
"Virtual connection vector for Tramp version.")
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
(defconst tramp-cache-undefined 'undef
"The symbol marking undefined hash keys and values.")
(defun tramp-get-hash-table (key)
"Return the hash table for KEY.
If it doesn't exist yet, it is created and initialized with
matching entries of `tramp-connection-properties'.
If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(unless (eq key tramp-cache-undefined)
(or (gethash key tramp-cache-data)
(let ((hash
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
(when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties)
(when (string-match-p
(or (nth 0 elt) "")
(tramp-make-tramp-file-name key 'noloc))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
hash))))
(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) default
(let* ((hash (tramp-get-hash-table key))
(cached (and (hash-table-p hash) (gethash property hash)))
(cached-at
(and (consp cached) (format-time-string "%T" (car cached))))
(value default)
cache-used)
(when (and (consp cached)
(or (null remote-file-name-inhibit-cache)
(and (integerp remote-file-name-inhibit-cache)
(time-less-p
nil
(time-add (car cached) remote-file-name-inhibit-cache)))
(and (consp remote-file-name-inhibit-cache)
(time-less-p
remote-file-name-inhibit-cache (car cached)))))
(setq value (cdr cached)
cache-used t))
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
(tramp-file-name-localname key)
property value remote-file-name-inhibit-cache cache-used cached-at)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
(val (or (and (boundp var) (numberp (symbol-value var))
(symbol-value var))
0)))
(set var (1+ val))))
value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(dolist (var (all-completions "tramp-cache-get-count-" obarray))
(unintern var obarray))))
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) value
(let ((hash (tramp-get-hash-table key)))
(puthash property (cons (current-time) value) hash)
(tramp-message
key 8 "%s %s %s" (tramp-file-name-localname key) property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
(val (or (and (boundp var) (numberp (symbol-value var))
(symbol-value var))
0)))
(set var (1+ val))))
value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(dolist (var (all-completions "tramp-cache-set-count-" obarray))
(unintern var obarray))))
(defun tramp-file-property-p (key file property)
"Check whether PROPERTY of FILE is defined in the cache context of KEY."
(and
(not (eq key tramp-cache-undefined))
(not (eq (tramp-get-file-property key file property tramp-cache-undefined)
tramp-cache-undefined))))
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(remhash property (tramp-get-hash-table key))
(tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
(when (>= tramp-verbose 10)
(let ((var (intern (concat "tramp-cache-set-count-" property))))
(makunbound var)))))
(defun tramp-flush-file-upper-properties (key file)
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
(when (string-match-p
(rx
bos (| "directory-" "file-name-all-completions"
"file-entries"))
property)
(tramp-flush-file-property key file property)))))))
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let ((truename (tramp-get-file-property key file "file-truename")))
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(tramp-message key 8 "%s" (tramp-file-name-localname key))
(remhash key tramp-cache-data)
(when (and (stringp truename)
(not (string-equal file (directory-file-name truename))))
(tramp-flush-file-properties key truename))
(tramp-flush-file-upper-properties key file))))
(defun tramp-flush-directory-properties (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
(let* ((directory
(directory-file-name (tramp-compat-file-name-unquote directory)))
(truename (tramp-get-file-property key directory "file-truename")))
(tramp-message key 8 "%s" directory)
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
(stringp (tramp-file-name-localname key))
(tramp-compat-string-search
directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
(tramp-flush-directory-properties key truename))
(tramp-flush-file-upper-properties key directory)))
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from `buffer-file-name'.
This is suppressed for temporary buffers."
(save-match-data
(unless (or (null (buffer-name))
(string-match-p (rx bos (| blank "*")) (buffer-name)))
(let ((bfn (if (stringp (buffer-file-name))
(buffer-file-name)
default-directory))
(tramp-verbose 0))
(when (tramp-tramp-file-p bfn)
(tramp-flush-file-properties
(tramp-dissect-file-name bfn) (tramp-file-local-name bfn)))))))
(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)))
(defmacro with-tramp-file-property (key 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 KEY."
(declare (indent 3) (debug t))
`(let ((value (tramp-get-file-property
,key ,file ,property tramp-cache-undefined)))
(when (eq value tramp-cache-undefined)
(setq value (progn ,@body))
(tramp-set-file-property ,key ,file ,property value))
value))
(defmacro with-tramp-saved-file-property (key file property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY.
Preserve timestamps."
(declare (indent 3) (debug t))
`(progn
(setq ,key (tramp-file-name-unify ,key ,file))
(let* ((hash (tramp-get-hash-table ,key))
(cached (and (hash-table-p hash) (gethash ,property hash))))
(unwind-protect (progn ,@body)
(setq hash (tramp-get-hash-table ,key))
(if (consp cached)
(puthash ,property cached hash)
(remhash ,property hash))))))
(defmacro with-tramp-saved-file-properties (key file properties &rest body)
"Save PROPERTIES, run BODY, reset PROPERTIES.
PROPERTIES is a list of file properties (strings).
Preserve timestamps."
(declare (indent 3) (debug t))
`(progn
(setq ,key (tramp-file-name-unify ,key ,file))
(let* ((hash (tramp-get-hash-table ,key))
(values
(and (hash-table-p hash)
(mapcar
(lambda (property) (cons property (gethash property hash)))
,properties))))
(unwind-protect (progn ,@body)
(setq hash (tramp-get-hash-table ,key))
(dolist (value values)
(if (consp (cdr value))
(puthash (car value) (cdr value) hash)
(remhash (car value) hash)))))))
(defun tramp-get-connection-property (key property &optional default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine.
If KEY is `tramp-cache-undefined', or if the value is not set for
the connection, return DEFAULT."
(setq key (tramp-file-name-unify key))
(let* ((hash (tramp-get-hash-table key))
(cached (if (hash-table-p hash)
(gethash property hash tramp-cache-undefined)
tramp-cache-undefined))
(value default)
cache-used)
(when (and (not (eq cached tramp-cache-undefined))
(not (and (processp key) (not (process-live-p key)))))
(setq value cached
cache-used t))
(tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
value))
(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
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine. If KEY
is `tramp-cache-undefined', nothing is set.
PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
Return VALUE."
(setq key (tramp-file-name-unify key))
(when-let ((hash (tramp-get-hash-table key)))
(puthash property value hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s %s" property value)
value)
(defun tramp-connection-property-p (key property)
"Check whether named PROPERTY of a connection is defined.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine."
(not (eq (tramp-get-connection-property key property tramp-cache-undefined)
tramp-cache-undefined)))
(defun tramp-flush-connection-property (key property)
"Remove the named PROPERTY of a connection identified by KEY.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine.
PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
(setq key (tramp-file-name-unify key))
(when-let ((hash (tramp-get-hash-table key)))
(remhash property hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s" property))
(defun tramp-flush-connection-properties (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine."
(setq key (tramp-file-name-unify key))
(tramp-message
key 7 "%s %s" key
(when-let ((hash (gethash key tramp-cache-data)))
(hash-table-keys hash)))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
(defmacro with-tramp-connection-property (key property &rest body)
"Check in Tramp for property PROPERTY, otherwise execute BODY and set."
(declare (indent 2) (debug t))
`(let ((value (tramp-get-connection-property
,key ,property tramp-cache-undefined)))
(when (eq value tramp-cache-undefined)
(setq value (progn ,@body))
(tramp-set-connection-property ,key ,property value))
value))
(defmacro with-tramp-saved-connection-property (key property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY."
(declare (indent 2) (debug t))
`(progn
(setq ,key (tramp-file-name-unify ,key))
(let* ((hash (tramp-get-hash-table ,key))
(cached (and (hash-table-p hash)
(gethash ,property hash tramp-cache-undefined))))
(unwind-protect (progn ,@body)
(setq hash (tramp-get-hash-table ,key))
(if (not (eq cached tramp-cache-undefined))
(puthash ,property cached hash)
(remhash ,property hash))))))
(defmacro with-tramp-saved-connection-properties (key properties &rest body)
"Save PROPERTIES, run BODY, reset PROPERTIES.
PROPERTIES is a list of file properties (strings)."
(declare (indent 2) (debug t))
`(progn
(setq ,key (tramp-file-name-unify ,key))
(let* ((hash (tramp-get-hash-table ,key))
(values
(mapcar
(lambda (property)
(cons property (gethash property hash tramp-cache-undefined)))
,properties)))
(unwind-protect (progn ,@body)
(setq hash (tramp-get-hash-table ,key))
(dolist (value values)
(if (not (eq (cdr value) tramp-cache-undefined))
(puthash (car value) (cdr value) hash)
(remhash (car value) hash)))))))
(defun tramp-cache-print (table)
"Print hash table TABLE."
(when (hash-table-p table)
(let (result)
(maphash
(lambda (key value)
(when (tramp-file-name-p key)
(dolist
(slot
(mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
(when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
(setf (cl-struct-slot-value 'tramp-file-name slot key)
(substring-no-properties
(cl-struct-slot-value 'tramp-file-name slot key))))))
(when (stringp key)
(setq key (substring-no-properties key)))
(when (stringp value)
(setq value (substring-no-properties 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)))
(defun tramp-list-connections ()
"Return all active `tramp-file-name' structs according to `tramp-cache-data'."
(let ((tramp-verbose 0))
(delq nil (mapcar
(lambda (key)
(and (tramp-file-name-p key)
(null (tramp-file-name-localname key))
(tramp-connection-property-p key "process-buffer")
key))
(hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
"Write persistent connection properties into file \
`tramp-persistency-file-name'."
(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)
(maphash
(lambda (key value)
(if (and (tramp-file-name-p key) (hash-table-p value)
(not (string-equal
(tramp-file-name-method key) tramp-archive-method))
(not (tramp-file-name-localname key))
(not (gethash "login-as" value))
(not (gethash "started" value)))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash key cache)))
cache)
(with-temp-file tramp-persistency-file-name
(insert
(format ";; -*- emacs-lisp -*- <%s %s>\n"
(time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
tramp-persistency-file-name)
";; Tramp connection history. Don't change this file.\n"
";; Run `M-x tramp-cleanup-all-connections' instead.\n\n"
(with-output-to-string
(pp (read (format "(%s)" (tramp-cache-print cache)))))))))))
(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)))
(defcustom tramp-completion-use-cache t
"Whether to use the Tramp cache for completion of user and host names.
Set it to nil if there are invalid entries in the cache, for
example if the host configuration changes often, or if you plug
your laptop to different networks frequently."
:group 'tramp
:version "29.1"
:type 'boolean)
(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."
(and tramp-completion-use-cache
(mapcar
(lambda (key)
(and (tramp-file-name-p key)
(string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname key))
(list (tramp-file-name-user key)
(tramp-file-name-host key))))
(hash-table-keys tramp-cache-data))))
(defvar tramp-cache-read-persistent-data (or init-file-user site-run-file)
"Whether to read persistent data at startup time.")
(when (and (stringp tramp-persistency-file-name)
(zerop (hash-table-count tramp-cache-data))
tramp-cache-read-persistent-data)
(condition-case err
(with-temp-buffer
(insert-file-contents-literally tramp-persistency-file-name)
(let ((list (read (current-buffer)))
(tramp-verbose 0)
element key item)
(while (setq element (pop list))
(setq key (pop element))
(when (tramp-file-name-p key)
(while (setq item (pop element))
(unless (tramp-connection-property-p key (car item))
(tramp-set-connection-property key (pop item) (car item)))))))
(unless (string-equal
(tramp-get-connection-property
tramp-cache-version "tramp-version" "")
tramp-version)
(signal 'file-error nil))
(setq tramp-cache-data-changed nil))
(file-error
(clrhash tramp-cache-data))
(error
(message "Tramp persistency file `%s' is corrupted: %s"
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
(tramp-set-connection-property tramp-cache-version "tramp-version" tramp-version)
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-cache 'force)))
(provide 'tramp-cache)