[Emacs-diffs] master 3a19e6e: Further fixes in tramp-smb.el

[Michael Albinus]

branch: master
commit 3a19e6ec235dc0496d3c406073b92b6d45588c9a
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Further fixes in tramp-smb.el
    
    * lisp/net/tramp-smb.el (tramp-smb-handle-file-truename): New defun.
    (tramp-smb-file-name-handler-alist): Use it.
    (tramp-smb-handle-make-symbolic-link): Unquote target.
    
    * test/lisp/net/tramp-tests.el
    (tramp--test-ignore-make-symbolic-link-error): New defmacro.
    (tramp-test18-file-attributes, tramp-test21-file-links)
    (tramp--test-check-files): Use it.
---
 lisp/net/tramp-smb.el        |  24 ++++++-
 test/lisp/net/tramp-tests.el | 148 ++++++++++++++++++++-----------------------
 2 files changed, 91 insertions(+), 81 deletions(-)

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 920e103..0b05cdb 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -253,7 +253,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-remote-p . tramp-handle-file-remote-p)
     ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
-    ;; `file-truename' performed by default handler.
+    (file-truename . tramp-smb-handle-file-truename)
     (file-writable-p . tramp-smb-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `find-file-noselect' performed by default handler.
@@ -947,6 +947,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                (nth 0 x))))
           (tramp-smb-get-file-entries directory))))))))
 
