Commit da2df1c1 authored by Michael Albinus's avatar Michael Albinus

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.
parent d30f5e7e
Pipeline #3952 failed with stage
in 65 minutes and 9 seconds
......@@ -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)
......
......@@ -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)))
......
......@@ -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.
......
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -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)))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment