Re: bug in copy-directory

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

Michael Albinus <michael.albinus@gmx.de> writes:

> Chong Yidong <cyd@stupidchicken.com> writes:
>
>> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>>
>>> I don't think there's a traditional C-level equivalent to `cp', but at
>>> least for `mv', the C-level API (aka `rename') does not behave like
>>> `mv', but instead signals an error if the destination is
>>> a pre-existing directory.
>>>
>>> As Lennart points out, the semantics of `rename' are a bit less magical,
>>> which tends to work well when you care about race-conditions and other
>>> fun stuff.  OTOH out `copy-file' behaves like `cp', so I guess it's OK
>>> for copy-directory to also always behave like `cp' even for
>>> non-interactive uses.
>>
>> I've commited the patch to the branch.  Dired seems to still work fine.
>
> Sorry for coming in late.
>
> A year ago, there was the related Bug#5343. I've fixed that.
>
> Your patch breaks recursive copy now. Extend the use case from that bug
> report:
>
> - Create directory /tmp/test
> - Create directory /tmp/test/test
> - Create file /tmp/test/a
> - Create file /tmp/test/test/b
>
> - Apply (copy-directory "/tmp/test" "~/")
>   Everything is fine
>
> - Apply again (copy-directory "/tmp/test" "~/")
>   The target directory structure is broken.

Following patch seems to work in these cases, could you check?

---
 lisp/files.el |   31 +++++++++++++------------------
 1 files changed, 13 insertions(+), 18 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 4659742..eebdf7d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,6 +4723,7 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+
 (defun copy-directory (directory newname &optional keep-time parents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
@@ -4754,24 +4755,17 @@ this happens by default."
 	(funcall handler 'copy-directory directory newname keep-time parents)
 
       ;; Compute target name.
-      (setq directory (directory-file-name (expand-file-name directory))
-	    newname   (directory-file-name (expand-file-name newname)))
-
-      (if (not (file-directory-p newname))
-	  ;; If NEWNAME is not an existing directory, create it; that
-	  ;; is where we will copy the files of DIRECTORY.
-	  (make-directory newname parents)
-	;; If NEWNAME is an existing directory, we will copy into
-	;; NEWNAME/[DIRECTORY-BASENAME].
-	(setq newname (expand-file-name
-		       (file-name-nondirectory
-			(directory-file-name directory))
-		       newname))
-	(if (and (file-exists-p newname)
-		 (not (file-directory-p newname)))
-	    (error "Cannot overwrite non-directory %s with a directory"
-		   newname))
-	(make-directory newname t))
+      ;; (setq directory (directory-file-name (expand-file-name directory))
+      ;;       newname   (directory-file-name (expand-file-name newname)))
+      ;; (if (not (file-directory-p newname)) (make-directory newname parents))
+      (setq directory (directory-file-name (expand-file-name directory)))
+      (setq newname   (directory-file-name (if (file-directory-p newname)
+                                               (expand-file-name
+                                                (file-relative-name directory
+                                                 (file-name-directory directory))
+                                                newname)
+                                               newname)))
+      (if (not (file-directory-p newname)) (make-directory newname parents))
 
       ;; Copy recursively.
       (mapc
@@ -4792,6 +4786,7 @@ this happens by default."
       (set-file-modes newname (file-modes directory))
       (if keep-time
 	  (set-file-times newname (nth 5 (file-attributes directory)))))))
+
 \f
 (put 'revert-buffer-function 'permanent-local t)
 (defvar revert-buffer-function nil


>> I haven't checked whether the Tramp handlers need fixing, though.
>
> When possible, Tramp will use native means for recursive copy. Try
> (copy-directory "/tmp/test" "/rsync::~/")
>
> I would like to keep this behaviour.
Patch above works also in this case (not tested with rsync method but
should be the same).

> Best regards, Michael.

-- 
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997