+(defun tramp-smb-handle-file-truename (filename)
+  "Like `file-truename' for Tramp files."
+  (format
+   "%s%s"
+   (with-parsed-tramp-file-name (expand-file-name filename) nil
+     (tramp-make-tramp-file-name
+      method user domain host port
+      (with-tramp-file-property v localname "file-truename"
+       (funcall
+        (if (tramp-compat-file-name-quoted-p localname)
+            'tramp-compat-file-name-quote 'identity)
+        ;; We don't follow symlink of symlink.
+        (or (file-symlink-p filename) localname)))))
+
+   ;; Preserve trailing "/".
+   (if (string-equal (file-name-nondirectory filename) "") "/" "")))
+
 (defun tramp-smb-handle-file-writable-p (filename)
   "Like `file-writable-p' for Tramp files."
   (if (file-exists-p filename)
@@ -1147,8 +1164,9 @@ component is used as the target of the symlink."
 
       (unless
          (tramp-smb-send-command
-          v
-          (format "symlink \"%s\" \"%s\"" target (tramp-smb-get-localname v)))
+          v (format "symlink \"%s\" \"%s\""
+                    (tramp-compat-file-name-unquote target)
+                    (tramp-smb-get-localname v)))
        (tramp-error
         v 'file-error
         "error with make-symbolic-link, see buffer `%s' for details"
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e7a55c4..201ac10 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2374,6 +2374,20 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
        (ignore-errors (delete-directory tmp-name1 'recursive))
        (ignore-errors (delete-directory tmp-name2 'recursive))))))
 
+;; Method "smb" supports `make-symbolic-link' only if the remote host
+;; has CIFS capabilities.  tramp-adb.el and tramp-gvfs.el do not
+;; support symbolic links at all.
+(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
+  "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
+  (declare (indent defun) (debug t))
+  `(condition-case err
+       (progn ,@body)
+     ((error quit debug)
+      (unless (and (eq (car err) 'file-error)
+                  (string-equal (error-message-string err)
+                                "make-symbolic-link not supported"))
+       (signal (car err) (cdr err))))))
+
 (ert-deftest tramp-test18-file-attributes ()
   "Check `file-attributes'.
 This tests also `file-readable-p', `file-regular-p' and
@@ -2429,26 +2443,22 @@ This tests also `file-readable-p', `file-regular-p' and
            (should (stringp (nth 2 attr))) ;; Uid.
            (should (stringp (nth 3 attr))) ;; Gid.
 
-           (condition-case err
-               (progn
-                 (when (tramp--test-sh-p)
-                   (should (file-ownership-preserved-p tmp-name2 'group)))
-                 (make-symbolic-link tmp-name1 tmp-name2)
-                 (should (file-exists-p tmp-name2))
-                 (should (file-symlink-p tmp-name2))
-                 (when (tramp--test-sh-p)
-                   (should (file-ownership-preserved-p tmp-name2 'group)))
-                 (setq attr (file-attributes tmp-name2))
-                 (should
-                  (string-equal
-                   (funcall
-                    (if quoted 'tramp-compat-file-name-quote 'identity)
-                    (car attr))
-                   (file-remote-p (file-truename tmp-name1) 'localname)))
-                 (delete-file tmp-name2))
-             (file-error
-              (should (string-equal (error-message-string err)
-                                    "make-symbolic-link not supported"))))
+           (tramp--test-ignore-make-symbolic-link-error
+             (when (tramp--test-sh-p)
+               (should (file-ownership-preserved-p tmp-name2 'group)))
+             (make-symbolic-link tmp-name1 tmp-name2)
+             (should (file-exists-p tmp-name2))
+             (should (file-symlink-p tmp-name2))
+             (when (tramp--test-sh-p)
+               (should (file-ownership-preserved-p tmp-name2 'group)))
+             (setq attr (file-attributes tmp-name2))
+             (should
+              (string-equal
+               (funcall
+                (if quoted 'tramp-compat-file-name-quote 'identity)
+                (car attr))
+               (file-remote-p (file-truename tmp-name1) 'localname)))
+             (delete-file tmp-name2))
 
            ;; Check, that "//" in symlinks are handled properly.
            (with-temp-buffer
@@ -2574,18 +2584,10 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
 
       ;; Check `make-symbolic-link'.
       (unwind-protect
-         (progn
+         (tramp--test-ignore-make-symbolic-link-error
            (write-region "foo" nil tmp-name1)
            (should (file-exists-p tmp-name1))
-           ;; Method "smb" supports `make-symbolic-link' only if the
-           ;; remote host has CIFS capabilities.  tramp-adb.el and
-           ;; tramp-gvfs.el do not support symbolic links at all.
-           (condition-case err
-               (make-symbolic-link tmp-name1 tmp-name2)
-             (file-error
-              (skip-unless
-               (not (string-equal (error-message-string err)
-                                  "make-symbolic-link not supported")))))
+           (make-symbolic-link tmp-name1 tmp-name2)
            (should
             (string-equal
              (funcall
@@ -2659,7 +2661,9 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (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)))
+           (should-error
+            (add-name-to-file tmp-name1 tmp-name3)
+            :type 'file-error))
 
        ;; Cleanup.
        (ignore-errors
@@ -2668,7 +2672,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
 
       ;; Check `file-truename'.
       (unwind-protect
-         (progn
+         (tramp--test-ignore-make-symbolic-link-error
            (write-region "foo" nil tmp-name1)
            (should (file-exists-p tmp-name1))
            (make-symbolic-link tmp-name1 tmp-name2)
@@ -3615,31 +3619,23 @@ This requires restrictions of file name syntax."
                (copy-file file2 tmp-name1)
                (should (file-exists-p file1))
 
-               ;; Method "smb" supports `make-symbolic-link' only if the
-               ;; remote host has CIFS capabilities.  tramp-adb.el and
-               ;; tramp-gvfs.el do not support symbolic links at all.
-               (condition-case err
-                   (progn
-                     (make-symbolic-link file1 file3)
-                     (should (file-symlink-p file3))
-                     (should
-                      (string-equal
-                       (expand-file-name file1) (file-truename file3)))
-                     (should
-                      (string-equal
-                       (funcall
-                        (if quoted 'tramp-compat-file-name-quote 'identity)
-                        (car (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))
-                 (file-error
-                  (should
-                   (string-equal (error-message-string err)
-                                 "make-symbolic-link not supported"))))))
+               (tramp--test-ignore-make-symbolic-link-error
+                 (make-symbolic-link file1 file3)
+                 (should (file-symlink-p file3))
+                 (should
+                  (string-equal
+                   (expand-file-name file1) (file-truename file3)))
+                 (should
+                  (string-equal
+                   (funcall
+                    (if quoted 'tramp-compat-file-name-quote 'identity)
+                    (car (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.
            (should (equal (directory-files
@@ -3692,27 +3688,23 @@ This requires restrictions of file name syntax."
                  elt))
 
                ;; Check symlink in `directory-files-and-attributes'.
-               (condition-case err
-                   (progn
-                     (make-symbolic-link file2 file3)
-                     (should (file-symlink-p file3))
-                     (should
-                      (string-equal
-                       (caar (directory-files-and-attributes
-                              file1 nil (regexp-quote elt1)))
-                       elt1))
-                     (should
-                      (string-equal
-                       (funcall
-                        (if quoted 'tramp-compat-file-name-quote 'identity)
-                        (cadr (car (directory-files-and-attributes
-                                    file1 nil (regexp-quote elt1)))))
-                       (file-remote-p (file-truename file2) 'localname)))
-                     (delete-file file3)
-                     (should-not (file-exists-p file3)))
-                 (file-error
-                  (should (string-equal (error-message-string err)
-                                        "make-symbolic-link not supported"))))
+               (tramp--test-ignore-make-symbolic-link-error
+                 (make-symbolic-link file2 file3)
+                 (should (file-symlink-p file3))
+                 (should
+                  (string-equal
+                   (caar (directory-files-and-attributes
+                          file1 nil (regexp-quote elt1)))
+                   elt1))
+                 (should
+                  (string-equal
+                   (funcall
+                    (if quoted 'tramp-compat-file-name-quote 'identity)
+                    (cadr (car (directory-files-and-attributes
+                                file1 nil (regexp-quote elt1)))))
+                   (file-remote-p (file-truename file2) 'localname)))
+                 (delete-file file3)
+                 (should-not (file-exists-p file3)))
 
                (delete-file file2)
                (should-not (file-exists-p file2))