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.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index a4f5760f72e6017fc6ee278030d89555bc43e917..cfbda0824e77680602303e5e9ecd870a8d5e0cbb 100644 (file)
--- 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 dbda24b9ac1099c6ac654fc7211152893ed481b4..f13564c544eadae82120362dd942c7dcba4230a8 100644 (file)
--- 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 be531ed31929fc1e13f5d7f61d266270e4053ad1..76bb10a277f83e1096a6c8393dd3b610f5f722d7 100644 (file)
--- 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 f87d4becfe0b666e8068801e2b669879972ee5a5..95cdb4cbffe0333a856874d2cd5e815a59c1e89e 100644 (file)
--- 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 e7a892c746595b70f8fc4866a6f210d7a1b756ef..43ac6ff66b30e6ad4fc22922e38cadc0fa0836f9 100644 (file)
--- 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 acb5a93687c2b3df7f4089d0671e7a41e86debec..09d125945a1eab333c12424b0cc7288dd08bd332 100644 (file)
--- 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 ec9cda0bbddc6f48f00cd600f04d255da7ece218..9b73f7ca28e3dc8e8b1949cfbd3422df47a43089 100644 (file)
--- 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)))))