mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
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.
This commit is contained in:
Michael Albinus
parent
dcc3ef3ee7
commit
cc7530cae0
@ -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 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))
|
||||
|
||||
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."))
|
||||
(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? "
|
||||
l-localname)))))
|
||||
(tramp-error l 'file-already-exists l-localname)
|
||||
(delete-file linkname)))
|
||||
;; 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 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)))))
|
||||
;; 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 l (file-name-directory l-localname))
|
||||
(tramp-flush-file-property l l-localname)
|
||||
(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 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)))))))))
|
||||
;; 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 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))
|
||||
|
||||
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)
|
||||
(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
|
||||
"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)))
|
||||
(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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user