master da2df1c: More error checks in Tramp's make-directory

[Michael Albinus]

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

    More error checks in Tramp's make-directory
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-directory):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory):
    * lisp/net/tramp-sh.el (tramp-sh-handle-make-directory):
    * lisp/net/tramp-smb.el (tramp-smb-handle-make-directory):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-directory):
    Signal `file-already-exists' if DIR exists.
    
    * test/lisp/net/tramp-tests.el (tramp-test04-substitute-in-file-name):
    Fix thinko.
    (tramp-test13-make-directory, tramp-test14-delete-directory)
    (tramp-test15-copy-directory): Extend tests.
---
 lisp/net/tramp-adb.el        |  2 ++
 lisp/net/tramp-gvfs.el       |  2 ++
 lisp/net/tramp-sh.el         |  2 ++
 lisp/net/tramp-smb.el        |  2 ++
 lisp/net/tramp-sudoedit.el   |  2 ++
 lisp/net/tramp.el            |  4 ++--
 test/lisp/net/tramp-tests.el | 23 +++++++++++++++++------
 7 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index a4f5760..cfbda08 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -514,6 +514,8 @@ Emacs dired can't find files."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (when parents
       (let ((par (expand-file-name ".." dir)))
        (unless (file-directory-p par)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index dbda24b..f13564c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1310,6 +1310,8 @@ file-notify events."
   "Like `make-directory' for Tramp files."
   (setq dir (directory-file-name (expand-file-name dir)))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (tramp-flush-directory-properties v localname)
     (save-match-data
       (let ((ldir (file-name-directory dir)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index be531ed..76bb10a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2513,6 +2513,8 @@ The method used must be an out-of-band method."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     ;; When PARENTS is non-nil, DIR could be a chain of non-existent
     ;; directories a/b/c/...  Instead of checking, we simply flush the
     ;; whole cache.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f87d4be..95cdb4c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1139,6 +1139,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
   (unless (file-name-absolute-p dir)
     (setq dir (expand-file-name dir default-directory)))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (let* ((ldir (file-name-directory dir)))
       ;; Make missing directory parts.
       (when (and parents
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e7a892c..43ac6ff 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -587,6 +587,8 @@ the result will be a local, non-Tramp, file name."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     ;; When PARENTS is non-nil, DIR could be a chain of non-existent
     ;; directories a/b/c/...  Instead of checking, we simply flush the
     ;; whole cache.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index acb5a93..09d1259 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3019,8 +3019,8 @@ User is always nil."
 (defun tramp-handle-copy-directory
   (directory newname &optional keep-date parents copy-contents)
   "Like `copy-directory' for Tramp files."
-  ;; `directory-files' creates `newname' before running this check.
-  ;; So we do it ourselves.
+  ;; `copy-directory' creates NEWNAME before running this check.  So
+  ;; we do it ourselves.
   (unless (file-exists-p directory)
     (tramp-error
      (tramp-dissect-file-name directory) tramp-file-missing
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index ec9cda0..9b73f7c 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1958,7 +1958,7 @@ properly.  BODY shall not contain a timeout."
 
     ;; Forwhatever reasons, the following tests let Emacs crash for
     ;; Emacs 24 and Emacs 25, occasionally. No idea what's up.
-    (when (or (tramp--test-emacs26-p) (tramp--test-emacs27-p))
+    (when (tramp--test-emacs26-p)
       (should
        (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
       (should
@@ -2593,9 +2593,14 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
       (unwind-protect
          (progn
            (make-directory tmp-name1)
+           (should-error
+            (make-directory tmp-name1)
+            :type 'file-already-exists)
            (should (file-directory-p tmp-name1))
            (should (file-accessible-directory-p tmp-name1))
-           (should-error (make-directory tmp-name2) :type 'file-error)
+           (should-error
+            (make-directory tmp-name2)
+            :type 'file-error)
            (make-directory tmp-name2 'parents)
            (should (file-directory-p tmp-name2))
            (should (file-accessible-directory-p tmp-name2))
@@ -2627,7 +2632,9 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
       (should (file-directory-p tmp-name2))
       (write-region "foo" nil (expand-file-name "bla" tmp-name2))
       (should (file-exists-p (expand-file-name "bla" tmp-name2)))
-      (should-error (delete-directory tmp-name1) :type 'file-error)
+      (should-error
+       (delete-directory tmp-name1)
+       :type 'file-error)
       (delete-directory tmp-name1 'recursive)
       (should-not (file-directory-p tmp-name1)))))
 
@@ -2663,7 +2670,7 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
            (when (tramp--test-emacs26-p)
              (should-error
               (copy-directory tmp-name1 tmp-name2)
-              :type 'file-error))
+              :type 'file-already-exists))
            (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
            (should (file-directory-p tmp-name3))
            (should (file-exists-p tmp-name6)))
@@ -3523,7 +3530,9 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                  :type 'file-error)
               (make-symbolic-link tmp-name1 tmp-name2)
               (should (file-symlink-p tmp-name2))
-              (should-error (file-truename tmp-name1) :type 'file-error))))
+              (should-error
+               (file-truename tmp-name1)
+               :type 'file-error))))
 
        ;; Cleanup.
        (ignore-errors
@@ -4276,7 +4285,9 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (while (accept-process-output proc nil nil 0)))
          (should-not (process-live-p proc))
          ;; An interrupted process cannot be interrupted, again.
-         (should-error (interrupt-process proc) :type 'error))
+         (should-error
+          (interrupt-process proc)
+          :type 'error))
 
       ;; Cleanup.
       (ignore-errors (delete-process proc)))))