procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Reorganize Tramp

Browse source 
* lisp/net/tramp-adb.el (tramp-adb-handle-write-region): Handle special
case that START is "".
(tramp-adb-handle-set-file-modes)
(tramp-adb-handle-set-file-times):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.
(tramp-adb-handle-make-process):
Use `with-tramp-saved-connection-properties'.

* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
Use `tramp-archive-handle-file-exists-p'.
(tramp-archive-handle-file-exists-p): New defun.
(tramp-archive-file-name-handler): Add ;;;###tramp-autoload cookie.

* lisp/net/tramp-cache.el (tramp-compat, tramp-loaddefs)
(time-stamp): Require.
(tramp-get-file-property, tramp-set-file-property)
(tramp-flush-file-property, tramp-flush-file-upper-properties)
(tramp-flush-file-properties): Use `tramp-file-name-unify'.  Adapt
message.
(tramp-flush-directory-properties): Simplify.
(tramp-flush-file-function): Add ;;;###tramp-autoload cookie.
Don't use `with-parsed-tramp-file-name', it isn't exposed.
(with-tramp-file-property, with-tramp-connection-property)
(with-tramp-saved-connection-property): Macros moved from tramp.el.
(with-tramp-saved-file-property)
(with-tramp-saved-file-properties)
(with-tramp-saved-connection-properties): New defmacros.

* lisp/net/tramp-cmds.el (tramp-cleanup-connection): Flush "/".

* lisp/net/tramp-crypt.el (tramp-crypt-handle-set-file-modes)
(tramp-crypt-handle-set-file-times)
(tramp-crypt-handle-set-file-uid-gid):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.

* lisp/net/tramp-ftp.el (tramp-archive-file-name-handler):
Don't declare.

* lisp/net/tramp-gvfs.el (tramp-gvfs-info): New defun.
(tramp-gvfs-do-copy-or-rename-file)
(tramp-gvfs-handle-delete-directory)
(tramp-gvfs-handle-delete-file, tramp-gvfs-get-root-attributes)
(tramp-gvfs-handle-make-directory): Use it.
(tramp-gvfs-handle-set-file-modes)
(tramp-gvfs-handle-set-file-times)
(tramp-gvfs-handle-set-file-uid-gid):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.

* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link):
Expand TARGET when flushing file properties.
(tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times)
(tramp-sh-handle-set-file-uid-gid):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.
(tramp-sh-handle-file-name-all-completions): Protect, when
connection is not established yet.
(tramp-do-copy-or-rename-file-directly): Flush file properties of
NEWNAME when constructing a new remote file name.
(tramp-do-copy-or-rename-file-out-of-band, tramp-sh-handle-make-process):
Use `with-tramp-saved-connection-properties'.
(tramp-sh-handle-delete-file): Flush file properties only after
deleting, otherwise we get a false alarm.
(tramp-sh-handle-process-file): Flush "/".
(tramp-sh-handle-write-region): Handle special case that START is "".

* lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
(tramp-smb-handle-file-acl, tramp-smb-handle-process-file)
(tramp-smb-handle-set-file-acl)
(tramp-smb-handle-start-file-process):
Use `with-tramp-saved-connection-properties'.
(tramp-smb-remote-acl-p): New defun.
(tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl): Use it.
(tramp-smb-handle-set-file-modes):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.
(tramp-smb-handle-process-file, tramp-smb-maybe-open-connection):
Flush "/".

* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): Flush "/".
(tramp-sshfs-handle-set-file-modes)
(tramp-sshfs-handle-set-file-times):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-modes)
(tramp-sudoedit-handle-set-file-times)
(tramp-sudoedit-handle-set-file-uid-gid):
Use `tramp-skeleton-set-file-modes-times-uid-gid'.

* lisp/net/tramp.el (tramp-archive-file-name-handler): Don't declare.
(tramp-verbose, tramp-file-name-unify, tramp-tramp-file-p)
(tramp-file-local-name, tramp-dissect-file-name)
(tramp-make-tramp-file-name, tramp-get-connection-buffer)
(tramp-get-buffer-string, tramp-debug-message)
(tramp-inhibit-progress-reporter, tramp-message):
Add ;;;###tramp-autoload cookie.
(tramp-file-name): Expose defstruct to tramp-loaddefs.el
(tramp-file-name-unify): New optional arg FILE.
(tramp-get-default-directory, tramp-get-buffer-string)
(tramp-message, tramp-backtrace, tramp-error-with-buffer)
(tramp-with-demoted-errors, tramp-barf-if-file-missing)
(tramp-skeleton-copy-directory, tramp-skeleton-delete-directory)
(tramp-skeleton-directory-files)
(tramp-skeleton-directory-files-and-attributes)
(tramp-skeleton-file-local-copy, tramp-skeleton-write-region):
Remove `tramp-suppress-trace' property, it isn't needed for
defmacros and defsubsts.
(with-tramp-file-property, with-tramp-connection-property)
(with-tramp-saved-connection-property): Move macros to tramp-cache.el.
(tramp-skeleton-directory-files-and-attributes): Fix implementation.
(tramp-skeleton-file-local-copy): Fix docstring.
(tramp-skeleton-set-file-modes-times-uid-gid): New defmacro.
(tramp-skeleton-write-region): Set "file-exists-p" cache property.
(tramp-handle-file-exists-p): Use cached value.
(tramp-process-sentinel): Flush "/".
(tramp-make-tramp-temp-file): Suppress also `tramp-smb-remote-acl-p'.
(tramp-get-connection-buffer):

* test/lisp/net/tramp-tests.el (tramp-test10-write-region)
(tramp-test20-file-modes, tramp-test22-file-times): Extend tests.
This commit is contained in:
Michael Albinus 2022-08-03 17:30:09 +02:00
parent 3ec6b806b2
commit 21afc26d4d
13 changed files with 884 additions and 779 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

234
lisp/net/tramp-adb.el
View file

@ -517,34 +517,39 @@ Emacs dired can't find files."
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
(let (create-lockfiles)
(write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile))))))
;; If `start' is the empty string, it is likely that a temporary
;; file is created. Do it directly.
(if (and (stringp start) (string-empty-p start))
(tramp-adb-send-command-and-check
v (format "echo -n \"\">%s" (tramp-shell-quote-argument localname)))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
(let (create-lockfiles)
(write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(unless (tramp-adb-execute-adb-command
v "push" tmpfile
(tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; ADB shell does not support "chmod -h".
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
;; ADB shell does not support "chmod -h".
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-adb-send-command-and-check
v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
@ -827,7 +832,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
(tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@ -923,102 +928,99 @@ implementation will be used."
name1 (format "%s<%d>" name i)))
(setq name name1)
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise,
;; `make-process' could be called on the local
;; host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save
;; BUFFER contents. Clear also the
;; modification time; otherwise we might be
;; interrupted by `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection',
;; in order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(delete-region (point-min) (point-max))
;; Send the command.
(setq p (tramp-get-connection-process v))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
(process-put p 'remote-command orig-command)
(tramp-set-connection-property
p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors,
;; because the process could have finished
;; already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point))
;; We must flush them here already;
;; otherwise `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property
v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the
;; first line, which is the command
;; echo.
(unless (eq filter t)
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point)))
;; Provide error buffer. This shows
;; only initial error messages; messages
;; arriving later on will be inserted
;; when the process is deleted. The
;; temporary file will exist until the
;; process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr))))
;; Return process.
p))))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification
;; time; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection',
;; in order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(delete-region (point-min) (point-max))
;; Send the command.
(setq p (tramp-get-connection-process v))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
(process-put p 'remote-command orig-command)
(tramp-set-connection-property
p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point))
;; We must flush them here already;
;; otherwise `rename-file', `delete-file'
;; or `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property
v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first
;; line, which is the command echo.
(unless (eq filter t)
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point)))
;; Provide error buffer. This shows only
;; initial error messages; messages
;; arriving later on will be inserted when
;; the process is deleted. The temporary
;; file will exist until the process is
;; deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr))))
;; Return process.
p))))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))))))))))))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp)))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."

12
lisp/net/tramp-archive.el
View file

@ -240,7 +240,7 @@ It must be supported by libarchive(3).")
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-archive-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
(file-exists-p . tramp-archive-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
(file-locked-p . ignore)
@ -322,7 +322,11 @@ arguments to pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply operation args))))
;;;###autoload
;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
;; autoloaded. But it must still be in tramp-loaddefs.el for older
;; Emacsen.
;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archine")
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
"Invoke the file archive related OPERATION.
First arg specifies the OPERATION, second arg ARGS is a list of
@ -645,6 +649,10 @@ offered."
"Like `file-executable-p' for file archives."
(file-executable-p (tramp-archive-gvfs-file-name filename)))
(defun tramp-archive-handle-file-exists-p (filename)
"Like `file-exists-p' for file archives."
(file-exists-p (tramp-archive-gvfs-file-name filename)))
(defun tramp-archive-handle-file-local-copy (filename)
"Like `file-local-copy' for file archives."
(file-local-copy (tramp-archive-gvfs-file-name filename)))

164
lisp/net/tramp-cache.el
View file

@ -48,7 +48,7 @@
;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
;; the timestamp a command has been sent to the remote process.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
@ -75,8 +75,9 @@
;;; Code:
(require 'tramp)
(autoload 'time-stamp-string "time-stamp")
(require 'tramp-compat)
(require 'tramp-loaddefs)
(require 'time-stamp)
;;; -- Cache --
@ -133,11 +134,7 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key)
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(setq key (tramp-file-name-unify key file))
(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))))
@ -161,7 +158,8 @@ Return DEFAULT if not set."
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
file property value remote-file-name-inhibit-cache cache-used cached-at)
(tramp-file-name-localname key)
property value remote-file-name-inhibit-cache cache-used cached-at)
;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
@ -181,15 +179,12 @@ Return DEFAULT if not set."
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key)
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(setq key (tramp-file-name-unify key file))
(let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(tramp-message key 8 "%s %s %s" file property value)
(tramp-message
key 8 "%s %s %s" (tramp-file-name-localname key) property value)
;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
@ -214,13 +209,9 @@ Return VALUE."
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key)
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(setq key (tramp-file-name-unify key file))
(remhash property (tramp-get-hash-table key))
(tramp-message key 8 "%s %s" file property)
(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))))
@ -232,10 +223,7 @@ Return VALUE."
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
(setq key (tramp-file-name-unify key file))
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
(when (string-match-p
"^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
@ -245,14 +233,10 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename")))
(let ((truename (tramp-get-file-property key file "file-truename")))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
(tramp-message key 8 "%s" file)
(setq key (tramp-file-name-unify key file))
(tramp-message key 8 "%s" (tramp-file-name-localname key))
(remhash key tramp-cache-data)
;; Remove file properties of symlinks.
(when (and (stringp truename)
@ -265,9 +249,8 @@ Return VALUE."
(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."
(setq directory (tramp-compat-file-name-unquote directory))
(let* ((directory (tramp-run-real-handler
#'directory-file-name (list directory)))
(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))
@ -288,6 +271,7 @@ Remove also properties of all files in subdirectories."
;; not show proper directory contents when a file has been copied or
;; deleted before. We must apply `save-match-data', because it would
;; corrupt other packages otherwise (reported from org).
;;;###tramp-autoload
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from `buffer-file-name'.
This is suppressed for temporary buffers."
@ -299,8 +283,8 @@ This is suppressed for temporary buffers."
default-directory))
(tramp-verbose 0))
(when (tramp-tramp-file-p bfn)
(with-parsed-tramp-file-name bfn nil
(tramp-flush-file-properties v localname)))))))
(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)
@ -314,6 +298,61 @@ This is suppressed for temporary buffers."
(remove-hook 'kill-buffer-hook
#'tramp-flush-file-function)))
;;;###tramp-autoload
(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)
;; 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 ,key ,file ,property value))
value))
;;;###tramp-autoload
(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
;; Unify localname. Remove hop from `tramp-file-name' structure.
(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)
;; Reset PROPERTY. Recompute hash, it could have been flushed.
(setq hash (tramp-get-hash-table ,key))
(if (consp cached)
(puthash ,property cached hash)
(remhash ,property hash))))))
;;;###tramp-autoload
(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
;; Unify localname. Remove hop from `tramp-file-name' structure.
(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)
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
(setq hash (tramp-get-hash-table ,key))
(dolist (value values)
(if (consp (cdr value))
(puthash (car value) (cdr value) hash)
(remhash (car value) hash)))))))
;;; -- Properties --
;;;###tramp-autoload
@ -396,6 +435,57 @@ used to cache connection properties of the local machine."
(or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
(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)
;; 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
(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)
;; Reset PROPERTY. Recompute hash, it could have been flushed.
(setq hash (tramp-get-hash-table ,key))
(if (not (eq cached tramp-cache-undefined))
(puthash ,property cached hash)
(remhash ,property hash))))))
;;;###tramp-autoload
(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)
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
(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)))))))
;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."

2
lisp/net/tramp-cmds.el
View file

@ -139,7 +139,7 @@ When called interactively, a Tramp connection has to be selected."
(when (bufferp buf) (kill-buffer buf)))
;; Flush file cache.
(tramp-flush-directory-properties vec "")
(tramp-flush-directory-properties vec "/")
;; Flush connection cache.
(tramp-flush-connection-properties vec)

