From d3f1682ae9f95ee912d9bc5a2ab5c58659abf065 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 22 Dec 2022 19:39:59 +0100 Subject: [PATCH] Handle make-directory return values in file name handlers * lisp/net/ange-ftp.el (ange-ftp-make-directory): Handle return values. * lisp/net/tramp.el (tramp-skeleton-make-directory): New defmacro. Handle also return values. * lisp/net/tramp-adb.el (tramp-adb-handle-make-directory): * lisp/net/tramp-crypt.el (tramp-crypt-handle-make-directory): * lisp/net/tramp-fuse.el (tramp-fuse-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): Use it. * test/lisp/net/tramp-tests.el (tramp-test13-make-directory): Handle return values. --- lisp/net/ange-ftp.el | 5 +++-- lisp/net/tramp-adb.el | 19 +++++-------------- lisp/net/tramp-crypt.el | 11 ++--------- lisp/net/tramp-fuse.el | 10 ++-------- lisp/net/tramp-gvfs.el | 26 ++++++-------------------- lisp/net/tramp-sh.el | 13 ++----------- lisp/net/tramp-smb.el | 32 ++++++++------------------------ lisp/net/tramp-sudoedit.el | 13 ++----------- lisp/net/tramp.el | 21 +++++++++++++++++++++ test/lisp/net/tramp-tests.el | 15 +++++++++++---- 10 files changed, 62 insertions(+), 103 deletions(-) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 9781ebf863a..f8e2858bc3f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4129,7 +4129,7 @@ directory, so that Emacs will know its current contents." (or (file-exists-p parent) (ange-ftp-make-directory parent parents)))) (if (file-exists-p dir) - (unless parents + (if parents t (signal 'file-already-exists (list "Cannot make directory: file already exists" dir))) @@ -4158,7 +4158,8 @@ directory, so that Emacs will know its current contents." (format "Could not make directory %s: %s" dir (cdr result)))) - (ange-ftp-add-file-entry dir t)) + (ange-ftp-add-file-entry dir t) + nil) (ange-ftp-real-make-directory dir))))) (defun ange-ftp-delete-directory (dir &optional recursive trash) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 90020fbb1b6..5a025130ecf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -411,20 +411,11 @@ Emacs dired can't find files." (defun tramp-adb-handle-make-directory (dir &optional parents) "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 dir)) - (when parents - (let ((par (expand-file-name ".." dir))) - (unless (file-directory-p par) - (make-directory par parents)))) - (tramp-flush-directory-properties v localname) - (unless (or (tramp-adb-send-command-and-check - v (format "mkdir -m %#o %s" - (default-file-modes) - (tramp-shell-quote-argument localname))) - (and parents (file-directory-p dir))) + (tramp-skeleton-make-directory dir parents + (unless (tramp-adb-send-command-and-check + v (format "mkdir -m %#o %s" + (default-file-modes) + (tramp-shell-quote-argument localname))) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-adb-handle-delete-directory (directory &optional recursive trash) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 249b3fcd4d7..e6c0ebccbff 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -800,16 +800,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) + (tramp-skeleton-make-directory dir parents (let (tramp-crypt-enabled) - (make-directory (tramp-crypt-encrypt-file-name dir) parents)) - ;; 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. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (make-directory (tramp-crypt-encrypt-file-name dir) parents)))) (defun tramp-crypt-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index ea6b5a0622c..5176c6e9c48 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -127,14 +127,8 @@ (defun tramp-fuse-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (make-directory (tramp-fuse-local-file-name dir) parents) - ;; 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 file cache. - (tramp-flush-file-properties v localname) - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (tramp-skeleton-make-directory dir parents + (make-directory (tramp-fuse-local-file-name dir) parents))) ;; File name helper functions. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index da7641774fb..66f4de989d0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1560,27 +1560,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-make-directory (dir &optional parents) "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 dir)) - (tramp-flush-directory-properties v localname) + (tramp-skeleton-make-directory dir parents (save-match-data - (let ((ldir (file-name-directory dir))) - ;; Make missing directory parts. "gvfs-mkdir -p ..." does not - ;; work robust. - (when (and parents (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (or (when-let ((mkdir-succeeded - (and - (tramp-gvfs-send-command - v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) - (tramp-gvfs-info dir)))) - (set-file-modes dir (default-file-modes)) - mkdir-succeeded) - (and parents (file-directory-p dir)) - (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) + (if (and (tramp-gvfs-send-command + v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) + (tramp-gvfs-info dir)) + (set-file-modes dir (default-file-modes)) + (tramp-error v 'file-error "Couldn't make directory %s" dir))))) (defun tramp-gvfs-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6087f16431e..19c160f4d6d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2559,19 +2559,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-make-directory (dir &optional parents) "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 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. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (tramp-barf-unless-okay v (format "%s -m %#o %s" - (if parents "mkdir -p" "mkdir") - (default-file-modes) + "mkdir" (default-file-modes) (tramp-shell-quote-argument localname)) "Couldn't make directory %s" dir))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cd73b9b8eca..b51f42deb45 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1172,30 +1172,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (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 dir)) - (let* ((ldir (file-name-directory dir))) - ;; Make missing directory parts. - (when (and parents - (tramp-smb-get-share v) - (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (when (file-directory-p ldir) - (tramp-smb-send-command - v (if (tramp-smb-get-cifs-capabilities v) - (format "posix_mkdir %s %o" - (tramp-smb-shell-quote-localname v) (default-file-modes)) - (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir))))) + (tramp-skeleton-make-directory dir parents + (tramp-smb-send-command + v (if (tramp-smb-get-cifs-capabilities v) + (format "posix_mkdir %s %o" + (tramp-smb-shell-quote-localname v) (default-file-modes)) + (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) + (unless (file-directory-p dir) + (tramp-error v 'file-error "Couldn't make directory %s" dir)))) ;; This is not used anymore. (defun tramp-smb-handle-make-directory-internal (directory) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index fcc27dd8343..8774367cefe 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -626,18 +626,9 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-make-directory (dir &optional parents) "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. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (unless (tramp-sudoedit-send-command - v (if parents '("mkdir" "-p") "mkdir") - "-m" (format "%#o" (default-file-modes)) + v "mkdir" "-m" (format "%#o" (default-file-modes)) (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ca8963fbf54..e39c9ccc31a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3537,6 +3537,27 @@ BODY is the backend specific code." ;; Trigger the `file-missing' error. (signal 'error nil))))) +(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body) + "Skeleton for `tramp-*-handle-make-directory'. +BODY is the backend specific code." + ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers + ;; anymore. And the return values are specified since then as well. + (declare (indent 2) (debug t)) + `(let* ((dir (directory-file-name (expand-file-name ,dir))) + (par (file-name-directory dir))) + (with-parsed-tramp-file-name dir nil + (when (and (null ,parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists dir)) + ;; Make missing directory parts. + (when ,parents + (unless (file-directory-p par) + (make-directory par ,parents))) + ;; Just do it. + (if (file-exists-p dir) t + (tramp-flush-file-properties v localname) + ,@body + nil)))) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 79b2fc803d6..d7f4576335c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2857,6 +2857,7 @@ This checks also `file-name-as-directory', `file-name-directory', This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) + ;; Since Emacs 29.1, `make-directory' has defined return values. (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo/bar" tmp-name1)) @@ -2865,7 +2866,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (unwind-protect (progn (with-file-modes unusual-file-mode-1 - (make-directory tmp-name1)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name1)) + (make-directory tmp-name1))) (should-error (make-directory tmp-name1) :type 'file-already-exists) @@ -2878,15 +2881,19 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name2) :type 'file-error) (with-file-modes unusual-file-mode-2 - (make-directory tmp-name2 'parents)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2)) (when (tramp--test-supports-set-file-modes-p) (should (equal (format "%#o" unusual-file-mode-2) (format "%#o" (file-modes tmp-name2))))) ;; If PARENTS is non-nil, `make-directory' shall not - ;; signal an error when DIR exists already. - (make-directory tmp-name2 'parents)) + ;; signal an error when DIR exists already. It returns t. + (if (tramp--test-emacs29-p) + (should (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -- 2.39.2