dired-do-copy may create infinite directory hierarchy, again

dired-do-copy may create infinite directory hierarchy, again

[Michael Heerdegen]

Hi,

I had sent a reply to

  bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy

after it had been closed, saying that there are still problems.
Unfortunately I got no answer.  Since it was an important bug: Can
please somebody have a look?  Thanks.

This was my message:



Hello again,

I'm afraid there are still problems.  I encountered these two:


1. Creating symlinks to parent directories doesn't work anymore.

E.g. if you have a directory "~/test/dir1/", open a dired for "~", go to
"test/", hit S, enter "~/test/dir1/" and hit RET.  You get the error

  dired-create-files: Cannot copy `/home/micha/test' into its
subdirectory `/home/micha/test/dir1/test'

But I only wanted a symlink...  This worked in Emacs 23.


2. Symlinks to parent directories (still) lead to ininite loops when
copying containing dir.

To use the above example: just create this symlink from outside Emacs,
so you get e.g. this:

  /home/micha/test/dir1:
  total used in directory 8,0K available 94267456
  drwxr-xr-x 2 micha users 4,0K Mär 22 02:32 .
  drwxr-xr-x 3 micha users 4,0K Mär 22 02:33 ..
  lrwxrwxrwx 1 micha users   22 Mär 22 02:32 test -> /home/micha/test


Now dired "~", and copy "~/test" to "~/test2".  You get a hierarchy

  ~/test2/dir1/test/dir1/test/...

again (the command terminates without error, btw).  And all these
are real directories, and _not_ symlinks!


I also wonder why dired doesn't copy the symlink itself, but copies the
target instead?  This seems to be the case also in other examples.  If I
copy a directory containing any symlinks with dired, copying always
copies the targets of the symlinks.


Michael

Re: dired-do-copy may create infinite directory hierarchy, again

[Thierry Volpiatto]

Hi Michael,

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Hi,
>
> I had sent a reply to
>
>   bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy
>
> after it had been closed, saying that there are still problems.
> Unfortunately I got no answer.  Since it was an important bug: Can
> please somebody have a look?  Thanks.
Thanks for this, you should open a new bug.

> This was my message:
>
>
>
> Hello again,
>
> I'm afraid there are still problems.  I encountered these two:
>
>
> 1. Creating symlinks to parent directories doesn't work anymore.
>
> E.g. if you have a directory "~/test/dir1/", open a dired for "~", go to
> "test/", hit S, enter "~/test/dir1/" and hit RET.  You get the error
>
>   dired-create-files: Cannot copy `/home/micha/test' into its
> subdirectory `/home/micha/test/dir1/test'
>
> But I only wanted a symlink...  This worked in Emacs 23.
>
Need to be fixed.

> 2. Symlinks to parent directories (still) lead to ininite loops when
> copying containing dir.
>
> To use the above example: just create this symlink from outside Emacs,
> so you get e.g. this:
>
>   /home/micha/test/dir1:
>   total used in directory 8,0K available 94267456
>   drwxr-xr-x 2 micha users 4,0K Mär 22 02:32 .
>   drwxr-xr-x 3 micha users 4,0K Mär 22 02:33 ..
>   lrwxrwxrwx 1 micha users   22 Mär 22 02:32 test -> /home/micha/test
>
>
> Now dired "~", and copy "~/test" to "~/test2".  You get a hierarchy
>
>   ~/test2/dir1/test/dir1/test/...
>
> again (the command terminates without error, btw).  And all these
> are real directories, and _not_ symlinks!
This is because the loop of copy-directory test the file it copy with
`file-directory-p' instead of testing if the car of its
`file-attributes' is non-nil.

--8<---------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5102,10 +5102,10 @@
 	       ;; We do not want to copy "." and "..".
 	       (directory-files directory 'full
 				directory-files-no-dot-files-regexp))
-	(if (file-directory-p file)
-	    (copy-directory file newname keep-time parents)
-	  (let ((target (expand-file-name (file-name-nondirectory file) newname))
-		(attrs (file-attributes file)))
+        (let ((target (expand-file-name (file-name-nondirectory file) newname))
+              (attrs (file-attributes file)))
+          (if (eq t (car attrs)) ; A directory but not a symlink.
+              (copy-directory file newname keep-time parents)
 	    (if (stringp (car attrs)) ; Symbolic link
 		(make-symbolic-link (car attrs) target t)
 	      (copy-file file target t keep-time)))))
--8<---------------cut here---------------end--------------->8---

This patch should fix it, but not fully tested, please have a look.

>
> I also wonder why dired doesn't copy the symlink itself, but copies the
> target instead?  This seems to be the case also in other examples.  If I
> copy a directory containing any symlinks with dired, copying always
> copies the targets of the symlinks.
The patch above should fix this.

>
> Michael
>
>

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

Re: dired-do-copy may create infinite directory hierarchy, again

[Thierry Volpiatto]

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

Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:

>>   bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy
>>
>> after it had been closed, saying that there are still problems.
>> Unfortunately I got no answer.  Since it was an important bug: Can
>> please somebody have a look?  Thanks.

>> But I only wanted a symlink...  This worked in Emacs 23.
>>
> Need to be fixed.

The attached patch should fix this also, please review it and test it (quite
busy actually, not fully tested), and if no objections I will apply it.
Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bugfix copy-directory/symlinks --]
[-- Type: text/x-diff, Size: 2658 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1333042420 -7200
# Node ID c2de4670a69cefd92095caca612f8b1e4fd0c217
# Parent  0c4996976cc3ded487b93f71a27641a48c127767
* lisp/files.el (copy-directory): Check if file is a directory but a symlink.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,7 +1264,8 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
-  (when (file-subdir-of-p to from)
+  (when (and (eq t (car (file-attributes from)))
+             (file-subdir-of-p to from))
     (error "Cannot copy `%s' into its subdirectory `%s'" from to))
   (let ((attrs (file-attributes from)))
     (if (and recursive
@@ -1452,10 +1453,14 @@
                          (eq file-creator 'dired-copy-file))
                 (setq to destname))
               ;; If DESTNAME and FROM are the same directory or
-              ;; If DESTNAME is a subdirectory of FROM, return error.
-              (and (file-subdir-of-p destname from)
-                   (error "Cannot copy `%s' into its subdirectory `%s'"
-                          from to)))
+              ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+              ;; and the method in use is copying return error.
+              (when (and (eq t          ; A dir but not a symlink.
+                             (car (file-attributes destname)))
+                         (eq file-creator 'dired-copy-file)
+                         (file-subdir-of-p destname from))
+                (error "Here:Cannot copy `%s' into its subdirectory `%s'"
+                       from to)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5102,10 +5102,10 @@
 	       ;; We do not want to copy "." and "..".
 	       (directory-files directory 'full
 				directory-files-no-dot-files-regexp))
-	(if (file-directory-p file)
-	    (copy-directory file newname keep-time parents)
-	  (let ((target (expand-file-name (file-name-nondirectory file) newname))
-		(attrs (file-attributes file)))
+        (let ((target (expand-file-name (file-name-nondirectory file) newname))
+              (attrs (file-attributes file)))
+          (if (eq t (car attrs)) ; A directory but not a symlink.
+              (copy-directory file newname keep-time parents)
 	    (if (stringp (car attrs)) ; Symbolic link
 		(make-symbolic-link (car attrs) target t)
 	      (copy-file file target t keep-time)))))

[-- Attachment #3: Type: text/plain, Size: 84 bytes --]



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