9
lisp/net/tramp-crypt.el
View file

@ -824,24 +824,21 @@ WILDCARD is not supported."
(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-modes
(tramp-crypt-encrypt-file-name filename) mode flag))))
(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-times
(tramp-crypt-encrypt-file-name filename) time flag))))
(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))

1
lisp/net/tramp-ftp.el
View file

@ -31,7 +31,6 @@
(require 'tramp)
;; Pacify byte-compiler.
(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)

47
lisp/net/tramp-gvfs.el
View file

@ -960,6 +960,15 @@ The global value will always be nil; it is bound where needed.")
;; File name primitives.
(defun tramp-gvfs-info (filename &optional arg)
"Check FILENAME via `gvfs-info'.
Set file property \"file-exists-p\" with the result."
(with-parsed-tramp-file-name filename nil
(tramp-set-file-property
v localname "file-exists-p"
(tramp-gvfs-send-command
v "gvfs-info" arg (tramp-gvfs-url-file-name filename)))))
(defun tramp-gvfs-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
@ -1046,12 +1055,9 @@ file names."
;; code in case of direct copy/move. Apply
;; sanity checks.
(or (not equal-remote)
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name newname))
(tramp-gvfs-info newname)
(eq op 'copy)
(not (tramp-gvfs-send-command
v "gvfs-info"
(tramp-gvfs-url-file-name filename)))))
(not (tramp-gvfs-info filename))))
(if (or (not equal-remote)
(and equal-remote
@ -1111,8 +1117,9 @@ file names."
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
(unless (tramp-gvfs-send-command
v "gvfs-rm" (tramp-gvfs-url-file-name directory))
(unless (and (tramp-gvfs-send-command
v "gvfs-rm" (tramp-gvfs-url-file-name directory))
(not (tramp-gvfs-info directory)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@ -1125,8 +1132,9 @@ file names."
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(unless (tramp-gvfs-send-command
v "gvfs-rm" (tramp-gvfs-url-file-name filename))
(unless (and (tramp-gvfs-send-command
v "gvfs-rm" (tramp-gvfs-url-file-name filename))
(not (tramp-gvfs-info filename)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@ -1239,10 +1247,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if file-system " system" "") localname)
;; Send command.
(if file-system
(tramp-gvfs-send-command
v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename)))
(tramp-gvfs-info filename "--filesystem")
(tramp-gvfs-info filename))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@ -1547,8 +1553,10 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(make-directory ldir parents))
;; Just do it.
(or (when-let ((mkdir-succeeded
(tramp-gvfs-send-command
v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))))
(and
(tramp-gvfs-send-command
v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
(tramp-gvfs-info dir))))
(set-file-modes dir (default-file-modes))
mkdir-succeeded)
(and parents (file-directory-p dir))
@ -1582,16 +1590,14 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint64"
(tramp-gvfs-url-file-name filename) "time::modified"
@ -1644,8 +1650,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(when (natnump uid)
(tramp-gvfs-set-attribute
v "-t" "uint32"

677
lisp/net/tramp-sh.el
View file

@ -1113,7 +1113,8 @@ component is used as the target of the symlink."
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (tramp-file-local-name (expand-file-name target))))
;; There could be a cyclic link.
(tramp-flush-file-properties v target))
(tramp-flush-file-properties
v (expand-file-name target (tramp-file-local-name default-directory))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@ -1465,12 +1466,11 @@ of."
(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; We need "chmod -h" when the flag is set.
(when (or (not (eq flag 'nofollow))
(not (file-symlink-p filename))
(tramp-get-remote-chmod-h v))
(tramp-flush-file-properties v localname)
;; We need "chmod -h" when the flag is set.
(when (or (not (eq flag 'nofollow))
(not (file-symlink-p filename))
(tramp-get-remote-chmod-h (tramp-dissect-file-name filename)))
(tramp-skeleton-set-file-modes-times-uid-gid filename
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
@ -1482,9 +1482,8 @@ of."
(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-get-remote-touch v)
(tramp-flush-file-properties v localname)
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
@ -1543,9 +1542,9 @@ ID-FORMAT valid values are `string' and `integer'."
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
;; the majority of cases.
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used))
(with-parsed-tramp-file-name filename nil
(tramp-skeleton-set-file-modes-times-uid-gid filename
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used))
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
(tramp-set-file-uid-gid localname uid gid)
@ -1767,10 +1766,11 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-parsed-tramp-file-name (expand-file-name directory) nil
(when (and (not (tramp-compat-string-search "/" filename))
(tramp-connectable-p v))
(all-completions
filename
(with-tramp-file-property v localname "file-name-all-completions"
(let (result)
;; Get a list of directories and files, including reliably
@ -2197,6 +2197,8 @@ the uid and gid from FILENAME."
(file-name-directory (concat prefix localname2)))
(or (file-directory-p (concat prefix localname2))
(file-writable-p (concat prefix localname2))))
(with-parsed-tramp-file-name prefix nil
(tramp-flush-file-properties v localname2))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date preserve-uid-gid)
@ -2406,52 +2408,52 @@ The method used must be an out-of-band method."
(with-temp-buffer
(unwind-protect
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
;; The default directory must be remote.
(let ((default-directory
(file-name-directory (if v1 filename newname)))
(process-environment (copy-sequence process-environment)))
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(when copy-env
(tramp-message
v 6 "%s=\"%s\""
(car copy-env) (string-join (cdr copy-env) " "))
(setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
copy-args
(append
copy-args
(if remote-copy-program
(list (if v1 (concat ">" target) (concat "<" source)))
(list source target)))
;; Use an asynchronous process. By this, password
;; can be handled. We don't set a timeout, because
;; the copying of large files can last longer than
;; 60 secs.
p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program copy-args)))
(tramp-message v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
;; The default directory must be remote.
(let ((default-directory
(file-name-directory (if v1 filename newname)))
(process-environment (copy-sequence process-environment)))
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(when copy-env
(tramp-message
v 6 "%s=\"%s\""
(car copy-env) (string-join (cdr copy-env) " "))
(setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
copy-args
(append
copy-args
(if remote-copy-program
(list (if v1 (concat ">" target) (concat "<" source)))
(list source target)))
;; Use an asynchronous process. By this, password
;; can be handled. We don't set a timeout, because
;; the copying of large files can last longer than 60
;; secs.
p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program copy-args)))
(tramp-message v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
;; We must adapt `tramp-local-end-of-line' for sending
;; the password. Also, we indicate that perhaps several
;; password prompts might appear.
(let ((tramp-local-end-of-line tramp-rsh-end-of-line)
(tramp-password-prompt-not-unique (and v1 v2)))
(tramp-process-actions
p v nil tramp-actions-copy-out-of-band)))))
;; We must adapt `tramp-local-end-of-line' for sending
;; the password. Also, we indicate that perhaps
;; several password prompts might appear.
(let ((tramp-local-end-of-line tramp-rsh-end-of-line)
(tramp-password-prompt-not-unique (and v1 v2)))
(tramp-process-actions
p v nil tramp-actions-copy-out-of-band))))
;; Clear the remote prompt.
(when (and remote-copy-program
@ -2510,12 +2512,12 @@ The method used must be an out-of-band method."
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(tramp-barf-unless-okay
v (format "rm -f %s" (tramp-shell-quote-argument localname))
"Couldn't delete %s" filename))))
"Couldn't delete %s" filename))
(tramp-flush-file-properties v localname)))
;; Dired.
@ -2966,102 +2968,102 @@ implementation will be used."
name1 (format "%s<%d>" name i)))
(setq name name1)
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise,
;; `make-process' could be called on the local
;; host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save
;; BUFFER contents. Clear also the
;; modification time; otherwise we might be
;; interrupted by `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point-max))
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification
;; time; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point-max))
(coding-system-for-write
(if (symbolp coding) coding (car coding)))
(coding-system-for-read
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
(catch 'suppress
;; Set the pid of the remote shell. This
;; is needed when sending signals
;; remotely.
(let ((pid
(tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property
p "remote-pid" pid))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
(when (and (memq connection-type '(nil pipe))
(not
(tramp-check-remote-uname v "Darwin")))
(tramp-send-command v "stty -icrnl"))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could
;; have trashed the connection buffer.
;; Remove this.
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
(catch 'suppress
;; Set the pid of the remote shell. This is
;; needed when sending signals remotely.
(let ((pid
(tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property
p "remote-pid" pid))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
(when (and (memq connection-type '(nil pipe))
(not
(tramp-check-remote-uname v "Darwin")))
(tramp-send-command v "stty -icrnl"))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
(unless (process-get p 'remote-tty)
(tramp-error
v 'file-error
"pty association is not supported for `%s'"
name))))
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
(process-put p 'remote-command orig-command)
(tramp-set-connection-property
p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors,
;; because the process could have finished
;; already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already;
;; otherwise `delete-file' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Kill stderr process and delete named pipe.
(when (bufferp stderr)
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(ignore-errors
(while (accept-process-output
(get-buffer-process stderr) 0 nil t))
(delete-process (get-buffer-process stderr)))
(ignore-errors
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
(unless (process-get p 'remote-tty)
(tramp-error
v 'file-error
"pty association is not supported for `%s'"
name))))
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
(process-put p 'remote-command orig-command)
(tramp-set-connection-property
p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already;
;; otherwise `delete-file' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Kill stderr process and delete named pipe.
(when (bufferp stderr)
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(ignore-errors
(while (accept-process-output
(get-buffer-process stderr) 0 nil t))
(delete-process (get-buffer-process stderr)))
(ignore-errors
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))))))))))))
;; Save exit.
(if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp)))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@ -3242,7 +3244,7 @@ implementation will be used."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
(tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@ -3334,194 +3336,201 @@ implementation will be used."
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
(if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore.
(file-writable-p (file-name-directory localname))
(or (file-directory-p localname)
(file-writable-p localname)))
;; Short track: if we are on the local host, we can run directly.
(let ((create-lockfiles (not file-locked)))
(write-region start end localname append 'no-message lockname))
;; If `start' is the empty string, it is likely that a temporary
;; file is created. Do it directly.
(if (and (stringp start) (string-empty-p start))
(tramp-send-command
v (format "echo -n \"\">%s" (tramp-shell-quote-argument localname)))
(let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
;; We use this to save the value of
;; `last-coding-system-used' after writing the tmp file.
;; At the end of the function, we set
;; `last-coding-system-used' to this saved value. This
;; way, any intermediary coding systems used while
;; talking to the remote shell or suchlike won't hose
;; this variable. This approach was snarfed from
;; ange-ftp.el.
coding-system-used
;; Write region into a tmp file. This isn't really
;; needed if we use an encoding function, but currently
;; we use it always because this makes the logic simpler.
;; We must also set `temporary-file-directory', because
;; it could point to a remote directory.
(temporary-file-directory
tramp-compat-temporary-file-directory)
(tmpfile (or tramp-temp-buffer-file-name
(tramp-compat-make-temp-file filename))))
;; Short track: if we are on the local host, we can run directly.
(if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore.
(file-writable-p (file-name-directory localname))
(or (file-directory-p localname)
(file-writable-p localname)))
(let ((create-lockfiles (not file-locked)))
(write-region start end localname append 'no-message lockname))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
(let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
;; We use this to save the value of
;; `last-coding-system-used' after writing the tmp
;; file. At the end of the function, we set
;; `last-coding-system-used' to this saved value. This
;; way, any intermediary coding systems used while
;; talking to the remote shell or suchlike won't hose
;; this variable. This approach was snarfed from
;; ange-ftp.el.
coding-system-used
;; Write region into a tmp file. This isn't really
;; needed if we use an encoding function, but currently
;; we use it always because this makes the logic
;; simpler. We must also set
;; `temporary-file-directory', because it could point
;; to a remote directory.
(temporary-file-directory
tramp-compat-temporary-file-directory)
(tmpfile (or tramp-temp-buffer-file-name
(tramp-compat-make-temp-file filename))))
;; We say `no-message' here because we don't want the visited
;; file modtime data to be clobbered from the temp file. We
;; call `set-visited-file-modtime' ourselves later on. We
;; must ensure that `file-coding-system-alist' matches
;; `tmpfile'.
(let ((file-coding-system-alist
(tramp-find-file-name-coding-system-alist filename tmpfile))
create-lockfiles)
(condition-case err
(write-region start end tmpfile append 'no-message)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
(signal (car err) (cdr err))))
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; Now, `last-coding-system-used' has the right value.
;; Remember it.
(setq coding-system-used last-coding-system-used))
;; We say `no-message' here because we don't want the
;; visited file modtime data to be clobbered from the temp
;; file. We call `set-visited-file-modtime' ourselves later
;; on. We must ensure that `file-coding-system-alist'
;; matches `tmpfile'.
(let ((file-coding-system-alist
(tramp-find-file-name-coding-system-alist filename tmpfile))
create-lockfiles)
(condition-case err
(write-region start end tmpfile append 'no-message)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
(signal (car err) (cdr err))))
;; The permissions of the temporary file should be set. If
;; FILENAME does not exist (eq modes nil) it has been renamed
;; to the backup file. This case `save-buffer' handles
;; permissions. Ensure that it is still readable.
(when modes
(set-file-modes tmpfile (logior (or modes 0) #o0400)))
;; Now, `last-coding-system-used' has the right value.
;; Remember it.
(setq coding-system-used last-coding-system-used))
;; This is a bit lengthy due to the different methods possible
;; for file transfer. First, we check whether the method uses
;; an scp program. If so, we call it. Otherwise, both
;; encoding and decoding command must be specified. However,
;; if the method _also_ specifies an encoding function, then
;; that is used for encoding the contents of the tmp file.
(let* ((size (file-attribute-size (file-attributes tmpfile)))
(rem-dec (tramp-get-inline-coding v "remote-decoding" size))
(loc-enc (tramp-get-inline-coding v "local-encoding" size)))
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
(tramp-method-out-of-band-p v size))
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
(tramp-get-method-parameter
v 'tramp-copy-keep-tmpfile))
(progn
(setq tramp-temp-buffer-file-name tmpfile)
(condition-case err
;; We keep the local file for performance
;; reasons, useful for "rsync".
(copy-file tmpfile filename t)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
(signal (car err) (cdr err)))))
(setq tramp-temp-buffer-file-name nil)
;; Don't rename, in order to keep context in SELinux.
;; The permissions of the temporary file should be set. If
;; FILENAME does not exist (eq modes nil) it has been
;; renamed to the backup file. This case `save-buffer'
;; handles permissions. Ensure that it is still readable.
(when modes
(set-file-modes tmpfile (logior (or modes 0) #o0400)))
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
;; method uses an scp program. If so, we call it.
;; Otherwise, both encoding and decoding command must be
;; specified. However, if the method _also_ specifies an
;; encoding function, then that is used for encoding the
;; contents of the tmp file.
(let* ((size (file-attribute-size (file-attributes tmpfile)))
(rem-dec (tramp-get-inline-coding v "remote-decoding" size))
(loc-enc (tramp-get-inline-coding v "local-encoding" size)))
(cond
;; `copy-file' handles direct copy and out-of-band methods.
((or (tramp-local-host-p v)
(tramp-method-out-of-band-p v size))
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
(tramp-get-method-parameter
v 'tramp-copy-keep-tmpfile))
(progn
(setq tramp-temp-buffer-file-name tmpfile)
(condition-case err
;; We keep the local file for performance
;; reasons, useful for "rsync".
(copy-file tmpfile filename t)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
(signal (car err) (cdr err)))))
(setq tramp-temp-buffer-file-name nil)
;; Don't rename, in order to keep context in SELinux.
(unwind-protect
(copy-file tmpfile filename t)
(delete-file tmpfile))))
;; Use inline file transfer.
(rem-dec
;; Encode tmpfile.
(unwind-protect
(copy-file tmpfile filename t)
(delete-file tmpfile))))
(with-temp-buffer
(set-buffer-multibyte nil)
;; Use encoding function or command.
(with-tramp-progress-reporter
v 3 (format-message
"Encoding local file `%s' using `%s'"
tmpfile loc-enc)
(if (functionp loc-enc)
;; The following `let' is a workaround for
;; the base64.el that comes with pgnus-0.84.
;; If both of the following conditions are
;; satisfied, it tries to write to a local
;; file in default-directory, but at this
;; point, default-directory is remote.
;; (`call-process-region' can't write to
;; remote files, it seems.) The file in
;; question is a tmp file anyway.
(let ((coding-system-for-read 'binary)
(default-directory
tramp-compat-temporary-file-directory))
(insert-file-contents-literally tmpfile)
(funcall loc-enc (point-min) (point-max)))
;; Use inline file transfer.
(rem-dec
;; Encode tmpfile.
(unwind-protect
(with-temp-buffer
(set-buffer-multibyte nil)
;; Use encoding function or command.
(with-tramp-progress-reporter
v 3 (format-message
"Encoding local file `%s' using `%s'"
tmpfile loc-enc)
(if (functionp loc-enc)
;; The following `let' is a workaround for the
;; base64.el that comes with pgnus-0.84. If
;; both of the following conditions are
;; satisfied, it tries to write to a local
;; file in default-directory, but at this
;; point, default-directory is remote.
;; (`call-process-region' can't write to
;; remote files, it seems.) The file in
;; question is a tmp file anyway.
(let ((coding-system-for-read 'binary)
(default-directory
tramp-compat-temporary-file-directory))
(insert-file-contents-literally tmpfile)
(funcall loc-enc (point-min) (point-max)))
(unless (zerop (tramp-call-local-coding-command
loc-enc tmpfile t))
(tramp-error
v 'file-error
(concat "Cannot write to `%s', "
"local encoding command `%s' failed")
filename loc-enc))))
(unless (zerop (tramp-call-local-coding-command
loc-enc tmpfile t))
(tramp-error
v 'file-error
(concat "Cannot write to `%s', "
"local encoding command `%s' failed")
filename loc-enc))))
;; Send buffer into remote decoding command which
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
(with-tramp-progress-reporter
v 3 (format-message
"Decoding remote file `%s' using `%s'"
filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
(tramp-barf-unless-okay
v (format
(concat rem-dec " <<'%s'\n%s%s")
(tramp-shell-quote-argument localname)
tramp-end-of-heredoc
(buffer-string)
tramp-end-of-heredoc)
"Couldn't write region to `%s', decode using `%s' failed"
filename rem-dec)
;; When `file-precious-flag' is set, the region
;; is written to a temporary file. Check that
;; the checksum is equal to that from the local
;; tmpfile.
(when file-precious-flag
(erase-buffer)
(and
;; cksum runs locally, if possible.
(zerop (tramp-call-process v "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
v (format
"cksum <%s" (tramp-shell-quote-argument localname)))
;; ... they are different.
(not
(string-equal
(buffer-string)
(tramp-get-buffer-string (tramp-get-buffer v))))
(tramp-error
v 'file-error
(concat "Couldn't write region to `%s',"
" decode using `%s' failed")
filename rem-dec)))))
;; Send buffer into remote decoding command which
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
(with-tramp-progress-reporter
v 3 (format-message
"Decoding remote file `%s' using `%s'"
filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
(tramp-barf-unless-okay
v
(format
(concat rem-dec " <<'%s'\n%s%s")
(tramp-shell-quote-argument localname)
tramp-end-of-heredoc
(buffer-string)
tramp-end-of-heredoc)
"Couldn't write region to `%s', decode using `%s' failed"
filename rem-dec)
;; When `file-precious-flag' is set, the region is
;; written to a temporary file. Check that the
;; checksum is equal to that from the local tmpfile.
(when file-precious-flag
(erase-buffer)
(and
;; cksum runs locally, if possible.
(zerop (tramp-call-process v "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
v
(format
"cksum <%s"
(tramp-shell-quote-argument localname)))
;; ... they are different.
(not
(string-equal
(buffer-string)
(tramp-get-buffer-string (tramp-get-buffer v))))
(tramp-error
v 'file-error
"Couldn't write region to `%s', decode using `%s' failed"
filename rem-dec)))))
;; Save exit.
(delete-file tmpfile)))
;; Save exit.
(delete-file tmpfile)))
;; That's not expected.
(t
(tramp-error
v 'file-error
(concat "Method `%s' should specify both encoding and "
"decoding command or an scp program")
method))))
;; That's not expected.
(t
(tramp-error
v 'file-error
(concat "Method `%s' should specify both encoding and "
"decoding command or an scp program")
method))))
;; Make `last-coding-system-used' have the right value.
(when coding-system-used
(setq last-coding-system-used coding-system-used))))))
;; Make `last-coding-system-used' have the right value.
(when coding-system-used
(setq last-coding-system-used coding-system-used)))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")

330
lisp/net/tramp-smb.el
View file

@ -523,49 +523,49 @@ arguments to pass to the OPERATION."
"tar qx -")))))
(unwind-protect
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(when t1
;; The smbclient tar command creates
;; always complete paths. We must
;; emulate the directory structure, and
;; symlink to the real target.
(make-directory
(expand-file-name
".." (concat tmpdir localname))
'parents)
(make-symbolic-link
newname
(directory-file-name (concat tmpdir localname))))
(when t1
;; The smbclient tar command creates
;; always complete paths. We must emulate
;; the directory structure, and symlink to
;; the real target.
(make-directory
(expand-file-name
".." (concat tmpdir localname))
'parents)
(make-symbolic-link
newname
(directory-file-name (concat tmpdir localname))))
;; Use an asynchronous processes. By
;; this, password can be handled.
(let* ((default-directory tmpdir)
(p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-program args)))
;; Use an asynchronous processes. By this,
;; password can be handled.
(let* ((default-directory tmpdir)
(p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-program args)))
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put
p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions
p v nil tramp-smb-actions-with-tar)
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put
p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions
p v nil tramp-smb-actions-with-tar)
(while (process-live-p p)
(sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string))))))
(while (process-live-p p)
(sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string)))))
;; Save exit.
(when t1 (delete-directory tmpdir 'recursive))))
@ -751,6 +751,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
(defun tramp-smb-remote-acl-p (_vec)
"Check, whether ACL is enabled on the remote host."
(and (stringp tramp-smb-acl-program) (executable-find tramp-smb-acl-program)))
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
(unless (process-live-p proc)
@ -774,7 +778,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(ignore-errors
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
(when (executable-find tramp-smb-acl-program)
(when (tramp-smb-remote-acl-p v)
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@ -799,31 +803,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(concat "2>" (tramp-get-remote-null-device v)))))
(unwind-protect
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
;; Use an asynchronous process. By this,
;; password can be handled.
(let ((p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-acl-program args)))
;; Use an asynchronous process. By this, password
;; can be handled.
(let ((p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-acl-program args)))
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-get-acl)
(when (> (point-max) (point-min))
(substring-no-properties (buffer-string))))))))))))))
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-get-acl)
(when (> (point-max) (point-min))
(substring-no-properties (buffer-string)))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@ -1311,32 +1315,32 @@ component is used as the target of the symlink."
;; Call it.
(condition-case nil
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property
v "process-buffer"
(or outbuf (generate-new-buffer tramp-temp-buffer-name)))
(with-current-buffer (tramp-get-connection-buffer v)
;; Preserve buffer contents.
(narrow-to-region (point-max) (point-max))
(tramp-smb-call-winexe v)
(when (tramp-smb-get-share v)
(tramp-smb-send-command
v (format "cd //%s%s" host
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-smb-send-command v command)
;; Preserve command output.
(narrow-to-region (point-max) (point-max))
(let ((p (tramp-get-connection-process v)))
(tramp-smb-send-command v "exit $lasterrorcode")
(while (process-live-p p)
(sleep-for 0.1)
(setq ret (process-exit-status p))))
(delete-region (point-min) (point-max))
(widen))))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property
v "process-buffer"
(or outbuf (generate-new-buffer tramp-temp-buffer-name)))
(with-current-buffer (tramp-get-connection-buffer v)
;; Preserve buffer contents.
(narrow-to-region (point-max) (point-max))
(tramp-smb-call-winexe v)
(when (tramp-smb-get-share v)
(tramp-smb-send-command
v (format "cd //%s%s" host
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-smb-send-command v command)
;; Preserve command output.
(narrow-to-region (point-max) (point-max))
(let ((p (tramp-get-connection-process v)))
(tramp-smb-send-command v "exit $lasterrorcode")
(while (process-live-p p)
(sleep-for 0.1)
(setq ret (process-exit-status p))))
(delete-region (point-min) (point-max))
(widen)))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@ -1356,7 +1360,7 @@ component is used as the target of the symlink."
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
(tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@ -1427,7 +1431,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v localname "file-acl")
(when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
(when (and (stringp acl-string) (tramp-smb-remote-acl-p v))
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@ -1455,52 +1459,50 @@ component is used as the target of the symlink."
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
;; Use an asynchronous process. By this, password
;; can be handled.
(let ((p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-acl-program args)))
;; Use an asynchronous process. By this, password
;; can be handled.
(let ((p (apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-acl-program args)))
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl)
;; This is meant for traces, and returning from
;; the function. No error is propagated
;; outside, due to the `ignore-errors' closure.
(unless
(tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'"
tramp-smb-acl-program))
(skip-chars-forward "^ ")
(when (zerop (read (current-buffer)))
;; Success.
(tramp-set-file-property
v localname "file-acl" acl-string)
t)))))))))))
(tramp-message
v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl)
;; This is meant for traces, and returning from
;; the function. No error is propagated outside,
;; due to the `ignore-errors' closure.
(unless
(tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'"
tramp-smb-acl-program))
(skip-chars-forward "^ ")
(when (zerop (read (current-buffer)))
;; Success.
(tramp-set-file-property v localname "file-acl" acl-string)
t))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; smbclient chmod does not support nofollow.
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
;; smbclient chmod does not support nofollow.
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-smb-get-cifs-capabilities v)
(tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
v
(format "chmod %s %o" (tramp-smb-shell-quote-localname v) mode))
@ -1524,38 +1526,38 @@ component is used as the target of the symlink."
(i 0)
p)
(unwind-protect
(with-tramp-saved-connection-property v "process-name"
(with-tramp-saved-connection-property v "process-buffer"
(save-excursion
(save-restriction
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property v "process-buffer" buffer)
;; Activate narrowing in order to save BUFFER contents.
(with-current-buffer (tramp-get-connection-buffer v)
(let ((buffer-undo-list t))
(narrow-to-region (point-max) (point-max))
(tramp-smb-call-winexe v)
(when (tramp-smb-get-share v)
(tramp-smb-send-command
v (format
"cd //%s%s"
host
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-message v 6 "(%s); exit" command)
(tramp-send-string v command)))
(setq p (tramp-get-connection-process v))
(when program
(process-put p 'remote-command (cons program args))
(tramp-set-connection-property
p "remote-command" (cons program args)))
;; Return value.
p))))
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(save-excursion
(save-restriction
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property v "process-buffer" buffer)
;; Activate narrowing in order to save BUFFER contents.
(with-current-buffer (tramp-get-connection-buffer v)
(let ((buffer-undo-list t))
(narrow-to-region (point-max) (point-max))
(tramp-smb-call-winexe v)
(when (tramp-smb-get-share v)
(tramp-smb-send-command
v (format
"cd //%s%s"
host
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-message v 6 "(%s); exit" command)
(tramp-send-string v command)))
(setq p (tramp-get-connection-process v))
(when program
(process-put p 'remote-command (cons program args))
(tramp-set-connection-property
p "remote-command" (cons program args)))
;; Return value.
p)))
;; Save exit.
;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
@ -1933,7 +1935,7 @@ If ARGUMENT is non-nil, use it as argument for
tramp-smb-version
(tramp-get-connection-property
vec "smbclient-version" tramp-smb-version))
(tramp-flush-directory-properties vec "")
(tramp-flush-directory-properties vec "/")
(tramp-flush-connection-properties vec))
(tramp-set-connection-property

13
lisp/net/tramp-sshfs.el
View file

@ -333,7 +333,7 @@ arguments to pass to the OPERATION."
;; them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))))))
(tramp-flush-directory-properties v "/"))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
@ -355,18 +355,15 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
"Like `set-file-times' for Tramp files."
(or (file-exists-p filename) (write-region "" nil filename nil 0))
(with-parsed-tramp-file-name filename nil
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-times
(tramp-fuse-local-file-name filename) timestamp flag))))

