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

Tramp: Handle symlinks to non-existing targets better

Browse source 
* lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
Don't use the truename.

* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): Refactor.  Handle
symlinks.  (Bug#76678)

* lisp/net/tramp-smb.el (tramp-smb-errors): Add string.
(tramp-smb-handle-copy-file, tramp-smb-handle-rename-file):
Refactor.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
Don't use the truename.  Handle symlinks.

* lisp/net/tramp.el (tramp-barf-if-file-missing): Accept also symlinks.
(tramp-skeleton-file-exists-p): Handle non-existing symlink targets.
(tramp-skeleton-set-file-modes-times-uid-gid): Fix typo.

* test/lisp/net/tramp-tests.el (vc-handled-backends):
Suppress only if noninteractive.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test18-file-attributes, tramp-test21-file-links)
(tramp--test-check-files): Adapt tests.
This commit is contained in:
Michael Albinus 2025-03-16 14:17:38 +01:00
parent 03e33cbef3
commit b8104dadbf
8 changed files with 359 additions and 285 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -997,7 +997,7 @@ error and non-nil on success."
;; <https://android.stackexchange.com/questions/226638/how-to-use-multibyte-file-names-in-adb-shell/232379#232379>
;; mksh uses UTF-8 internally, but is currently limited to the
;; BMP (basic multilingua plane), which means U+0000 to
;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
;; U-0010FFFD) on the input line, you currently have to disable
;; the UTF-8 mode (sorry).
(tramp-adb-execute-adb-command vec "shell" command)

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

@ -738,6 +738,7 @@ By default this is done using the \"sudo\" Tramp method.
YOu can customize `tramp-file-name-with-method' to change this.
Interactively, with a prefix argument, prompt for a different method."
;; (declare (completion tramp-dired-buffer-command-completion-p))
(interactive)
(with-tramp-file-name-with-method
(find-file (tramp-file-name-with-sudo (dired-get-file-for-visit)))))

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

@ -1044,7 +1044,9 @@ file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(setq filename (file-truename filename))
;; We cannot use `file-truename', this would fail for symlinks with
;; non-existing target.
(setq filename (expand-file-name filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
@ -2217,7 +2219,7 @@ connection if a previous connection has died for some reason."
method '(("smb" . "smb-share")
("davs" . "dav")
("nextcloud" . "dav")
("afp". "afp-volume")
("afp" . "afp-volume")
("gdrive" . "google-drive")))
method)
tramp-gvfs-mounttypes)

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

@ -2128,123 +2128,129 @@ file names."
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
(if (file-symlink-p filename)
(progn
(make-symbolic-link
(file-symlink-p filename) newname ok-if-already-exists)
(when (eq op 'rename) (delete-file filename)))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (file-attribute-size
(file-attributes (file-truename filename))))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(msg-operation (if (eq op 'copy) "Copying" "Renaming"))
copy-keep-date)
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (or (file-attribute-size
(file-attributes (file-truename filename)))
;; `filename' doesn't exist, for example due
;; to non-existent symlink target.
0))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(msg-operation (if (eq op 'copy) "Copying" "Renaming"))
copy-keep-date)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless length
(tramp-error v 'file-missing filename))
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(cond
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same for
;; both files, we invoke `cp' or `mv' on the remote
;; host directly.
((tramp-equal-remote filename newname)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Try out-of-band operation.
((and
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go
;; back and delete the original file (if the copy
;; was successful). The approach is simple-minded:
;; we create a new buffer, insert the contents of
;; the source file into it, then write out the
;; buffer to the target file. The advantage is
;; that it doesn't matter which file name handlers
;; are used for the source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same
;; for both files, we invoke `cp' or `mv' on the
;; remote host directly.
((tramp-equal-remote filename newname)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; Try out-of-band operation.
((and
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go
;; back and delete the original file (if the copy
;; was successful). The approach is simple-minded:
;; we create a new buffer, insert the contents of
;; the source file into it, then write out the
;; buffer to the target file. The advantage is
;; that it doesn't matter which file name handlers
;; are used for the source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))
;; Handle `preserve-extended-attributes'. We ignore
;; possible errors, because ACL strings could be
;; incompatible.
(when-let* ((attributes (and preserve-extended-attributes
(file-extended-attributes filename))))
(ignore-errors
(set-file-extended-attributes newname attributes)))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(set-file-times
newname file-times (unless ok-if-already-exists 'nofollow)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
(set-file-modes newname file-modes))))))))
;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
;; Handle `preserve-extended-attributes'. We ignore
;; possible errors, because ACL strings could be
;; incompatible.
(when-let* ((attributes (and preserve-extended-attributes
(file-extended-attributes filename))))
(ignore-errors
(set-file-extended-attributes newname attributes)))
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(set-file-times
newname file-times (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
(set-file-modes newname file-modes)))))))))
(defun tramp-do-copy-or-rename-file-via-buffer
(op filename newname _ok-if-already-exists _keep-date)
@ -3119,7 +3125,7 @@ will be used."
;; character to read. When a process does
;; not read from stdin, like magit, it
;; should set a timeout
;; instead. See`tramp-pipe-stty-settings'.
;; instead. See `tramp-pipe-stty-settings'.
;; (Bug#62093)
;; FIXME: Shall we rather use "stty raw"?
(tramp-send-command
@ -5631,7 +5637,7 @@ Nonexistent directories are removed from spec."
(lambda (x) (not (tramp-get-file-property vec x "file-directory-p")))
remote-path))))))
;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
;; on various platforms:
;; - 512 on macOS, FreeBSD, NetBSD, OpenBSD, MirBSD, native Windows.
;; - 4 KiB on Linux, OSF/1, Cygwin, Haiku.

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

