[Emacs-diffs] master 79cc944: Tramp cleanup

[Michael Albinus]

branch: master
commit 79cc9445e182ad5d80380ccf677b947d76854ce8
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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.
---
 lisp/net/tramp-sh.el         | 11 ++----
 lisp/net/tramp-smb.el        | 87 ++++++++++++++++++++++++--------------------
 lisp/net/tramp.el            |  8 +---
 test/lisp/net/tramp-tests.el | 67 ++++++++++++++++++++++++++++------
 4 files changed, 109 insertions(+), 64 deletions(-)

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6251248..6494b09 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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)))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f734b80..920e103 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index bb68b9e..1a5cda7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3dbb522..e7a55c4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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