24
lisp/net/tramp-sudoedit.el
View file

@ -484,10 +484,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; It is unlikely that "chmod -h" works.
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
;; It is unlikely that "chmod -h" works.
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(unless (tramp-sudoedit-send-command
v "chmod" (format "%o" mode)
(tramp-compat-file-name-unquote localname))
@ -542,8 +541,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
@ -730,13 +728,13 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-sudoedit-send-command
v "chown"
(format "%d:%d"
(or uid (tramp-get-remote-uid v 'integer))
(or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-file-local-name filename))))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-sudoedit-send-command
v "chown"
(format "%d:%d"
(or uid (tramp-get-remote-uid v 'integer))
(or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-file-local-name filename))))
;; Internal functions.

127
lisp/net/tramp.el
View file

@ -62,7 +62,6 @@
(require 'cl-lib)
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(declare-function tramp-archive-file-name-handler "tramp-archive")
(defvar auto-save-file-name-transforms)
;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package.
@ -97,6 +96,7 @@
If it is set to nil, all remote file names are used literally."
:type 'boolean)
;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
@ -1441,8 +1441,9 @@ calling HANDLER.")
;; work otherwise when unloading / reloading Tramp. (Bug#50869)
;;;###tramp-autoload(require 'cl-lib)
;;;###tramp-autoload
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
(progn
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop))
(put #'tramp-file-name-method 'tramp-suppress-trace t)
(put #'tramp-file-name-user 'tramp-suppress-trace t)
@ -1485,13 +1486,22 @@ If nil, return `tramp-default-port'."
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
(defun tramp-file-name-unify (vec)
;;;###tramp-autoload
(defun tramp-file-name-unify (vec &optional file)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
If FILE is a string, set it as localname.
Objects returned by this function compare `equal' if they refer to the
same connection. Make a copy in order to avoid side effects."
(when (tramp-file-name-p vec)
(setq vec (copy-tramp-file-name vec))
(setf (tramp-file-name-localname vec) nil
(setf (tramp-file-name-localname vec)
(and (stringp file)
;; FIXME: This is a sanity check. When this error
;; doesn't happen for a while, it can be removed.
(or (file-name-absolute-p file)
(tramp-error
vec 'file-error "File `%s' must be absolute" file))
(directory-file-name (tramp-compat-file-name-unquote file)))
(tramp-file-name-hop vec) nil))
vec)
@ -1525,6 +1535,7 @@ entry does not exist, return nil."
"Return unquoted localname component of VEC."
(tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(and tramp-mode (stringp name)
@ -1546,6 +1557,7 @@ entry does not exist, return nil."
;; However, it is more performant than `file-local-name', and might be
;; useful where performance matters, like in operations over a bulk
;; list of file names.
;;;###tramp-autoload
(defun tramp-file-local-name (name)
"Return the local name component of NAME.
This function removes from NAME the specification of the remote
@ -1637,6 +1649,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(put #'tramp-find-host 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
The structure consists of method, user, domain, host, port,
@ -1747,6 +1760,7 @@ See `tramp-dissect-file-name' for details."
(put #'tramp-buffer-name 'tramp-suppress-trace t)
;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
@ -1856,6 +1870,7 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet."
(tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
;;;###tramp-autoload
(defun tramp-get-connection-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
Unless DONT-CREATE, the buffer is created when it doesn't exist yet.
@ -1912,8 +1927,7 @@ version, the function does nothing."
"Return `default-directory' of BUFFER."
(buffer-local-value 'default-directory buffer))
(put #'tramp-get-default-directory 'tramp-suppress-trace t)
;;;###tramp-autoload
(defsubst tramp-get-buffer-string (&optional buffer)
"Return contents of BUFFER.
If BUFFER is not a buffer or a buffer name, return the contents
@ -1921,8 +1935,6 @@ of `current-buffer'."
(with-current-buffer (or buffer (current-buffer))
(substring-no-properties (buffer-string))))
(put #'tramp-get-buffer-string 'tramp-suppress-trace t)
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
@ -2034,6 +2046,7 @@ They are completed by \"M-x TAB\" only in Tramp debug buffers."
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
;;;###tramp-autoload
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
@ -2107,10 +2120,12 @@ ARGUMENTS to actually emit the message (if applicable)."
(put #'tramp-debug-message 'tramp-suppress-trace t)
;;;###tramp-autoload
(defvar tramp-inhibit-progress-reporter nil
"Show Tramp progress reporter in the minibuffer.
This variable is used to disable concurrent progress reporter messages.")
;;;###tramp-autoload
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@ -2163,8 +2178,6 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
(put #'tramp-message 'tramp-suppress-trace t)
(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
@ -2177,8 +2190,6 @@ This function is meant for debugging purposes."
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
(put #'tramp-backtrace 'tramp-suppress-trace t)
(defun tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
@ -2246,8 +2257,6 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
@ -2284,8 +2293,6 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
;; This macro shall optimize the cases where an `file-exists-p' call
;; is invoked first. Often, the file exists, so the remote command is
;; superfluous.
@ -2302,8 +2309,6 @@ does not exist, otherwise propagate the error."
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
(put #'tramp-barf-if-file-missing 'tramp-suppress-trace t)
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
(cond
@ -2399,45 +2404,6 @@ without a visible progress reporter."
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
(defmacro with-tramp-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."
(declare (indent 3) (debug t))
`(if (file-name-absolute-p ,file)
(let ((value (tramp-get-file-property
,vec ,file ,property tramp-cache-undefined)))
(when (eq value tramp-cache-undefined)
;; 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))
(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)
;; 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))
(defmacro with-tramp-saved-connection-property (key property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY."
(declare (indent 2) (debug t))
`(let ((value (tramp-get-connection-property
,key ,property tramp-cache-undefined)))
(unwind-protect (progn ,@body)
(if (eq value tramp-cache-undefined)
(tramp-flush-connection-property ,key ,property)
(tramp-set-connection-property ,key ,property value)))))
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
@ -3424,8 +3390,6 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory))
,@body))
(put #'tramp-skeleton-copy-directory 'tramp-suppress-trace t)
(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
"Skeleton for `tramp-*-handle-delete-directory'.
BODY is the backend specific code."
@ -3441,8 +3405,6 @@ BODY is the backend specific code."
,@body)
(tramp-flush-directory-properties v localname)))
(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
(defmacro tramp-skeleton-directory-files
(directory &optional full match nosort count &rest body)
"Skeleton for `tramp-*-handle-directory-files'.
@ -3474,8 +3436,6 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
(put #'tramp-skeleton-directory-files 'tramp-suppress-trace t)
(defmacro tramp-skeleton-directory-files-and-attributes
(directory &optional full match nosort id-format count &rest body)
"Skeleton for `tramp-*-handle-directory-files-and-attributes'.
@ -3485,7 +3445,6 @@ BODY is the backend specific code."
(with-parsed-tramp-file-name ,directory nil
(tramp-barf-if-file-missing v ,directory
(when (file-directory-p ,directory)
(setq ,directory (expand-file-name ,directory))
(let ((temp
(copy-tree
(mapcar
@ -3493,9 +3452,10 @@ BODY is the backend specific code."
(cons
(car x)
(tramp-convert-file-attributes
v (car x) ,id-format (cdr x))))
v (expand-file-name (car x) localname)
,id-format (cdr x))))
(with-tramp-file-property
v localname ",directory-files-and-attributes"
v localname "directory-files-and-attributes"
,@body))))
result item)
@ -3524,10 +3484,8 @@ BODY is the backend specific code."
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
(put #'tramp-skeleton-directory-files-and-attributes 'tramp-suppress-trace t)
(defmacro tramp-skeleton-file-local-copy (filename &rest body)
"Skeleton for `tramp-*-handle-file-local-copy-files'.
"Skeleton for `tramp-*-handle-file-local-copy'.
BODY is the backend specific code."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (file-truename ,filename) nil
@ -3541,7 +3499,22 @@ BODY is the backend specific code."
;; Trigger the `file-missing' error.
(signal 'error nil)))))
(put #'tramp-skeleton-file-local-copy 'tramp-suppress-trace t)
(defmacro tramp-skeleton-set-file-modes-times-uid-gid
(filename &rest body)
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
BODY is the backend specific code."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name ,filename nil
(when (not (file-exists-p ,filename))
(tramp-error v 'file-missing ,filename))
(with-tramp-saved-file-properties
v localname
;; We cannot add "file-attributes", "file-executable-p",
;; "file-ownership-preserved-p", "file-readable-p",
;; "file-writable-p".
'("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
(tramp-flush-file-properties v localname))
,@body))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
@ -3602,6 +3575,9 @@ BODY is the backend specific code."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
;; Set the "file-exists-p" file property, because it is
;; likely that it is needed shortly after `write-region'.
(tramp-set-file-property v localname "file-exists-p" t)
;; We must protect `last-coding-system-used', now we have
;; set it to its correct value.
@ -3645,8 +3621,6 @@ BODY is the backend specific code."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))))
(put #'tramp-skeleton-write-region 'tramp-suppress-trace t)
;;; Common file name handler functions for different backends:
(defvar tramp-handle-file-local-copy-hook nil
@ -3843,7 +3817,9 @@ Let-bind it when necessary.")
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
(not (null (file-attributes filename)))))
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-exists-p"
(not (null (file-attributes filename)))))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
@ -5620,7 +5596,7 @@ the remote host use line-endings as defined in the variable
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
(tramp-flush-directory-properties vec ""))
(tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
(when (and prompt (tramp-search-regexp (regexp-quote prompt)))
@ -6049,6 +6025,7 @@ Return the local name of the temporary file."
(let (create-lockfiles)
(cl-letf (((symbol-function 'tramp-remote-acl-p) #'ignore)
((symbol-function 'tramp-remote-selinux-p) #'ignore)
((symbol-function 'tramp-smb-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-acl-p) #'ignore)
((symbol-function 'tramp-sudoedit-remote-selinux-p) #'ignore))
(tramp-file-local-name

23
test/lisp/net/tramp-tests.el
View file

@ -2481,6 +2481,19 @@ This checks also `file-name-as-directory', `file-name-directory',
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
;; Write empty string. Used for creation of temprorary files.
;; Since Emacs 27.1.
(when (fboundp 'make-empty-file)
(with-no-warnings
(should-error
(make-empty-file tmp-name)
:type 'file-already-exists)
(delete-file tmp-name)
(make-empty-file tmp-name)
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "")))))
;; Write partly.
(with-temp-buffer
(insert "123456789")
@ -3790,7 +3803,11 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-modes tmp-name1 #o222 'nofollow)
(should (= (file-modes tmp-name1 'nofollow) #o222)))))
(should (= (file-modes tmp-name1 'nofollow) #o222))))
;; Setting the mode for not existing files shall fail.
(should-error
(set-file-modes tmp-name2 #o777)
:type 'file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name1)))
@ -4153,6 +4170,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-compat-time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 1)))
;; Setting the time for not existing files shall fail.
(should-error
(set-file-times tmp-name2)
:type 'file-missing)
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))