[Emacs-diffs] master cc7530c: Fix Tramp part of Bug#28156

[Michael Albinus]

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

    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.
---
 lisp/files.el                |   2 +-
 lisp/net/tramp-sh.el         | 129 ++++++++++++++++++++++---------------------
 lisp/net/tramp-smb.el        | 115 +++++++++++++++++++-------------------
 lisp/net/tramp.el            |  28 ++++++++--
 test/lisp/net/tramp-tests.el |  30 ++++++++--
 5 files changed, 173 insertions(+), 131 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 77ebd94..ca3b055 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 50b3801..6251248 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 367beb8..f734b80 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ef3e62c..bb68b9e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 55f4b52..3dbb522 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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)