@ -114,6 +114,7 @@ this variable \"client min protocol=NT1\"."
"Read from server failed, maybe it closed the connection"
"Call timed out: server did not respond"
(: (+ (not blank)) ": command not found")
(: (+ (not blank)) " does not exist")
"Server doesn't support UNIX CIFS calls"
(| ;; Samba.
"ERRDOS"
@ -596,66 +597,63 @@ KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-tramp-progress-reporter
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
(copy-directory filename newname keep-date 'parents 'copy-contents)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(unless (file-exists-p filename)
(tramp-error
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
'file-missing filename))
(if (file-directory-p filename)
(copy-directory filename newname keep-date 'parents 'copy-contents)
;; `file-local-copy' returns a file name also for a local file
;; with `jka-compr-handler', so we cannot trust its result as
;; indication for a remote file name.
(if-let* ((tmpfile
(and (tramp-tramp-file-p filename) (file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
((error quit)
(delete-file tmpfile)
(signal (car err) (cdr err))))
(tramp-barf-if-file-missing v filename
;; `file-local-copy' returns a file name also for a local
;; file with `jka-compr-handler', so we cannot trust its
;; result as indication for a remote file name.
(if-let* ((tmpfile
(and (tramp-tramp-file-p filename)
(file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
((error quit)
(delete-file tmpfile)
(signal (car err) (cdr err))))
;; Remote newname.
(when (and (file-directory-p newname)
(directory-name-p newname))
(setq newname
(expand-file-name (file-name-nondirectory filename) newname)))
;; Remote newname.
(when (and (file-directory-p newname)
(directory-name-p newname))
(setq newname
(expand-file-name
(file-name-nondirectory filename) newname)))
(with-parsed-tramp-file-name newname nil
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(unless (tramp-smb-get-share v)
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v (format "put %s %s"
(tramp-smb-shell-quote-argument filename)
(tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname))
(unless (tramp-smb-get-share v)
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v (format "put %s %s"
(tramp-smb-shell-quote-argument filename)
(tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname))
;; When newname did exist, we have wrong cached values.
(when (tramp-tramp-file-p newname)
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))
;; When newname did exist, we have wrong cached values.
(when (tramp-tramp-file-p newname)
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))
;; KEEP-DATE handling.
(when keep-date
(set-file-times
newname
(file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
;; KEEP-DATE handling.
(when keep-date
(set-file-times
newname
(file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
@ -1306,46 +1304,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
(tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(if (and (not (file-exists-p newname))
(tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
;; We can rename directly.
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(if (and (not (file-exists-p newname))
(tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
;; We can rename directly.
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v1 v1-localname)
(tramp-flush-file-properties v2 v2-localname)
(unless (tramp-smb-get-share v2)
(tramp-error
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v2 (format "rename %s %s"
(tramp-smb-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v1 v1-localname)
(tramp-flush-file-properties v2 v2-localname)
(unless (tramp-smb-get-share v2)
(tramp-error
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v2 (format "rename %s %s"
(tramp-smb-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must rename via copy.
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(if (file-directory-p filename)
(delete-directory filename 'recursive)
(delete-file filename))))))
;; We must rename via copy.
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(if (file-directory-p filename)
(delete-directory filename 'recursive)
(delete-file filename)))))))
(defun tramp-smb-action-set-acl (proc vec)
"Set ACL data."

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

@ -244,84 +244,88 @@ absolute file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(setq filename (file-truename filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
(if (file-symlink-p filename)
(progn
(make-symbolic-link
(file-symlink-p filename) newname ok-if-already-exists)
(when (eq op 'rename) (delete-file filename)))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
(file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
((eq op 'copy) '("cp" "-f"))
((eq op 'rename) '("mv" "-f"))))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
(file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
((eq op 'copy) '("cp" "-f"))
((eq op 'rename) '("mv" "-f"))))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and (tramp-tramp-file-p filename) (not t1))
(and (tramp-tramp-file-p newname) (not t2)))
;; We cannot copy or rename directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file filename tmpfile t)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists))
(if (or (and (tramp-tramp-file-p filename) (not t1))
(and (tramp-tramp-file-p newname) (not t2)))
;; We cannot copy or rename directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file filename tmpfile t)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists))
;; Direct action.
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
(tramp-unquote-file-local-name filename)
(tramp-unquote-file-local-name newname))
(tramp-error
v 'file-error
"Error %s `%s' `%s'" msg-operation filename newname))))
;; Direct action.
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
(tramp-unquote-file-local-name filename)
(tramp-unquote-file-local-name newname))
(tramp-error
v 'file-error
"Error %s `%s' `%s'" msg-operation filename newname))))
;; When `newname' is local, we must change the ownership to
;; the local user.
(unless (tramp-tramp-file-p newname)
(tramp-set-file-uid-gid
(concat (file-remote-p filename) newname)
(tramp-get-local-uid 'integer)
(tramp-get-local-gid 'integer)))
;; When `newname' is local, we must change the ownership
;; to the local user.
(unless (tramp-tramp-file-p newname)
(tramp-set-file-uid-gid
(concat (file-remote-p filename) newname)
(tramp-get-local-uid 'integer)
(tramp-get-local-gid 'integer)))
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
(set-file-times
newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
(set-file-times
newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Handle `preserve-extended-attributes'. We ignore possible
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(set-file-extended-attributes newname attributes)))
;; Handle `preserve-extended-attributes'. We ignore possible
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))))
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-sudoedit-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date

21
lisp/net/tramp.el
View file

@ -2107,7 +2107,7 @@ does not exist, otherwise propagate the error."
`(condition-case ,err
(progn ,@body)
(error
(if (not (file-exists-p ,filename))
(if (not (or (file-exists-p ,filename) (file-symlink-p ,filename)))
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
@ -3576,12 +3576,17 @@ BODY is the backend specific code."
(when (tramp-connectable-p ,filename)
(with-parsed-tramp-file-name (expand-file-name ,filename) nil
(with-tramp-file-property v localname "file-exists-p"
;; Examine `file-attributes' cache to see if request can
;; be satisfied without remote operation.
(if (tramp-file-property-p v localname "file-attributes")
(not
(null (tramp-get-file-property v localname "file-attributes")))
,@body))))))
(cond
;; Examine `file-attributes' cache to see if request can
;; be satisfied without remote operation.
((and-let*
(((tramp-file-property-p v localname "file-attributes"))
(fa (tramp-get-file-property v localname "file-attributes"))
((not (stringp (car fa)))))))
;; Symlink to a non-existing target counts as nil.
((file-symlink-p ,filename)
(file-exists-p (file-truename ,filename)))
(t ,@body)))))))
(defmacro tramp-skeleton-file-local-copy (filename &rest body)
"Skeleton for `tramp-*-handle-file-local-copy'.
@ -3846,7 +3851,7 @@ BODY is the backend specific code."
;; 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")
'("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename")
(tramp-flush-file-properties v localname))
(condition-case err
(progn ,@body)

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

@ -153,7 +153,7 @@
tramp-error-show-message-timeout nil
tramp-persistency-file-name nil
tramp-verbose 0
vc-handled-backends nil)
vc-handled-backends (unless noninteractive vc-handled-backends))
(defconst tramp-test-name-prefix "tramp-test"
"Prefix to use for temporary test files.")
@ -2871,7 +2871,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
(tmp-name4
(file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Copy on remote side.
(,tmp-name1 . ,tmp-name2)
@ -2879,8 +2881,12 @@ This checks also `file-name-as-directory', `file-name-directory',
(,tmp-name1 . ,tmp-name3)
;; Copy from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(let* ((source (car source-target))
(source-link
(expand-file-name tmp-name4 (file-name-directory source)))
(target (cdr source-target))
(target-link
(expand-file-name tmp-name4 (file-name-directory target))))
;; Copy simple file.
(unwind-protect
@ -2905,6 +2911,26 @@ This checks also `file-name-as-directory', `file-name-directory',
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
;; Copy symlinked file.
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil source-link)
(should (file-exists-p source-link))
(make-symbolic-link tmp-name4 source)
(should (file-exists-p source))
(should (string-equal (file-symlink-p source) tmp-name4))
(copy-file source target)
;; Some backends like tramp-gvfs.el do not create the
;; link on the target.
(when (file-symlink-p target)
(should (string-equal (file-symlink-p target) tmp-name4))))
;; Cleanup.
(ignore-errors (delete-file source))
(ignore-errors (delete-file source-link))
(ignore-errors (delete-file target))
(ignore-errors (delete-file target-link)))
;; Copy file to directory.
(unwind-protect
;; This doesn't work on FTP.
@ -2980,7 +3006,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
(tmp-name4
(file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Rename on remote side.
(,tmp-name1 . ,tmp-name2)
@ -2988,8 +3016,12 @@ This checks also `file-name-as-directory', `file-name-directory',
(,tmp-name1 . ,tmp-name3)
;; Rename from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(let* ((source (car source-target))
(source-link
(expand-file-name tmp-name4 (file-name-directory source)))
(target (cdr source-target))
(target-link
(expand-file-name tmp-name4 (file-name-directory target))))
;; Rename simple file.
(unwind-protect
@ -3018,6 +3050,27 @@ This checks also `file-name-as-directory', `file-name-directory',
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
;; Rename symlinked file.
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil source-link)
(should (file-exists-p source-link))
(make-symbolic-link tmp-name4 source)
(should (file-exists-p source))
(should (string-equal (file-symlink-p source) tmp-name4))
(rename-file source target)
(should-not (file-exists-p source))
;; Some backends like tramp-gvfs.el do not create the
;; link on the target.
(when (file-symlink-p target)
(should (string-equal (file-symlink-p target) tmp-name4))))
;; Cleanup.
(ignore-errors (delete-file source))
(ignore-errors (delete-file source-link))
(ignore-errors (delete-file target))
(ignore-errors (delete-file target-link)))
;; Rename file to directory.
(unwind-protect
(progn
@ -3814,6 +3867,18 @@ This tests also `access-file', `file-readable-p',
(if quoted #'file-name-quote #'identity)
(file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2)
;; A non-existent link target makes the file unaccessible.
(make-symbolic-link "error" tmp-name2)
(should (file-symlink-p tmp-name2))
(should-error
(access-file tmp-name2 "error")
:type 'file-missing)
;; `file-ownership-preserved-p' should return t for
;; symlinked files to a non-existing target.
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(delete-file tmp-name2))
;; Check, that "//" in symlinks are handled properly.
@ -4463,13 +4528,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
(should-error
(file-truename tmp-name1)
(file-regular-p tmp-name1)
:type 'file-error)
(should-error
(file-truename tmp-name2)
(file-regular-p tmp-name2)
:type 'file-error))))
;; Cleanup.
@ -7390,10 +7453,6 @@ This requires restrictions of file name syntax."
(if quoted #'file-name-quote #'identity)
(file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file3)
(should (string-equal (buffer-string) elt)))
(delete-file file3))))
;; Check file names.