Commit cc7530ca authored by Michael Albinus's avatar Michael Albinus

Fix Tramp part of Bug#28156

* lisp/files.el (file-name-non-special): Use `file-name-quote'
instead prefixing "/:", the file could already be quoted.

* lisp/net/tramp.el (tramp-error): Handle null arguments.
(tramp-handle-make-symbolic-link):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
(tramp-sh-handle-add-name-to-file):
* lisp/net/tramp-smb.el (tramp-smb-handle-add-name-to-file)
(tramp-smb-handle-make-symbolic-link): Adapt implementation to
stronger semantics in Emacs.  (Bug#28156)

* test/lisp/net/tramp-tests.el (tramp-test21-file-links):
Extend test.
parent dcc3ef3e
......@@ -6955,7 +6955,7 @@ only these files will be asked to be saved."
(setq file-arg-indices (cdr file-arg-indices))))
(pcase method
(`identity (car arguments))
(`add (concat "/:" (apply operation arguments)))
(`add (file-name-quote (apply operation arguments)))
(`insert-file-contents
(let ((visit (nth 1 arguments)))
(unwind-protect
......
......@@ -1057,62 +1057,61 @@ Operations not mentioned here will be handled by the normal Emacs functions.")
;;; File Name Handler Functions:
(defun tramp-sh-handle-make-symbolic-link
(filename linkname &optional ok-if-already-exists)
(target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
If LINKNAME is a non-Tramp file, it is used verbatim as the target of
the symlink. If LINKNAME is a Tramp file, only the localname component is
used as the target of the symlink.
If LINKNAME is a Tramp file and the localname component is relative, then
it is expanded first, before the localname component is taken. Note that
this can give surprising results if the user/host for the source and
target of the symlink differ."
(with-parsed-tramp-file-name linkname l
(let ((ln (tramp-get-remote-ln l))
(cwd (tramp-run-real-handler
'file-name-directory (list l-localname))))
(unless ln
(tramp-error
l 'file-error
"Making a symbolic link. ln(1) does not exist on the remote host."))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
;; What to do?
(if (or (null ok-if-already-exists) ; not allowed to exist
(and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
l-localname)))))
(tramp-error l 'file-already-exists l-localname)
(delete-file linkname)))
;; If FILENAME is a Tramp name, use just the localname component.
(when (tramp-tramp-file-p filename)
(setq filename
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name filename)))))
(tramp-flush-file-property l (file-name-directory l-localname))
(tramp-flush-file-property l l-localname)
;; Right, they are on the same host, regardless of user, method,
;; etc. We now make the link on the remote machine. This will
;; occur as the user that FILENAME belongs to.
(and (tramp-send-command-and-check
l (format "cd %s" (tramp-shell-quote-argument cwd)))
(tramp-send-command-and-check
l (format
"%s -sf %s %s"
ln
(tramp-shell-quote-argument filename)
;; The command could exceed PATH_MAX, so we use
;; relative file names. However, relative file names
;; could start with "-". `tramp-shell-quote-argument'
;; does not handle this, we must do it ourselves.
(tramp-shell-quote-argument
(concat "./" (file-name-nondirectory l-localname)))))))))
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
(if (not (tramp-tramp-file-p (expand-file-name linkname)))
(tramp-run-real-handler
'make-symbolic-link (list target linkname ok-if-already-exists))
(with-parsed-tramp-file-name linkname nil
(let ((ln (tramp-get-remote-ln v))
(cwd (tramp-run-real-handler
'file-name-directory (list localname))))
(unless ln
(tramp-error
v 'file-error
"Making a symbolic link. ln(1) does not exist on the remote host."))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
;; What to do?
(if (or (null ok-if-already-exists) ; not allowed to exist
(and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
localname)))))
(tramp-error v 'file-already-exists localname)
(delete-file linkname)))
;; If TARGET is a Tramp name, use just the localname component.
(when (tramp-file-name-equal-p
v (tramp-dissect-file-name (expand-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target)))))
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
;; Right, they are on the same host, regardless of user, method,
;; etc. We now make the link on the remote machine. This will
;; occur as the user that TARGET belongs to.
(and (tramp-send-command-and-check
v (format "cd %s" (tramp-shell-quote-argument cwd)))
(tramp-send-command-and-check
v (format
"%s -sf %s %s" ln
(tramp-shell-quote-argument target)
;; The command could exceed PATH_MAX, so we use
;; relative file names. However, relative file names
;; could start with "-". `tramp-shell-quote-argument'
;; does not handle this, we must do it ourselves.
(tramp-shell-quote-argument
(concat "./" (file-name-nondirectory localname))))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
......@@ -1918,14 +1917,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
(when (and (numberp ok-if-already-exists)
(file-exists-p newname)
(yes-or-no-p
(format
"File %s already exists; make it a new name anyway? "
newname)))
(tramp-error v2 'file-already-exists newname))
(when ok-if-already-exists (setq ln (concat ln " -f")))
;; Do the 'confirm if exists' thing.
(when (file-exists-p newname)
;; What to do?
(if (or (null ok-if-already-exists) ; not allowed to exist
(and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
v2-localname)))))
(tramp-error v2 'file-already-exists newname)
(delete-file newname)))
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(tramp-barf-unless-okay
......
......@@ -354,16 +354,17 @@ pass to the OPERATION."
(tramp-error
v2 'file-error
"add-name-to-file: %s must not be a directory" filename))
(when (and (not ok-if-already-exists)
(file-exists-p newname)
(not (numberp ok-if-already-exists))
(y-or-n-p
(format
"File %s already exists; make it a new name anyway? "
newname)))
(tramp-error
v2 'file-error
"add-name-to-file: file %s already exists" newname))
;; Do the 'confirm if exists' thing.
(when (file-exists-p newname)
;; What to do?
(if (or (null ok-if-already-exists) ; not allowed to exist
(and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
v2-localname)))))
(tramp-error v2 'file-already-exists newname)
(delete-file newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v2 (file-name-directory v2-localname))
......@@ -1095,54 +1096,56 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
v 'file-error "Couldn't make directory %s" directory))))))
(defun tramp-smb-handle-make-symbolic-link
(filename linkname &optional ok-if-already-exists)
(target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
If LINKNAME is a non-Tramp file, it is used verbatim as the target of
the symlink. If LINKNAME is a Tramp file, only the localname component is
used as the target of the symlink.
If LINKNAME is a Tramp file and the localname component is relative, then
it is expanded first, before the localname component is taken. Note that
this can give surprising results if the user/host for the source and
target of the symlink differ."
(unless (tramp-equal-remote filename linkname)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename linkname) nil
(tramp-error
v 'file-error
"make-symbolic-link: %s"
"only implemented for same method, same user, same host")))
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name linkname v2
(when (file-directory-p filename)
(tramp-error
v2 'file-error
"make-symbolic-link: %s must not be a directory" filename))
(when (and (not ok-if-already-exists)
(file-exists-p linkname)
(not (numberp ok-if-already-exists))
(y-or-n-p
(format
"File %s already exists; make it a new name anyway? "
linkname)))
(tramp-error v2 'file-already-exists linkname))
(unless (tramp-smb-get-cifs-capabilities v1)
(tramp-error v2 'file-error "make-symbolic-link not supported"))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(unless
(tramp-smb-send-command
v1
(format
"symlink \"%s\" \"%s\""
(tramp-smb-get-localname v1)
(tramp-smb-get-localname v2)))
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
(if (not (tramp-tramp-file-p (expand-file-name linkname)))
(tramp-run-real-handler
'make-symbolic-link (list target linkname ok-if-already-exists))
(unless (tramp-equal-remote target linkname)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p target) target linkname) nil
(tramp-error
v2 'file-error
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name))))))
v 'file-error
"make-symbolic-link: %s"
"only implemented for same method, same user, same host")))
(with-parsed-tramp-file-name target v1
(with-parsed-tramp-file-name linkname v2
(when (file-directory-p target)
(tramp-error
v2 'file-error
"make-symbolic-link: %s must not be a directory" target))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
;; What to do?
(if (or (null ok-if-already-exists) ; not allowed to exist
(and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
v2-localname)))))
(tramp-error v2 'file-already-exists v2-localname)
(delete-file linkname)))
(unless (tramp-smb-get-cifs-capabilities v1)
(tramp-error v2 'file-error "make-symbolic-link not supported"))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(unless
(tramp-smb-send-command
v1
(format
"symlink \"%s\" \"%s\""
(tramp-smb-get-localname v1)
(tramp-smb-get-localname v2)))
(tramp-error
v2 'file-error
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name)))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
......
......@@ -1597,6 +1597,12 @@ signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised."
(let (tramp-message-show-message)
(tramp-backtrace vec-or-proc)
(unless arguments
;; FMT-STRING could be just a file name, as in
;; `file-already-exists' errors. It could contain the ?\%
;; character, as in smb domain spec.
(setq arguments (list fmt-string)
fmt-string "%s"))
(when vec-or-proc
(tramp-message
vec-or-proc 1 "%s"
......@@ -2009,6 +2015,11 @@ ARGS are the arguments OPERATION has been called with."
'(add-name-to-file copy-directory copy-file expand-file-name
file-equal-p file-in-directory-p
file-name-all-completions file-name-completion
;; Starting with Emacs 26.1, just the 2nd argument of
;; `make-symbolic-link' matters. For backward
;; compatibility, we still accept the first argument as
;; file name to be checked. Handled properly in
;; `tramp-handle-*-make-symbolic-link'.
file-newer-than-file-p make-symbolic-link rename-file))
(save-match-data
(cond
......@@ -3262,11 +3273,18 @@ User is always nil."
t)))
(defun tramp-handle-make-symbolic-link
(filename linkname &optional _ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename linkname) nil
(tramp-error v 'file-error "make-symbolic-link not supported")))
(target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
This is the fallback implementation for backends which do not
support symbolic links."
(if (tramp-tramp-file-p (expand-file-name linkname))
(tramp-error
(tramp-dissect-file-name (expand-file-name linkname)) 'file-error
"make-symbolic-link not supported")
;; This is needed prior Emacs 26.1, where TARGET has also be
;; checked for a file name handler.
(tramp-run-real-handler
'make-symbolic-link (list target linkname ok-if-already-exists))))
(defun tramp-handle-shell-command
(command &optional output-buffer error-buffer)
......
......@@ -2587,16 +2587,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(not (string-equal (error-message-string err)
"make-symbolic-link not supported")))))
(should (file-symlink-p tmp-name2))
(should-error (make-symbolic-link tmp-name1 tmp-name2))
(should-error (make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists)
(make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
(should (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (make-symbolic-link tmp-name1 tmp-name3)))
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3)))
;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
(delete-file tmp-name2)
(delete-file tmp-name3)))
;; Check `add-name-to-file'.
(unwind-protect
......@@ -2605,7 +2608,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-exists-p tmp-name1))
(add-name-to-file tmp-name1 tmp-name2)
(should-not (file-symlink-p tmp-name2))
(should-error (add-name-to-file tmp-name1 tmp-name2))
(should-error (add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
(should-not (file-symlink-p tmp-name2))
;; `tmp-name3' is a local file name.
......@@ -2626,10 +2630,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2))
;; `tmp-name3' is a local file name.
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3))
(should-not (string-equal tmp-name3 (file-truename tmp-name3)))
;; `file-truename' returns a quoted file name for `tmp-name3'.
;; We must unquote it.
(should
(string-equal
(file-truename tmp-name1)
(funcall
'tramp-compat-file-name-unquote (file-truename tmp-name3)))))
;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
(delete-file tmp-name2)
(delete-file tmp-name3)))
;; `file-truename' shall preserve trailing link of directories.
(unless (file-symlink-p tramp-test-temporary-file-directory)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment