bug#58919: 28.2; dired-copy-file-recursive fails to overwrite directory

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 630 bytes --]

On 12/11/22 02:46, Eli Zaretskii wrote:
> Paul, did you have an opportunity to come up with the patch you
> mentioned in this discussion?  I'd like to solve this bug for Emacs
> 29, please.

I hacked on it for a bit and came up with the attached proposed patches 
to the emacs-29 branch. I have not installed them.

These patches address the issues raised by Michael by passing only 
single arguments to make-directory handlers. That way, we don't need to 
worry about whether the handlers follow the new convention. At our 
leisure, perhaps in Emacs 30, we can upgrade the make-directory handlers 
to support the new convention.

[-- Attachment #2: 0001-Use-make-directory-handlers-uniformly.patch --]
[-- Type: text/x-patch, Size: 6565 bytes --]

From bfbb463c6e1b74c96211e454c80d8588f187dcfb Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:47 -0800
Subject: [PATCH 1/3] Use make-directory handlers uniformly

Formerly, the code supported both make-directory and
make-directory-internal handlers. This led to confusion and meant than
in a few cases (nnmaildir, ido) remote directories could not be used in
some cases.  Fix this by using only make-directory handlers.

Perhaps there used to be a reason for why there were both
make-directory and make-directory-internal handlers, but whatever that
reason was, it seems to have vanished even before now.

There is no longer any need for make-directory-internal handlers, as
the few remaining callers that use make-directory-internal do so only
when there are no handlers.  However, this change keeps the existing
make-directory-internal handlers for now, in case this code is ever
used in older Emacs versions that still call those handlers.

* lisp/gnus/nnmaildir.el (nnmaildir--mkdir):
* lisp/ido.el (ido-file-internal):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-directory):
Use make-directory, not make-directory-internal.
* lisp/net/tramp-smb.el (tramp-smb-handle-make-directory-internal):
Now obsolete.
* src/fileio.c (Fmake_directory_internal): Do not look for or
use a make-directory-internal handler.
* test/lisp/files-tests.el:
(files-tests-file-name-non-special-make-directory-internal):
Remove, as this test incorrectly assumes that make-directory-internal
must support handlers.
---
 doc/lispref/files.texi   |  2 --
 etc/NEWS                 |  4 ++++
 lisp/gnus/nnmaildir.el   |  2 +-
 lisp/ido.el              |  2 +-
 lisp/net/tramp-smb.el    |  3 ++-
 src/fileio.c             |  5 -----
 test/lisp/files-tests.el | 11 -----------
 7 files changed, 8 insertions(+), 21 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 4b45d89f9d0..5bcbac6ceb8 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3378,7 +3378,6 @@ Magic File Names
 @code{load}, @code{lock-file},
 @code{make-auto-save-file-name},
 @code{make-directory},
-@code{make-directory-internal},
 @code{make-lock-file-name},
 @code{make-nearby-temp-file},
 @code{make-process},
@@ -3440,7 +3439,6 @@ Magic File Names
 @code{load}, @code{lock-file},
 @code{make-auto-save-file-name},
 @code{make-direc@discretionary{}{}{}tory},
-@code{make-direc@discretionary{}{}{}tory-internal},
 @code{make-lock-file-name},
 @code{make-nearby-temp-file},
 @code{make-process},
diff --git a/etc/NEWS b/etc/NEWS
index 157fe98c983..dbf1642206b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4477,6 +4477,10 @@ set is too big to transfer to Emacs every time a completion is
 needed.  The table uses new 'external' completion style exclusively
 and cannot work with regular styles such as 'basic' or 'flex'.
 
++++
+** Magic file handlers for make-directory-internal are no longer needed.
+Instead, Emacs uses the already-existing make-directory handlers.
+
 \f
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index faa288934d1..3fb87f3a712 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -296,7 +296,7 @@ nnmaildir--unlink
      (if (file-attributes file) (delete-file file))))
 (defun nnmaildir--mkdir (dir)
   (or (file-exists-p (file-name-as-directory dir))
-      (make-directory-internal (directory-file-name dir))))
+      (make-directory (directory-file-name dir))))
 (defun nnmaildir--mkfile (file)
   (write-region "" nil file nil 'no-message))
 (defun nnmaildir--delete-dir-files (dir ls)
diff --git a/lisp/ido.el b/lisp/ido.el
index 77e4dd447d8..92b4370cb45 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -2435,7 +2435,7 @@ ido-file-internal
                                 filename))
 	      (ido-record-command method dirname)
 	      (ido-record-work-directory dirname)
-	      (make-directory-internal dirname)
+	      (make-directory dirname)
 	      (funcall method dirname))
 	     (t
 	      ;; put make-directory command on history
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c720b33b5f2..24fff9bb495 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1186,12 +1186,13 @@ tramp-smb-handle-make-directory
 	(make-directory ldir parents))
       ;; Just do it.
       (when (file-directory-p ldir)
-	(make-directory-internal dir))
+	(make-directory dir))
       (unless (file-directory-p dir)
 	(tramp-error v 'file-error "Couldn't make directory %s" dir)))))
 
 (defun tramp-smb-handle-make-directory-internal (directory)
   "Like `make-directory-internal' for Tramp files."
+  (declare (obsolete nil "29.1"))
   (setq directory (directory-file-name (expand-file-name directory)))
   (unless (file-name-absolute-p directory)
     (setq directory (expand-file-name directory default-directory)))
diff --git a/src/fileio.c b/src/fileio.c
index 92335b639cd..835c42cc0a4 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2427,16 +2427,11 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
   (Lisp_Object directory)
 {
   const char *dir;
-  Lisp_Object handler;
   Lisp_Object encoded_dir;
 
   CHECK_STRING (directory);
   directory = Fexpand_file_name (directory, Qnil);
 
-  handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
-  if (!NILP (handler))
-    return call2 (handler, Qmake_directory_internal, directory);
-
   encoded_dir = ENCODE_FILE (directory);
 
   dir = SSDATA (encoded_dir);
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 682b5cdb449..efafb5583ac 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1038,17 +1038,6 @@ files-tests-file-name-non-special-make-directory
     (let ((default-directory nospecial-dir))
       (should-error (make-directory "dir")))))
 
-(ert-deftest files-tests-file-name-non-special-make-directory-internal ()
-  (files-tests--with-temp-non-special (tmpdir nospecial-dir t)
-    (let ((default-directory nospecial-dir))
-      (make-directory-internal "dir")
-      (should (file-directory-p "dir"))
-      (delete-directory "dir")))
-  (files-tests--with-temp-non-special-and-file-name-handler
-      (tmpdir nospecial-dir t)
-    (let ((default-directory nospecial-dir))
-      (should-error (make-directory-internal "dir")))))
-
 (ert-deftest files-tests-file-name-non-special-make-nearby-temp-file ()
   (let* ((default-directory (file-name-quote temporary-file-directory))
          (near-tmpfile (make-nearby-temp-file "file")))
-- 
2.38.1


[-- Attachment #3: 0002-make-directory-now-returns-t-if-dir-already-exists.patch --]
[-- Type: text/x-patch, Size: 6734 bytes --]

From b671e175372825c077ab4a1810e353845626c26a Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:48 -0800
Subject: [PATCH 2/3] make-directory now returns t if dir already exists

This new feature will help fix a copy-directory bug (Bug#58919).
Its implementation does not rely on make-directory handlers
supporting the new feature, as it no longer uses a make-directory
handler H in any way other than (funcall H DIR), thus using
only the intersection of the old and new behavior for handlers.
This will give us time to fix handlers at our leisure.
* lisp/files.el (files--ensure-directory): New arg MKDIR.
All uses changed.
(files--ensure-directory, make-directory):
Return non-nil if DIR is already a directory.  All uses changed.
* test/lisp/files-tests.el (files-tests-make-directory):
Test new return-value convention.
---
 doc/lispref/files.texi   |  3 +++
 etc/NEWS                 |  5 ++++
 lisp/files.el            | 58 +++++++++++++++++++++-------------------
 test/lisp/files-tests.el |  6 ++---
 4 files changed, 41 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5bcbac6ceb8..29d9e514c72 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3205,6 +3205,9 @@ Create/Delete Dirs
 @var{parents} is non-@code{nil}, as is always the case in an
 interactive call, that means to create the parent directories first,
 if they don't already exist.
+As a function, @code{make-directory} returns non-@code{nil} if @var{dirname}
+already exists as a directory and @var{parents} is non-@code{nil},
+and returns @code{nil} if it successfully created @var{dirname}.
 @code{mkdir} is an alias for this.
 @end deffn
 
diff --git a/etc/NEWS b/etc/NEWS
index dbf1642206b..d59d61a9d25 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4481,6 +4481,11 @@ and cannot work with regular styles such as 'basic' or 'flex'.
 ** Magic file handlers for make-directory-internal are no longer needed.
 Instead, Emacs uses the already-existing make-directory handlers.
 
++++
+** (make-directory DIR t) returns non-nil if DIR already exists.
+This can let a caller know whether it created DIR.  Formerly,
+make-directory's return value was unspecified.
+
 \f
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/files.el b/lisp/files.el
index c74e7e808e4..235eacee704 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6193,18 +6193,17 @@ rename-uniquely
       (rename-buffer (generate-new-buffer-name base-name))
       (force-mode-line-update))))
 
-(defun files--ensure-directory (dir)
-  "Make directory DIR if it is not already a directory.  Return nil."
+(defun files--ensure-directory (mkdir dir)
+  "Use function MKDIR to make directory DIR if it is not already a directory.
+Return non-nil if DIR is already a directory."
   (condition-case err
-      (make-directory-internal dir)
+      (funcall mkdir dir)
     (error
-     (unless (file-directory-p dir)
-       (signal (car err) (cdr err))))))
+     (or (file-directory-p dir)
+	 (signal (car err) (cdr err))))))
 
 (defun make-directory (dir &optional parents)
   "Create the directory DIR and optionally any nonexistent parent dirs.
-If DIR already exists as a directory, signal an error, unless
-PARENTS is non-nil.
 
 Interactively, the default choice of directory to create is the
 current buffer's default directory.  That is useful when you have
@@ -6214,8 +6213,9 @@ make-directory
 non-nil, says whether to create parent directories that don't
 exist.  Interactively, this happens by default.
 
-If creating the directory or directories fail, an error will be
-raised."
+Return non-nil if PARENTS is non-nil and DIR already exists as a
+directory, and nil if DIR did not already exist but was created.
+Signal an error if unsuccessful."
   (interactive
    (list (read-file-name "Make directory: " default-directory default-directory
 			 nil nil)
@@ -6223,25 +6223,27 @@ make-directory
   ;; If default-directory is a remote directory,
   ;; make sure we find its make-directory handler.
   (setq dir (expand-file-name dir))
-  (let ((handler (find-file-name-handler dir 'make-directory)))
-    (if handler
-	(funcall handler 'make-directory dir parents)
-      (if (not parents)
-	  (make-directory-internal dir)
-	(let ((dir (directory-file-name (expand-file-name dir)))
-	      create-list parent)
-	  (while (progn
-		   (setq parent (directory-file-name
-				 (file-name-directory dir)))
-		   (condition-case ()
-		       (files--ensure-directory dir)
-		     (file-missing
-		      ;; Do not loop if root does not exist (Bug#2309).
-		      (not (string= dir parent)))))
-	    (setq create-list (cons dir create-list)
-		  dir parent))
-	  (dolist (dir create-list)
-            (files--ensure-directory dir)))))))
+  (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory)))
+                   #'(lambda (dir) (funcall handler 'make-directory dir))
+                 #'make-directory-internal)))
+    (if (not parents)
+        (funcall mkdir dir)
+      (let ((dir (directory-file-name (expand-file-name dir)))
+            already-dir create-list parent)
+        (while (progn
+                 (setq parent (directory-file-name
+                               (file-name-directory dir)))
+                 (condition-case ()
+                     (ignore (setq already-dir
+                                   (files--ensure-directory mkdir dir)))
+                   (error
+                    ;; Do not loop if root does not exist (Bug#2309).
+                    (not (string= dir parent)))))
+          (setq create-list (cons dir create-list)
+                dir parent))
+        (dolist (dir create-list)
+          (setq already-dir (files--ensure-directory mkdir dir)))
+        already-dir))))
 
 (defun make-empty-file (filename &optional parents)
   "Create an empty file FILENAME.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index efafb5583ac..b9fbeb8a4e0 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1261,11 +1261,11 @@ files-tests-make-directory
            (a/b (concat dirname "a/b")))
       (write-region "" nil file)
       (should-error (make-directory "/"))
-      (should-not (make-directory "/" t))
+      (should (make-directory "/" t))
       (should-error (make-directory dir))
-      (should-not (make-directory dir t))
+      (should (make-directory dir t))
       (should-error (make-directory dirname))
-      (should-not (make-directory dirname t))
+      (should (make-directory dirname t))
       (should-error (make-directory file))
       (should-error (make-directory file t))
       (should-not (make-directory subdir1))
-- 
2.38.1


[-- Attachment #4: 0003-Fix-copy-directory-bug-when-dest-dir-exists.patch --]
[-- Type: text/x-patch, Size: 3944 bytes --]

From 5b6435e1e57ae0c20ce3078ac1fe97a7757c4ba7 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@penguin.cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:48 -0800
Subject: [PATCH 3/3] Fix copy-directory bug when dest dir exists
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/files.el (copy-directory): Set ‘follow’ depending on
whether we made the directory, not based on a guess that is
sometimes wrong.  When NEWNAME is a directory name and
COPY-CONTENTS is nil, do not object merely because the adjusted
NEWNAME is already a directory.  (Bug#58919).
* test/lisp/files-tests.el (files-tests-copy-directory):
Test for the bug.
---
 lisp/files.el            | 19 ++++++++++++-------
 test/lisp/files-tests.el |  9 ++++++++-
 2 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 235eacee704..3cf7833ae02 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6437,7 +6437,7 @@ copy-directory
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
 		     (find-file-name-handler newname 'copy-directory)))
-	(follow parents))
+	follow)
     (if handler
 	(funcall handler 'copy-directory directory
                  newname keep-time parents copy-contents)
@@ -6457,19 +6457,24 @@ copy-directory
 				    t)
 	      (make-symbolic-link target newname t)))
         ;; Else proceed to copy as a regular directory
-        (cond ((not (directory-name-p newname))
+	;; first by creating the destination directory if needed,
+	;; preparing to follow any symlink to a directory we did not create.
+	(setq follow
+	    (if (not (directory-name-p newname))
 	       ;; If NEWNAME is not a directory name, create it;
 	       ;; that is where we will copy the files of DIRECTORY.
-	       (make-directory newname parents))
+	       (make-directory newname parents)
 	      ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
 	      ;; create NEWNAME if it is not already a directory;
 	      ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
-	      ((if copy-contents
-		   (or parents (not (file-directory-p newname)))
+	      (unless copy-contents
 	         (setq newname (concat newname
 				       (file-name-nondirectory directory))))
-	       (make-directory (directory-file-name newname) parents))
-	      (t (setq follow t)))
+	      (condition-case err
+		  (make-directory (directory-file-name newname) parents)
+		(error
+		 (or (file-directory-p newname)
+		     (signal (car err) (cdr err)))))))
 
         ;; Copy recursively.
         (dolist (file
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index b9fbeb8a4e0..011bfa67cc2 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1346,7 +1346,9 @@ files-tests-copy-directory
            (dest (concat dirname "dest/new/directory/"))
            (file (concat (file-name-as-directory source) "file"))
            (source2 (concat dirname "source2"))
-           (dest2 (concat dirname "dest/new2")))
+           (dest2 (concat dirname "dest/new2"))
+           (source3 (concat dirname "source3/d"))
+           (dest3 (concat dirname "dest3/d")))
       (make-directory source)
       (write-region "" nil file)
       (copy-directory source dest t t t)
@@ -1354,6 +1356,11 @@ files-tests-copy-directory
       (make-directory (concat (file-name-as-directory source2) "a") t)
       (copy-directory source2 dest2)
       (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
+      (make-directory source3 t)
+      (write-region "x\n" nil (concat (file-name-as-directory source3) "file"))
+      (make-directory dest3 t)
+      (write-region "y\n" nil (concat (file-name-as-directory dest3) "file"))
+      (copy-directory source3 (file-name-directory dest3) t)
       (delete-directory dir 'recursive))))
 
 (ert-deftest files-tests-abbreviate-file-name-homedir ()
-- 
2.38.1