Commit 79cc9445 authored by Michael Albinus's avatar Michael Albinus

Tramp cleanup

* lisp/net/tramp-sh.el (tramp-sh-extra-args): Remove compat code.
(tramp-sh-handle-make-symbolic-link): More robust check for
TARGET remoteness.

* lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory):
Disable copying by tar temporarily, it doesn't work reliably.
(tramp-smb-do-file-attributes-with-stat): Resolve symlink.
(tramp-smb-handle-make-symbolic-link): Fix implementation.

* lisp/net/tramp.el (tramp-handle-file-symlink-p): Simplify.

* test/lisp/net/tramp-tests.el (tramp-test21-file-links):
Extend test.
parent c9950764
......@@ -562,11 +562,7 @@ This variable is only used when Tramp needs to start up another shell
for tilde expansion. The extra arguments should typically prevent the
shell from reading its init file."
:group 'tramp
;; This might be the wrong way to test whether the widget type
;; `alist' is available. Who knows the right way to test it?
:type (if (get 'alist 'widget-type)
'(alist :key-type string :value-type string)
'(repeat (cons string string)))
:type '(alist :key-type regexp :value-type string)
:require 'tramp)
(defconst tramp-actions-before-shell
......@@ -1088,8 +1084,9 @@ component is used as the target of the symlink."
(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)))
(when (and (tramp-tramp-file-p target)
(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)))))
......
......@@ -430,7 +430,8 @@ pass to the OPERATION."
(delete-directory tmpdir 'recursive))))
;; We can copy recursively.
((and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
;; Does not work reliably.
(nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
(when (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory dirname)
(file-name-nondirectory newname))))
......@@ -888,6 +889,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1)))))) ;; year
(forward-line))
;; Resolve symlink.
(when (and (stringp id)
(tramp-smb-send-command
vec
(format "readlink \"%s\"" (tramp-smb-get-localname vec))))
(goto-char (point-min))
(and (looking-at ".+ -> \\(.+\\)")
(setq id (match-string 1))))
;; Return the result.
(list id link uid gid atime mtime ctime size mode nil inode
(tramp-get-device vec)))))))
......@@ -1105,47 +1116,43 @@ component is used as the target of the symlink."
(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
(with-parsed-tramp-file-name linkname nil
;; 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)))
(unless (tramp-smb-get-cifs-capabilities v)
(tramp-error v 'file-error "make-symbolic-link not supported"))
;; If TARGET is a Tramp name, use just the localname component.
(when (and (tramp-tramp-file-p target)
(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)))))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(unless
(tramp-smb-send-command
v
(format "symlink \"%s\" \"%s\"" target (tramp-smb-get-localname v)))
(tramp-error
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)))))))
"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)
......
......@@ -3065,12 +3065,8 @@ User is always nil."
(defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
(when (stringp x)
(if (file-name-absolute-p x)
(tramp-make-tramp-file-name method user domain host port x)
x)))))
(let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
(and (stringp x) x)))
(defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for Tramp files."
......
......@@ -2586,14 +2586,50 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless
(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)
:type 'file-already-exists)
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-unquote 'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists)
;; 0 means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-unquote 'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2))))
(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
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-unquote 'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
;; If we use the local part of `tmp-name1', it shall still work.
(make-symbolic-link
(file-remote-p tmp-name1 'localname)
tmp-name2 'ok-if-already-exists)
(should
(string-equal
(funcall
(if quoted 'tramp-compat-file-name-unquote 'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
;; `tmp-name3' is a local file name. Therefore, the link
;; target remains unchanged, even if quoted.
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3)))
(should
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
;; Cleanup.
(ignore-errors
......@@ -2607,11 +2643,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(write-region "foo" nil tmp-name1)
(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)
:type 'file-already-exists)
(should (file-regular-p tmp-name2))
(should-error
(add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
;; 0 means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(add-name-to-file tmp-name1 tmp-name2 0)
(should (file-regular-p tmp-name2)))
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
(should-not (file-symlink-p tmp-name2))
(should (file-regular-p tmp-name2))
;; `tmp-name3' is a local file name.
(should-error (add-name-to-file tmp-name1 tmp-name3)))
......@@ -2640,8 +2686,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should
(string-equal
(file-truename tmp-name1)
(funcall
'tramp-compat-file-name-unquote (file-truename tmp-name3)))))
(tramp-compat-file-name-unquote (file-truename tmp-name3)))))
;; Cleanup.
(ignore-errors
......
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