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

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

[Michael Heerdegen]

Hello,

start emacs -Q.

Suppose you have a directory "~/Test".  Do C-x d ~ RET.  Jump to the
line showing "Test".  Hit C and enter "~/Test".  Answer "yes" to the

 Recursive copies of /home/micha/Test? (yes or no) 

question.

This creates an huge recursive hierarchy of "Test" directories

  ~/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/...

The error

  copy-directory: Variable binding depth exceeds max-specpdl-size

finally stops that.

The user may do something like that per accident.  Emacs should IMHO not
behave like that.

The problem also appears in Emacs 23.


Thanks,

Michael. 



In GNU Emacs 24.0.92.1 (i486-pc-linux-gnu, GTK+ Version 3.2.3)
 of 2012-01-11 on zelenka, modified by Debian
 (emacs-snapshot package, version 1:20120111-1)
Windowing system distributor `The X.Org Foundation', version 11.0.11102902
configured using `configure  '--build' 'i486-linux-gnu' '--host' 'i486-linux-gnu' '--prefix=/usr' '--sharedstatedir=/var/lib' '--libexecdir=/usr/lib' '--localstatedir=/var' '--infodir=/usr/share/info' '--mandir=/usr/share/man' '--with-pop=yes' '--enable-locallisppath=/etc/emacs-snapshot:/etc/emacs:/usr/local/share/emacs/24.0.92/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/24.0.92/site-lisp:/usr/share/emacs/site-lisp' '--without-compress-info' '--with-crt-dir=/usr/lib/i386-linux-gnu/' '--with-x=yes' '--with-x-toolkit=gtk3' '--with-imagemagick=yes' 'build_alias=i486-linux-gnu' 'host_alias=i486-linux-gnu' 'CFLAGS=-DDEBIAN -DSITELOAD_PURESIZE_EXTRA=5000 -g -O2''

Important settings:
  value of $LC_ALL: de_DE.utf8
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: C
  value of $LANG: de_DE.utf8
  value of $XMODIFIERS: nil
  locale-coding-system: utf-8-unix
  default enable-multibyte-characters: t

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 905 bytes --]

Hi, here a patch tha should fix this.
I resent it because I am not sure precedent post have been sent.

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Hello,
>
> start emacs -Q.
>
> Suppose you have a directory "~/Test".  Do C-x d ~ RET.  Jump to the
> line showing "Test".  Hit C and enter "~/Test".  Answer "yes" to the
>
>  Recursive copies of /home/micha/Test? (yes or no) 
>
> question.
>
> This creates an huge recursive hierarchy of "Test" directories
>
>   ~/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/Test/...
>
> The error
>
>   copy-directory: Variable binding depth exceeds max-specpdl-size
>
> finally stops that.
>
> The user may do something like that per accident.  Emacs should IMHO not
> behave like that.
>
> The problem also appears in Emacs 23.

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

[-- Attachment #1.2: patch-r118414 --]
[-- Type: application/octet-stream, Size: 2107 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1326402527 -3600
# Node ID 0b39841e4c22aa2e241f185136c8fcec5d9acf18
# Parent  402d62612daf76522194f2a8d02463cbbd64626e
Fix error when trying to copy directory on itself (bug#10489).
* lisp/dired-aux.el (dired-copy-file-recursive): Error when trying to copy file or dir on itself.
(dired-create-file): Be sure destination is set when from and to are the same file/dir.
* lisp/files.el (copy-directory): Error when trying to copy file or dir on itself.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,6 +1264,9 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (string= (file-name-as-directory from)
+                 (file-name-as-directory to))
+    (error "Can't copy to same directory"))
   (let ((attrs (file-attributes from)))
     (if (and recursive
 	     (eq t (car attrs))
@@ -1431,7 +1434,10 @@
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
 	    (when (and (file-directory-p from)
-		       (file-directory-p to)
+		       (or (file-directory-p to)
+                           (string= (file-name-as-directory from)
+                                    (file-name-as-directory
+                                     (file-name-directory to))))
 		       (eq file-creator 'dired-copy-file))
 	      (setq to (file-name-directory to)))
             (condition-case err
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4928,6 +4928,9 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (string= (file-name-as-directory directory)
+                 (file-name-as-directory newname))
+    (error "Can't copy to same directory"))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Date: Thu, 12 Jan 2012 22:33:38 +0100
> 
> Hi, here a patch that should fix this.

Thanks.

> +  (when (string= (file-name-as-directory from)
> +                 (file-name-as-directory to))
> +    (error "Can't copy to same directory"))
>    (let ((attrs (file-attributes from)))
>      (if (and recursive
>  	     (eq t (car attrs))
> @@ -1431,7 +1434,10 @@
>                           (marker-char (dired-file-marker from)) ; slow
>                           (t nil))))
>  	    (when (and (file-directory-p from)
> -		       (file-directory-p to)
> +		       (or (file-directory-p to)
> +                           (string= (file-name-as-directory from)
> +                                    (file-name-as-directory
> +                                     (file-name-directory to))))
>  		       (eq file-creator 'dired-copy-file))
>  	      (setq to (file-name-directory to)))
>              (condition-case err
> diff --git a/lisp/files.el b/lisp/files.el
> --- a/lisp/files.el
> +++ b/lisp/files.el
> @@ -4928,6 +4928,9 @@
>  	    (format "Copy directory %s to: " dir)
>  	    default-directory default-directory nil nil)
>  	   current-prefix-arg t nil)))
> +  (when (string= (file-name-as-directory directory)
> +                 (file-name-as-directory newname))
> +    (error "Can't copy to same directory"))
>    ;; If default-directory is a remote directory, make sure we find its
>    ;; copy-directory handler.
>    (let ((handler (or (find-file-name-handler directory 'copy-directory)

I don't think this will solves all the use cases.  File names are not
strings, you cannot compare them as literal strings and hope to plumb
all the leaks.

Some situations which I think this patch will not handle correctly:

 . file names with different letter-case on a case-insensitive file
   system

 . relative vs absolute file names

 . file names that are hard links to the same directory (this includes
   the infamous 8+3 short aliases on Windows)

I didn't actually try the patch, so apologies if I missed something
which makes these non-issues.

Thanks again for working on this.

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

[Thierry Volpiatto]

Hi Eli,

Eli Zaretskii <eliz@gnu.org> writes:

> I don't think this will solves all the use cases.  File names are not
> strings, you cannot compare them as literal strings and hope to plumb
> all the leaks.
A test with `equal' is already used in `dired-create-files',
(equal from to) 
Is it the correct way to compare two filenames?

> Some situations which I think this patch will not handle correctly:
>
>  . file names with different letter-case on a case-insensitive file
>    system
Can you provide example or better a recipe.

>  . relative vs absolute file names
Same.

>  . file names that are hard links to the same directory (this includes
>    the infamous 8+3 short aliases on Windows)
Don't know on Windows, (My knowledge of links in windows is very
limited) 
here it is difficult (impossible as User) to Hardlink a directory:

--8<---------------cut here---------------start------------->8---
man ln:
     -d, -F, --directory
          allow the superuser to attempt to hard link directories
          (note: will  probably fail due to  system restrictions,
          even for the superuser)
--8<---------------cut here---------------end--------------->8---


> I didn't actually try the patch, so apologies if I missed something
> which makes these non-issues.
Didn't try yet on Windows.
However, it is working fine for common usage on GNU/Linux, with
M-x copy-directory M-: (dired-copy-file/recursive x y) 
and `C' from dired.
Would be great you try it for the use cases you describe above.
(Maybe with a version of the patch that use `equal')

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

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Cc: 10489@debbugs.gnu.org
> Date: Fri, 13 Jan 2012 09:38:30 +0100
> 
> > I don't think this will solves all the use cases.  File names are not
> > strings, you cannot compare them as literal strings and hope to plumb
> > all the leaks.
> A test with `equal' is already used in `dired-create-files',
> (equal from to) 
> Is it the correct way to compare two filenames?

I don't see how `equal' could help, unless someone teaches it to treat
strings that are file names specially.  I don't see such treatment in
the current sources.

> > Some situations which I think this patch will not handle correctly:
> >
> >  . file names with different letter-case on a case-insensitive file
> >    system
> Can you provide example or better a recipe.

  emacs -Q
  C-x d ~ RET
  <go to the line showing "Test">
  C ~/test RET
  yes RET

> >  . relative vs absolute file names
> Same.

M-: (dired-copy-file-recursive "foo/../Test" "./Test" t) RET

> >  . file names that are hard links to the same directory (this includes
> >    the infamous 8+3 short aliases on Windows)
> Don't know on Windows, (My knowledge of links in windows is very
> limited) 
> here it is difficult (impossible as User) to Hardlink a directory:
> 
> --8<---------------cut here---------------start------------->8---
> man ln:
>      -d, -F, --directory
>           allow the superuser to attempt to hard link directories
>           (note: will  probably fail due to  system restrictions,
>           even for the superuser)
> --8<---------------cut here---------------end--------------->8---

We don't disallow superusers from using Emacs, nor restrict Emacs
usage only to filesystems where links to directories are impossible,
do we? ;-)

And what about symlinks?

On Windows, you can have "C:/PROGRA~1" be the alias of
"C:/Program Files", for example.

Bottom line, I think you need:

  . make both file names absolute by calling expand-file-name on each

  . resolve links by calling file-truename on each (this will handle
    the 8+3 alias issue, as well as, AFAIK, the issue with links)

  . compare case-insensitively on MS-Windows and MS-DOS

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

[Thierry Volpiatto]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
>> Cc: 10489@debbugs.gnu.org
>> Date: Fri, 13 Jan 2012 09:38:30 +0100
>> 
>> > I don't think this will solves all the use cases.  File names are not
>> > strings, you cannot compare them as literal strings and hope to plumb
>> > all the leaks.
>> A test with `equal' is already used in `dired-create-files',
>> (equal from to) 
>> Is it the correct way to compare two filenames?
>
> I don't see how `equal' could help, unless someone teaches it to treat
> strings that are file names specially.  I don't see such treatment in
> the current sources.
>
>> > Some situations which I think this patch will not handle correctly:
>> >
>> >  . file names with different letter-case on a case-insensitive file
>> >    system
>> Can you provide example or better a recipe.
>
>   emacs -Q
>   C-x d ~ RET
>   <go to the line showing "Test">
>   C ~/test RET
>   yes RET
>
>> >  . relative vs absolute file names
>> Same.
>
> M-: (dired-copy-file-recursive "foo/../Test" "./Test" t) RET
>
>> >  . file names that are hard links to the same directory (this includes
>> >    the infamous 8+3 short aliases on Windows)
>> Don't know on Windows, (My knowledge of links in windows is very
>> limited) 
>> here it is difficult (impossible as User) to Hardlink a directory:
>> 
>> --8<---------------cut here---------------start------------->8---
>> man ln:
>>      -d, -F, --directory
>>           allow the superuser to attempt to hard link directories
>>           (note: will  probably fail due to  system restrictions,
>>           even for the superuser)
>> --8<---------------cut here---------------end--------------->8---
>
> We don't disallow superusers from using Emacs, nor restrict Emacs
> usage only to filesystems where links to directories are impossible,
> do we? ;-)
I just want to be able to test:

cp "a_hardlink_of_/foo" "/foo"

> And what about symlinks?
>
> On Windows, you can have "C:/PROGRA~1" be the alias of
> "C:/Program Files", for example.
>
> Bottom line, I think you need:
>
>   . make both file names absolute by calling expand-file-name on each
Ok

>   . resolve links by calling file-truename on each (this will handle
>     the 8+3 alias issue, as well as, AFAIK, the issue with links)
Ok

>   . compare case-insensitively on MS-Windows and MS-DOS
let binding case-fold-search should be ok.

Thanks, I will add these modifications to the patch handling remote files.

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

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

[Juanma Barranquero]

On Fri, Jan 13, 2012 at 11:31, Eli Zaretskii <eliz@gnu.org> wrote:

> Bottom line, I think you need:
>
>  . make both file names absolute by calling expand-file-name on each
>
>  . resolve links by calling file-truename on each (this will handle
>    the 8+3 alias issue, as well as, AFAIK, the issue with links)
>
>  . compare case-insensitively on MS-Windows and MS-DOS

As this seems like a common occurrence, how comes that we don't have

(defun file-name-compare (name1 name2 &optional dir)
  "..."
  (let ((n1 (file-truename (expand-file-name name1 dir)))
        (n2 (file-truename (expand-file-name name2 dir))))
    (when (memq system-type '(ms-dos windows-nt))
      (setq n1 (downcase n1)
            n2 (downcase n2)))
    (string= n1 n2)))

?

    Juanma

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

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Fri, 13 Jan 2012 13:01:49 +0100
> Cc: Thierry Volpiatto <thierry.volpiatto@gmail.com>, 10489@debbugs.gnu.org
> 
> On Fri, Jan 13, 2012 at 11:31, Eli Zaretskii <eliz@gnu.org> wrote:
> 
> > Bottom line, I think you need:
> >
> >  . make both file names absolute by calling expand-file-name on each
> >
> >  . resolve links by calling file-truename on each (this will handle
> >    the 8+3 alias issue, as well as, AFAIK, the issue with links)
> >
> >  . compare case-insensitively on MS-Windows and MS-DOS
> 
> As this seems like a common occurrence, how comes that we don't have
> 
> (defun file-name-compare (name1 name2 &optional dir)
>   "..."
>   (let ((n1 (file-truename (expand-file-name name1 dir)))
>         (n2 (file-truename (expand-file-name name2 dir))))
>     (when (memq system-type '(ms-dos windows-nt))
>       (setq n1 (downcase n1)
>             n2 (downcase n2)))
>     (string= n1 n2)))
> 
> ?

Because in the past people objected to my saying that file names are
not strings.  Perhaps they will object now as well.

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

[Michael Albinus]

Juanma Barranquero <lekktu@gmail.com> writes:

> As this seems like a common occurrence, how comes that we don't have
>
> (defun file-name-compare (name1 name2 &optional dir)
>   "..."
>   (let ((n1 (file-truename (expand-file-name name1 dir)))
>         (n2 (file-truename (expand-file-name name2 dir))))
>     (when (memq system-type '(ms-dos windows-nt))
>       (setq n1 (downcase n1)
>             n2 (downcase n2)))
>     (string= n1 n2)))

I wouldn't check for `system-type', there might be other systems which
do not care filename cases (VMS?). I would let-bind `case-fold-search',
derived from `read-file-name-completion-ignore-case'.

> Juanma

Best regards, Michael.

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

[Juanma Barranquero]

On Fri, Jan 13, 2012 at 14:01, Michael Albinus <michael.albinus@gmx.de> wrote:

> I wouldn't check for `system-type', there might be other systems which
> do not care filename cases (VMS?). I would let-bind `case-fold-search',
> derived from `read-file-name-completion-ignore-case'.

You're right that r-f-n-c-i-c should be used, but as for binding it,
that forces you to use a more expensive comparation. Perhaps this is
simpler:

 (defun file-name-compare (name1 name2 &optional dir)
   "..."
   (compare-strings (file-truename (expand-file-name name1 dir))
                    (file-truename (expand-file-name name2 dir))
                    nil nil
                    read-file-name-completion-ignore-case))

    Juanma

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

[Juanma Barranquero]

On Fri, Jan 13, 2012 at 14:11, Juanma Barranquero <lekktu@gmail.com> wrote:

>   (compare-strings (file-truename (expand-file-name name1 dir))
>                    (file-truename (expand-file-name name2 dir))
>                    nil nil
>                    read-file-name-completion-ignore-case))

Sorry, I meant

  (compare-strings (file-truename (expand-file-name name1 dir)) 0 nil
                   (file-truename (expand-file-name name2 dir)) 0 nil
                   read-file-name-completion-ignore-case))

    Juanma

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

[Juanma Barranquero]

>  (compare-strings (file-truename (expand-file-name name1 dir)) 0 nil
>                   (file-truename (expand-file-name name2 dir)) 0 nil
>                   read-file-name-completion-ignore-case))

I think we should push for it to be added to Emacs, if only for the
thrill of having a ChangeLog entry

2012-01-13  Michael Albinus <michael.albinus@gmx.de>
	    Juanma Barranquero  <lekktu@gmail.com>
	    Eli Zaretskii <eliz@gnu.org>

	* files.el (file-name-compare): New function.

i.e., three authors for a three-line function (plus header and comments) ;-)

    Juanma

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

[Michael Albinus]

Juanma Barranquero <lekktu@gmail.com> writes:

>>  (compare-strings (file-truename (expand-file-name name1 dir)) 0 nil
>>                   (file-truename (expand-file-name name2 dir)) 0 nil
>>                   read-file-name-completion-ignore-case))
>
> I think we should push for it to be added to Emacs, if only for the
> thrill of having a ChangeLog entry
>
> 2012-01-13  Michael Albinus <michael.albinus@gmx.de>
> 	    Juanma Barranquero  <lekktu@gmail.com>
> 	    Eli Zaretskii <eliz@gnu.org>
>
> 	* files.el (file-name-compare): New function.
>
> i.e., three authors for a three-line function (plus header and comments) ;-)

Perfect reasoning, I'm for it :-)

Thinking about, `file-truename' would need some massage for the remote
case. Currently, it just expands symlinks. But it could also do some
normalization for the user and host name. For example:

(file-truename "/ssh:127.0.0.1:/path/to/symlink")
 => "/ssh:albinus@localhost:/extend/path/to/file"

But that's for Emacs 24.2, of course.

> Juanma

Best regards, Michael.

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

[Stefan Monnier]

IIUC the problem at hand can be solved by disregarding names and
comparing (file-attributes) instead, since we're checking whether two
names refer to the exact same (existing) directory.

>> As this seems like a common occurrence, how comes that we don't have
>> 
>> (defun file-name-compare (name1 name2 &optional dir)
>> "..."
>> (let ((n1 (file-truename (expand-file-name name1 dir)))
>> (n2 (file-truename (expand-file-name name2 dir))))
>> (when (memq system-type '(ms-dos windows-nt))
>> (setq n1 (downcase n1)
>> n2 (downcase n2)))
>> (string= n1 n2)))

file-name-equal-p would be nice, indeed, as discussed a few months
(years?) ago.

> I wouldn't check for `system-type', there might be other systems which
> do not care filename cases (VMS?). I would let-bind `case-fold-search',
> derived from `read-file-name-completion-ignore-case'.

read-file-name-completion-ignore-case is a user configuration which only
reflects the underlying system's sensitivity by default but the user is
free to modify it.  I used to set it to t under GNU/Linux, for instance.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> IIUC the problem at hand can be solved by disregarding names and
> comparing (file-attributes) instead, since we're checking whether two
> names refer to the exact same (existing) directory.
>
>>> As this seems like a common occurrence, how comes that we don't have
>>> 
>>> (defun file-name-compare (name1 name2 &optional dir)
>>> "..."
>>> (let ((n1 (file-truename (expand-file-name name1 dir)))
>>> (n2 (file-truename (expand-file-name name2 dir))))
>>> (when (memq system-type '(ms-dos windows-nt))
>>> (setq n1 (downcase n1)
>>> n2 (downcase n2)))
>>> (string= n1 n2)))
>
> file-name-equal-p would be nice, indeed, as discussed a few months
> (years?) ago.

I am for `file-name-equal-p', would be really helpful specially for this
patch. 

>> I wouldn't check for `system-type', there might be other systems which
>> do not care filename cases (VMS?). I would let-bind `case-fold-search',
>> derived from `read-file-name-completion-ignore-case'.
>
> read-file-name-completion-ignore-case is a user configuration which only
> reflects the underlying system's sensitivity by default but the user is
> free to modify it.  I used to set it to t under GNU/Linux, for instance.

So would be better to let-bind case-fold-search as suggested by Michael.
It's what I did in last version of this patch.

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

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> read-file-name-completion-ignore-case is a user configuration which only
> reflects the underlying system's sensitivity by default but the user is
> free to modify it.  I used to set it to t under GNU/Linux, for instance.

(eval (car (get 'read-file-name-completion-ignore-case 'standard-value)))

would do, but that's too hackish ??

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>> read-file-name-completion-ignore-case is a user configuration which only
>> reflects the underlying system's sensitivity by default but the user is
>> free to modify it.  I used to set it to t under GNU/Linux, for instance.
> (eval (car (get 'read-file-name-completion-ignore-case 'standard-value)))
> would do, but that's too hackish ??

Yuck.  I'd much rather introduce a new defconst which is then used to
provide the default value of read-file-name-completion-ignore-case.

BTW, a reliable test of file name equality is far from obvious.  E.g.
"/ssh:toto:/titi" is equal to "/ssh:TOTO:/titi" but whether
"/ssh:toto:/titi" is not equal to "/ssh:toto:/TITI" if titi
is a typical GNU/Linux machine.


        Stefan

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

[Juanma Barranquero]

On Fri, Jan 13, 2012 at 16:13, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> BTW, a reliable test of file name equality is far from obvious.

That is true, but it's also likely true* that simple, and file-name
comparisons are used in the Emacs sources. So perhaps we should limit
file-name-equal-p to local files, and assume that there's no reliable
way to compare them if the files are remote.

[* I haven't checked, but I would be surprised it they were none.]

    Juanma

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

[Michael Albinus]

Juanma Barranquero <lekktu@gmail.com> writes:

> That is true, but it's also likely true* that simple, and file-name
> comparisons are used in the Emacs sources. So perhaps we should limit
> file-name-equal-p to local files, and assume that there's no reliable
> way to compare them if the files are remote.

Simple cases would be possible, therefore I'm for a file name handler
implemented in Tramp. It could expand default method, user names and
host names. It could massage the hostname (downcase all hostnames,
canonicalize them if possible (for example "127.0.0.1" and "::1" and
"localhost" could all be mapped to (system-name))). It could fiddle with
file name case sensitvity (it might be different on your local Windows
machine and your remote GNU/Linux machine). It could know which methods
are equal when it comes to file name comparison. ("ssh" and "scp" are
equal in this way). And so on.

There will still be cases Tramp returns "not equal", but we would catch
the majority of use cases, I believe.

> Juanma

Best regards, Michael.

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

[Drew Adams]

> >> read-file-name-completion-ignore-case is a user 
> >> configuration which only reflects the underlying system's
> >> sensitivity by default but the user is free to modify it.
> >>  I used to set it to t under GNU/Linux, for instance.
> >
> > (eval (car (get 'read-file-name-completion-ignore-case 
> >                 'standard-value)))
> >
> > would do, but that's too hackish ??
> 
> Yuck.  I'd much rather introduce a new defconst which is then used to
> provide the default value of read-file-name-completion-ignore-case.
> 
> BTW, a reliable test of file name equality is far from obvious.  E.g.
> "/ssh:toto:/titi" is equal to "/ssh:TOTO:/titi" but whether
> "/ssh:toto:/titi" is not equal to "/ssh:toto:/TITI" if titi
> is a typical GNU/Linux machine.

And if you try to rely on some system setting (e.g. the constant you mentioned),
then that needs to be checked separately for each file name argument, in the
case where a remote specifier is part of the file name.

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

[Thierry Volpiatto]

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

Eli Zaretskii <eliz@gnu.org> writes:

> I don't think this will solves all the use cases.  File names are not
> strings, you cannot compare them as literal strings and hope to plumb
> all the leaks.
>
> Some situations which I think this patch will not handle correctly:
>
>  . file names with different letter-case on a case-insensitive file
>    system
>
>  . relative vs absolute file names
>
>  . file names that are hard links to the same directory (this includes
>    the infamous 8+3 short aliases on Windows)
>
> I didn't actually try the patch, so apologies if I missed something
> which makes these non-issues.
>
Here a version of the patch that use `equal' and handle also same error
on remotes files.
i.e (copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Singlepatch-r118414ToTip.patch --]
[-- Type: text/x-diff, Size: 2355 bytes --]

##Merge of all patches applied from revision 118413
## patch-r118414: Fix error when trying to copy directory on itself (bug#10489).
## patch-r118415: * lisp/dired-aux.el (dired-copy-file-recursive): Handle also remote file/dir.
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,6 +1264,11 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (equal (or (file-remote-p (file-name-as-directory from) 'localname)
+                   (file-name-as-directory from))
+               (or (file-remote-p (file-name-as-directory to) 'localname)
+                   (file-name-as-directory to)))
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
 	     (eq t (car attrs))
@@ -1431,7 +1436,12 @@
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
 	    (when (and (file-directory-p from)
-		       (file-directory-p to)
+		       (or (equal (or (file-remote-p (file-name-as-directory from) 'localname)
+                                      (file-name-as-directory from))
+                                  (or (file-remote-p (file-name-as-directory to) 'localname)
+                                      (file-name-as-directory
+                                       (file-name-directory to))))
+                           (file-directory-p to))
 		       (eq file-creator 'dired-copy-file))
 	      (setq to (file-name-directory to)))
             (condition-case err
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4928,6 +4928,11 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (equal (or (file-remote-p (file-name-as-directory directory) 'localname)
+                   (file-name-as-directory directory))
+               (or (file-remote-p (file-name-as-directory newname) 'localname)
+                   (file-name-as-directory newname)))
+    (error "Can't copy directory `%s' on itself" from))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)

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

[Michael Albinus]

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

> Here a version of the patch that use `equal' and handle also same error
> on remotes files.
> i.e (copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")

Your code seems also to suppress

   (copy-directory "/sssh:remotehost:/home/user/Test" "/home/user/Test")

Why that?

Best regards, Michael.

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 793 bytes --]

Hi Michael,

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Here a version of the patch that use `equal' and handle also same error
>> on remotes files.
>> i.e (copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")
>
> Your code seems also to suppress
>
>    (copy-directory "/sssh:remotehost:/home/user/Test" "/home/user/Test")
>
> Why that?
Because I forget to handle this case ;-).
Here the patch modified that handle this.

I want to only suppress the use of:
(copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")
or
(copy-directory "/sudo:host:/home/user/Test" "/sudo:host:/home/user/Test")


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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Singlepatch-r118414ToTip.patch --]
[-- Type: text/x-diff, Size: 5127 bytes --]

##Merge of all patches applied from revision 118413
## patch-r118414: Fix error when trying to copy directory on itself (bug#10489).
## patch-r118415: * lisp/dired-aux.el (dired-copy-file-recursive): Handle also remote file/dir.
## patch-r118416: "New patch"
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,6 +1264,13 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (equal (or (and (equal "sudo" (file-remote-p (file-name-as-directory from) 'method))
+                        (file-remote-p (file-name-as-directory from) 'localname))
+                   (file-name-as-directory from))
+               (or (and (equal "sudo" (file-remote-p (file-name-as-directory to) 'method))
+                        (file-remote-p (file-name-as-directory to) 'localname))
+                   (file-name-as-directory to)))
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
 	     (eq t (car attrs))
@@ -1402,7 +1409,7 @@
 newfile's entry, or t to use the current marker character if the
 old file was marked."
   (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
+                                    skipped (success-count 0) (total (length fn-list)))
     (let (to overwrite-query
 	     overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
@@ -1431,7 +1438,28 @@
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
 	    (when (and (file-directory-p from)
-		       (file-directory-p to)
+		       (or
+                        (equal
+                         ;; Test if 'from'
+                         ;; is a remote file localname with sudo method.
+                         (or (and (equal
+                                   "sudo"
+                                   (file-remote-p (file-name-as-directory from)
+                                                  'method))
+                                  (file-remote-p (file-name-as-directory from)
+                                                 'localname))
+                             (file-name-as-directory from))
+                         ;; Test if 'to'
+                         ;; is a remote file localname with sudo method.
+                         (or (and (equal
+                                   "sudo"
+                                   (file-remote-p (file-name-as-directory to)
+                                                  'method))
+                                  (file-remote-p (file-name-as-directory
+                                                  (file-name-directory to))
+                                                 'localname))
+                             (file-name-as-directory (file-name-directory to))))
+                        (file-directory-p to))
 		       (eq file-creator 'dired-copy-file))
 	      (setq to (file-name-directory to)))
             (condition-case err
@@ -1456,21 +1484,21 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4928,6 +4928,13 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (equal (or (and (equal "sudo" (file-remote-p (file-name-as-directory directory) 'method))
+                        (file-remote-p (file-name-as-directory directory) 'localname))
+                   (file-name-as-directory directory))
+               (or (and (equal "sudo" (file-remote-p (file-name-as-directory newname) 'method))
+                        (file-remote-p (file-name-as-directory newname) 'localname))
+                   (file-name-as-directory newname)))
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Michael Albinus]

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

> Hi Michael,

Hi Thierry,

> I want to only suppress the use of:
> (copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")

Do you know `tramp-default-proxies-alist'? With that toy, "/sudo:host:"
can be another machine but your local one. You really don't know,
without going into deep Tramp interna.

> (copy-directory "/sudo:host:/home/user/Test" "/sudo:host:/home/user/Test")

That would be reasonable to suppress. But you don't need a special
remote test for this. Just compare the results of `file-truename', as
suggested by Eli. This shall work also for remote files automagically.

If somebody wants to apply

(copy-directory "/ssh:host:/home/user/Test" "/scp:host:/home/user/Test")

you can't suppress. Same for using different hostnames which are aliases
for the same machine, etc pp.

Best regards, Michael.

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

[Thierry Volpiatto]

Hi Michael,

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Hi Michael,
>
> Hi Thierry,
>
>> I want to only suppress the use of:
>> (copy-directory "/sudo:host:/home/user/Test" "/home/user/Test")
>
> Do you know `tramp-default-proxies-alist'? With that toy, "/sudo:host:"
> can be another machine but your local one. You really don't know,
> without going into deep Tramp interna.
No I didn't know, I did differently, see below.

>> (copy-directory "/sudo:host:/home/user/Test" "/sudo:host:/home/user/Test")
>
> That would be reasonable to suppress.
We must suppress this as it cause infinite creation of subdir in ~/Test.


> But you don't need a special remote test for this. Just compare the
> results of `file-truename', as suggested by Eli. This shall work also
> for remote files automagically.
Ok good, but I did differently in last patch:

--8<---------------cut here---------------start------------->8---
(when (equal (or (and (equal "sudo" (file-remote-p (file-name-as-directory from) 'method))
                      (file-remote-p (file-name-as-directory from) 'localname))
                 (file-name-as-directory from))
             (or (and (equal "sudo" (file-remote-p (file-name-as-directory to) 'method))
                      (file-remote-p (file-name-as-directory to) 'localname))
                 (file-name-as-directory to)))
  (error "Can't copy directory `%s' on itself" from))
--8<---------------cut here---------------end--------------->8---

Which fail for the example below.
> If somebody wants to apply
>
> (copy-directory "/ssh:host:/home/user/Test" "/scp:host:/home/user/Test")
>
> you can't suppress. Same for using different hostnames which are aliases
> for the same machine, etc pp.
Yes right.
BTW, working on this, I found another bug for

(copy-directory "/ssh:host:/home/user/Test" "/home/user/Test")

This seem to overwrite "/home/user/Test".
Doing the same operation from Dired create "/home/user/Test/Test".

But I think it's easy to fix, just need to move the tramp block lower in
copy-directory, have a look.

So I will finish writing this patch with the compare file function
suggested by Juanma.

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

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

[Drew Adams]

FWIW, this is what Bookmark+ uses, based on some input from Michael:

(defun bmkp-same-file-p (file1 file2)
  "Return non-nil if FILE1 and FILE2 name the same file.
If either name is not absolute, then it is expanded relative to
`default-directory' for the test."
  (and (equal (file-remote-p file1) (file-remote-p file2))
       (string= (file-truename (expand-file-name file1))
                (file-truename (expand-file-name file2)))))

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

[Juanma Barranquero]

On Fri, Jan 13, 2012 at 15:14, Drew Adams <drew.adams@oracle.com> wrote:

>  (and (equal (file-remote-p file1) (file-remote-p file2))

Why is the file-remote-p needed?

    Juanma

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

[Michael Albinus]

Juanma Barranquero <lekktu@gmail.com> writes:

> On Fri, Jan 13, 2012 at 15:14, Drew Adams <drew.adams@oracle.com> wrote:
>
>>  (and (equal (file-remote-p file1) (file-remote-p file2))
>
> Why is the file-remote-p needed?

For some simple cases, `file-remote-p' does the correct expansion.

(file-remote-p "/sudo::") => "/sudo:root@host:"

With this expansion, "/sudo::/path/file" and "/sudo:host:/path/file"
would be equal.

> Juanma

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Juanma Barranquero <lekktu@gmail.com> writes:
>
>> On Fri, Jan 13, 2012 at 15:14, Drew Adams <drew.adams@oracle.com> wrote:
>>
>>>  (and (equal (file-remote-p file1) (file-remote-p file2))
>>
>> Why is the file-remote-p needed?
>
> For some simple cases, `file-remote-p' does the correct expansion.
>
> (file-remote-p "/sudo::") => "/sudo:root@host:"
>
> With this expansion, "/sudo::/path/file" and "/sudo:host:/path/file"
> would be equal.

What about this?

(defun file-name-equal-p (name1 name2 &optional dir)
  (let* ((n1     (file-truename (expand-file-name name1 dir)))
         (n2     (file-truename (expand-file-name name2 dir)))
         (rhost1 (file-remote-p n1 'host))
         (rhost2 (file-remote-p n2 'host))
         (lname1 (file-remote-p n1 'localname))
         (lname2 (file-remote-p n2 'localname))
         (rem-n1 (if rhost1
                     (list (cons rhost1 lname1))
                     (list (cons (system-name) n1))))
         (rem-n2 (if rhost2
                     (list (cons rhost2 lname2))
                     (list (cons (system-name) n2)))))
    (loop for (x1 . y1) in rem-n1
          for (x2 . y2) in rem-n2
          thereis (and (equal x1 x2)
                       (equal y1 y2)))))

(file-name-equal-p "/home/thierry/Test" "~/Test")
;=>t
(file-name-equal-p "/home/thierry/Test" "/home/thierry/tmp/Test")
;=>nil
(file-name-equal-p "/ssh:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test")
;=>t
(file-name-equal-p "/sudo::/home/thierry/Test" "/sudo::~/Test")
;=>nil
(file-name-equal-p "/sudo::/home/thierry/Test" "~/Test")
;=>t
(file-name-equal-p "/home/thierry/tmp" "/tmp")
;=>nil


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

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

[Drew Adams]

For one thing, you are accessing a remote file before testing whether it is
remote according to its name, which systematically costs you a remote access
(login etc.), perhaps uselessly. 

> What about this?
> 
> (defun file-name-equal-p (name1 name2 &optional dir)
>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>          (n2     (file-truename (expand-file-name name2 dir)))

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

[Thierry Volpiatto]

"Drew Adams" <drew.adams@oracle.com> writes:

> For one thing, you are accessing a remote file before testing whether it is
> remote according to its name, which systematically costs you a remote access
> (login etc.), perhaps uselessly. 
Agree, but for this use case the connection is already open so there is
not really a cost with remote access.
But anyway as Michael point we need to test also user, method.. to much!
So this method is not suitable anyway.
>> What about this?
>> 
>> (defun file-name-equal-p (name1 name2 &optional dir)
>>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>>          (n2     (file-truename (expand-file-name name2 dir)))
>
>
>
>
>

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

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

[Drew Adams]

> > For one thing, you are accessing a remote file before 
> > testing whether it is remote according to its name,
> > which systematically costs you a remote access
> > (login etc.), perhaps uselessly.
>
> Agree, but for this use case the connection is already open
> so there is not really a cost with remote access.

What use case?  I thought the discussion was about coming up with a general
function to compare file names to determine whether their files are the same.

> But anyway as Michael point we need to test also user, method..
> to much!

I believe that is all taken care of by the code I sent, which uses
`file-remote-p'.  IOW, I think `file-remote-p' does that.  But I'm no expert on
this stuff.

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

[Michael Albinus]

"Drew Adams" <drew.adams@oracle.com> writes:

> I believe that is all taken care of by the code I sent, which uses
> `file-remote-p'.  IOW, I think `file-remote-p' does that.  But I'm no
> expert on this stuff.

As I've pointed out, a specialized Tramp function could do better than
Tramp's version of `file-remote-p', for example knowing that the methods
"ssh" and "scp" are equal when it is about `file-name-equal-p'.

That's why I'm in favor of `file-name-equal-p' AND its file name handler
for remote files.

Best regards, Michael.

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

[Drew Adams]

> > I believe that is all taken care of by the code I sent, which uses
> > `file-remote-p'.  IOW, I think `file-remote-p' does that.  
> > But I'm no expert on this stuff.
> 
> As I've pointed out, a specialized Tramp function could do better than
> Tramp's version of `file-remote-p', for example knowing that 
> the methods "ssh" and "scp" are equal when it is about `file-name-equal-p'.
> 
> That's why I'm in favor of `file-name-equal-p' AND its file 
> name handler for remote files.

Sounds good to me.

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

[Thierry Volpiatto]

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

> Michael Albinus <michael.albinus@gmx.de> writes:
>
>> Juanma Barranquero <lekktu@gmail.com> writes:
>>
>>> On Fri, Jan 13, 2012 at 15:14, Drew Adams <drew.adams@oracle.com> wrote:
>>>
>>>>  (and (equal (file-remote-p file1) (file-remote-p file2))
>>>
>>> Why is the file-remote-p needed?
>>
>> For some simple cases, `file-remote-p' does the correct expansion.
>>
>> (file-remote-p "/sudo::") => "/sudo:root@host:"
>>
>> With this expansion, "/sudo::/path/file" and "/sudo:host:/path/file"
>> would be equal.
>
> What about this?
>
> (defun file-name-equal-p (name1 name2 &optional dir)
>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>          (n2     (file-truename (expand-file-name name2 dir)))
>          (rhost1 (file-remote-p n1 'host))
>          (rhost2 (file-remote-p n2 'host))
>          (lname1 (file-remote-p n1 'localname))
>          (lname2 (file-remote-p n2 'localname))
>          (rem-n1 (if rhost1
>                      (list (cons rhost1 lname1))
>                      (list (cons (system-name) n1))))
>          (rem-n2 (if rhost2
>                      (list (cons rhost2 lname2))
>                      (list (cons (system-name) n2)))))
>     (loop for (x1 . y1) in rem-n1
>           for (x2 . y2) in rem-n2
>           thereis (and (equal x1 x2)
>                        (equal y1 y2)))))
>
> (file-name-equal-p "/home/thierry/Test" "~/Test")
> ;=>t
> (file-name-equal-p "/home/thierry/Test" "/home/thierry/tmp/Test")
> ;=>nil
> (file-name-equal-p "/ssh:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test")
> ;=>t
> (file-name-equal-p "/sudo::/home/thierry/Test" "/sudo::~/Test")
> ;=>nil
> (file-name-equal-p "/sudo::/home/thierry/Test" "~/Test")
> ;=>t
> (file-name-equal-p "/home/thierry/tmp" "/tmp")
> ;=>nil

We need also to use file-name-as-directory for this use case:
(file-name-equal-p "/home/thierry/Test" "~/Test/")
;=>t

--8<---------------cut here---------------start------------->8---
(defun file-name-equal-p (name1 name2 &optional dir)
  (let* ((n1     (file-name-as-directory
                  (file-truename (expand-file-name name1 dir))))
         (n2     (file-name-as-directory
                  (file-truename (expand-file-name name2 dir))))
         (rhost1 (file-remote-p n1 'host))
         (rhost2 (file-remote-p n2 'host))
         (lname1 (file-remote-p n1 'localname))
         (lname2 (file-remote-p n2 'localname))
         (rem-n1 (if rhost1
                     (list (cons rhost1 lname1))
                     (list (cons (system-name) n1))))
         (rem-n2 (if rhost2
                     (list (cons rhost2 lname2))
                     (list (cons (system-name) n2)))))
    (loop for (x1 . y1) in rem-n1
          for (x2 . y2) in rem-n2
          thereis (and (equal x1 x2)
                       (equal y1 y2)))))
--8<---------------cut here---------------end--------------->8---

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

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

[Michael Albinus]

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

> What about this?
>
> (defun file-name-equal-p (name1 name2 &optional dir)
>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>          (n2     (file-truename (expand-file-name name2 dir)))
>          (rhost1 (file-remote-p n1 'host))
>          (rhost2 (file-remote-p n2 'host))
>          (lname1 (file-remote-p n1 'localname))
>          (lname2 (file-remote-p n2 'localname))
>          (rem-n1 (if rhost1
>                      (list (cons rhost1 lname1))
>                      (list (cons (system-name) n1))))
>          (rem-n2 (if rhost2
>                      (list (cons rhost2 lname2))
>                      (list (cons (system-name) n2)))))
>     (loop for (x1 . y1) in rem-n1
>           for (x2 . y2) in rem-n2
>           thereis (and (equal x1 x2)
>                        (equal y1 y2)))))

Nope. User name and method also matter.

"/ftp:host:/file" <> "/ssh:@host:/file"

"/ftp:user1@host:/file" <> "/ftp:user1@host:/file"

You shouldn't mess with remote files, really :-)

That's what file name handlers are good for.

Best regards, Michael.

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 1519 bytes --]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> What about this?
>>
>> (defun file-name-equal-p (name1 name2 &optional dir)
>>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>>          (n2     (file-truename (expand-file-name name2 dir)))
>>          (rhost1 (file-remote-p n1 'host))
>>          (rhost2 (file-remote-p n2 'host))
>>          (lname1 (file-remote-p n1 'localname))
>>          (lname2 (file-remote-p n2 'localname))
>>          (rem-n1 (if rhost1
>>                      (list (cons rhost1 lname1))
>>                      (list (cons (system-name) n1))))
>>          (rem-n2 (if rhost2
>>                      (list (cons rhost2 lname2))
>>                      (list (cons (system-name) n2)))))
>>     (loop for (x1 . y1) in rem-n1
>>           for (x2 . y2) in rem-n2
>>           thereis (and (equal x1 x2)
>>                        (equal y1 y2)))))
>
> Nope. User name and method also matter.
>
> "/ftp:host:/file" <> "/ssh:@host:/file"
>
> "/ftp:user1@host:/file" <> "/ftp:user1@host:/file"
I see.

> You shouldn't mess with remote files, really :-)
Indeed yes!

> That's what file name handlers are good for.
>
> Best regards, Michael.

I post here the last version of the patch I wrote today,
waiting something better to compare files.
it works and fix this bug in most use cases.
 
-- 
  Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Singlepatch-r118414ToTip.patch --]
[-- Type: text/x-diff, Size: 8329 bytes --]

##Merge of all patches applied from revision 118413
## patch-r118414: Fix error when trying to copy directory on itself (bug#10489).
## patch-r118415: * lisp/dired-aux.el (dired-copy-file-recursive): Handle also remote file/dir.
## patch-r118416: Handle only remote files with sudo method when copying directories.
## patch-r118417: * lisp/dired-aux.el (dired-copy-file-recursive): Use file-truename.
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,34 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
-  (let ((attrs (file-attributes from)))
+  (let* ((case-fold-search t)
+         (fromname    (file-name-as-directory (file-truename from)))
+         (destname    (file-name-as-directory (file-truename to)))
+         (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method))
+                           (file-remote-p fromname 'localname)))
+         (rem-newname (and (equal "sudo" (file-remote-p destname 'method))
+                           (file-remote-p destname 'localname)))
+         (attrs       (file-attributes from)))
+    (when (equal (or rem-dirname fromname)
+                 (or rem-newname destname))
+      (error "Can't copy directory `%s' on itself" from))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1402,7 +1412,7 @@
 newfile's entry, or t to use the current marker character if the
 old file was marked."
   (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
+                                    skipped (success-count 0) (total (length fn-list)))
     (let (to overwrite-query
 	     overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
@@ -1430,10 +1440,40 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let* ((case-fold-search t)
+                   (fromname     (file-name-as-directory (file-truename from)))
+                   (destname     (file-name-as-directory (file-name-directory
+                                                          (file-truename to))))
+                   (rem-fromname (and (equal "sudo" (file-remote-p fromname
+                                                                   'method))
+                                      (file-remote-p fromname 'localname)))
+                   (rem-newname  (and (equal "sudo" (file-remote-p destname
+                                                                   'method))
+                                      (file-remote-p destname 'localname))))
+              (when (and (file-directory-p from)
+                         (or (equal (or
+                                     ;; Maybe a remote file with sudo method
+                                     ;; converted to its localname.
+                                     rem-fromname
+                                     ;; Otherwise compare with local name.
+                                     fromname)
+                                    (or rem-newname destname))
+                             (file-directory-p to))
+                         (eq file-creator 'dired-copy-file))
+                (setq to (file-name-directory to))))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,21 +1496,21 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4928,10 +4928,20 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
-  ;; If default-directory is a remote directory, make sure we find its
-  ;; copy-directory handler.
-  (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+  (let* ((case-fold-search t)
+         (fromname    (file-name-as-directory (file-truename directory)))
+         (destname    (file-name-as-directory (file-truename newname)))
+         (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method))
+                           (file-remote-p fromname 'localname)))
+         (rem-newname (and (equal "sudo" (file-remote-p destname 'method))
+                           (file-remote-p destname 'localname)))
+         ;; If default-directory is a remote directory, make sure we find its
+         ;; copy-directory handler.
+         (handler (or (find-file-name-handler directory 'copy-directory)
+                      (find-file-name-handler newname 'copy-directory))))
+    (when (equal (or rem-dirname fromname)
+                 (or rem-newname destname))
+      (error "Can't copy directory `%s' on itself" directory))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Date: Fri, 13 Jan 2012 20:17:43 +0100
> Cc: 10489@debbugs.gnu.org
> 
>  (defun dired-copy-file-recursive (from to ok-flag &optional
>  				       preserve-time top recursive)
> -  (let ((attrs (file-attributes from)))
> +  (let* ((case-fold-search t)
> +         (fromname    (file-name-as-directory (file-truename from)))
> +         (destname    (file-name-as-directory (file-truename to)))
> +         (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method))
> +                           (file-remote-p fromname 'localname)))
> +         (rem-newname (and (equal "sudo" (file-remote-p destname 'method))
> +                           (file-remote-p destname 'localname)))
> +         (attrs       (file-attributes from)))
> +    (when (equal (or rem-dirname fromname)
> +                 (or rem-newname destname))
> +      (error "Can't copy directory `%s' on itself" from))

Why is case-fold-search being unconditionally bound to t?  I don't
think this is TRT on case-sensitive filesystems.  Am I missing
something?

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 2896 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
>> Date: Fri, 13 Jan 2012 20:17:43 +0100
>> Cc: 10489@debbugs.gnu.org
>> 
>>  (defun dired-copy-file-recursive (from to ok-flag &optional
>>  				       preserve-time top recursive)
>> -  (let ((attrs (file-attributes from)))
>> +  (let* ((case-fold-search t)
>> +         (fromname    (file-name-as-directory (file-truename from)))
>> +         (destname    (file-name-as-directory (file-truename to)))
>> +         (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method))
>> +                           (file-remote-p fromname 'localname)))
>> +         (rem-newname (and (equal "sudo" (file-remote-p destname 'method))
>> +                           (file-remote-p destname 'localname)))
>> +         (attrs       (file-attributes from)))
>> +    (when (equal (or rem-dirname fromname)
>> +                 (or rem-newname destname))
>> +      (error "Can't copy directory `%s' on itself" from))
>
> Why is case-fold-search being unconditionally bound to t?  I don't
> think this is TRT on case-sensitive filesystems.  Am I missing
> something?
Ignore, it have no effect, I have changed that.
The last patch use this instead, which avoid duplication of code and is
more readable.


--8<---------------cut here---------------start------------->8---
(defun files-copyable-p (from to)
  "Verify if file FROM is not the same than TO on this system."
  (let* ((fromname     (file-name-as-directory (file-truename from)))
         (destname     (file-name-as-directory (file-truename to)))
         (rem-fromname (and (equal "sudo" (file-remote-p fromname 'method))
                            (string-match (system-name)
                                          (file-remote-p fromname 'host))
                            (file-remote-p fromname 'localname)))
         (rem-newname  (and (equal "sudo" (file-remote-p destname 'method))
                            (string-match (system-name) (file-remote-p destname 'host))
                            (file-remote-p destname 'localname))))
    (not (equal (or rem-fromname fromname)
                (or rem-newname destname)))))
--8<---------------cut here---------------end--------------->8---

This work in these cases:
- usage on local filesystem.
- Copying from a remote filesystem on local filesystem.
- Copying from local filesystem to remote filesystem.
- Copying on a remote filesystem to same remote filesystem with same
method.

This may not work in these cases:
- copying from a remote filesystem to this same remote filesystem with a
different method. (Why one would do that?)
e.g /ssh:host:/foo => /scpc:host:/foo
- Others - please complete (Windows, other tramp use cases, etc...)


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

[-- Attachment #1.2: patch-r118414 --]
[-- Type: application/octet-stream, Size: 7002 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1326536680 -3600
# Node ID b4330fbf1c358a96445d8780fd9eca7eb195d057
# Parent  2065b5b887c3bb946af6eefdc134759d0459876e
Bugfix bug#10489, dired-do-copy may create infinite directory hierarchy.
* lisp/dired-aux.el
* lisp/files.el

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,26 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (unless (files-copyable-p from to)
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1402,7 +1404,7 @@
 newfile's entry, or t to use the current marker character if the
 old file was marked."
   (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
+                                    skipped (success-count 0) (total (length fn-list)))
     (let (to overwrite-query
 	     overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
@@ -1430,10 +1432,25 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (or (not (files-copyable-p from destname))
+                             (file-directory-p to))
+                         (eq file-creator 'dired-copy-file))
+                (setq to (file-name-directory to))))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,21 +1473,21 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4902,6 +4902,21 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-copyable-p (from to)
+  "Verify if file FROM is not the same than TO on this system."
+  (let* ((fromname     (file-name-as-directory (file-truename from)))
+         (destname     (file-name-as-directory (file-truename to)))
+         (rem-fromname (and (equal "sudo" (file-remote-p fromname 'method))
+                            (string-match (system-name)
+                                          (file-remote-p fromname 'host))
+                            (file-remote-p fromname 'localname)))
+         (rem-newname  (and (equal "sudo" (file-remote-p destname 'method))
+                            (string-match (system-name)
+                                          (file-remote-p destname 'host))
+                            (file-remote-p destname 'localname))))
+    (not (equal (or rem-fromname fromname)
+                (or rem-newname destname)))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -4928,10 +4943,12 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (unless (files-copyable-p directory newname)
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+                      (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Michael Albinus]

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

> The last patch use this instead, which avoid duplication of code and is
> more readable.
>
> (defun files-copyable-p (from to)
>   "Verify if file FROM is not the same than TO on this system."
>   (let* ((fromname     (file-name-as-directory (file-truename from)))
>          (destname     (file-name-as-directory (file-truename to)))
>          (rem-fromname (and (equal "sudo" (file-remote-p fromname 'method))
>                             (string-match (system-name)
>                                           (file-remote-p fromname 'host))
>                             (file-remote-p fromname 'localname)))
>          (rem-newname  (and (equal "sudo" (file-remote-p destname 'method))
>                             (string-match (system-name) (file-remote-p destname 'host))
>                             (file-remote-p destname 'localname))))
>     (not (equal (or rem-fromname fromname)
>                 (or rem-newname destname)))))

Again, Thierry: it is the wrong approach, to implement such logic in
files.el (or another package not related to remote files). You do not
know all details of the packages handling it. In this example, you have
handled "/sudo:", but you haven't handled "/su:". And other missing
details.

And you have called `file-truename' before comparing, whether the
"remoteness" of the files are equal. This is a performance issue,
because `file-truename' will always do expansive remote operations, even
if `from' and `to' are located on different hosts, and there is no
reason to find out their respective true names.

You are invited to implement `tramp-handle-file-eual-p', once
`file-equal-p' is added for Emacs 24.2. For the time being (Emacs 24.1),
it is sufficient to compare the result of `file-remote-p' as Drew has
shown in the example.

Best regards, Michael.

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 2209 bytes --]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> The last patch use this instead, which avoid duplication of code and is
>> more readable.
>>
>> (defun files-copyable-p (from to)
>>   "Verify if file FROM is not the same than TO on this system."
>>   (let* ((fromname     (file-name-as-directory (file-truename from)))
>>          (destname     (file-name-as-directory (file-truename to)))
>>          (rem-fromname (and (equal "sudo" (file-remote-p fromname 'method))
>>                             (string-match (system-name)
>>                                           (file-remote-p fromname 'host))
>>                             (file-remote-p fromname 'localname)))
>>          (rem-newname  (and (equal "sudo" (file-remote-p destname 'method))
>>                             (string-match (system-name) (file-remote-p destname 'host))
>>                             (file-remote-p destname 'localname))))
>>     (not (equal (or rem-fromname fromname)
>>                 (or rem-newname destname)))))
>
> Again, Thierry: it is the wrong approach, to implement such logic in
> files.el (or another package not related to remote files). You do not
> know all details of the packages handling it. In this example, you have
> handled "/sudo:", but you haven't handled "/su:". And other missing
> details.
Ok

> And you have called `file-truename' before comparing, whether the
> "remoteness" of the files are equal. This is a performance issue,
> because `file-truename' will always do expansive remote operations, even
> if `from' and `to' are located on different hosts, and there is no
> reason to find out their respective true names.
Ok 

> You are invited to implement `tramp-handle-file-eual-p', once
> `file-equal-p' is added for Emacs 24.2. For the time being (Emacs 24.1),
> it is sufficient to compare the result of `file-remote-p' as Drew has
> shown in the example.
Many examples given here, so if everybody is ok with The function given
by Drew, we could commit the attached patch to fix this bug:

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Singlepatch-r118414ToTip.patch --]
[-- Type: text/x-diff, Size: 7276 bytes --]

##Merge of all patches applied from revision 118409
## patch-r118414: Bugfix bug#10489, dired-do-copy may create infinite directory hierarchy.
## patch-r118411: * lisp/dired-aux.el (dired-copy-file-recursive): Use file-equal-p.
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,26 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (file-equal-p from to)
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1378,7 +1380,7 @@
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
+                                        &optional marker-char)
   "Create one or more new files from a list of existing files FN-LIST.
 This function also handles querying the user, updating Dired
 buffers, and displaying a success or failure message.
@@ -1402,9 +1404,9 @@
 newfile's entry, or t to use the current marker character if the
 old file was marked."
   (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
+                                    skipped (success-count 0) (total (length fn-list)))
     (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
+             overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -1430,10 +1432,25 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (or (file-equal-p from destname)
+                             (file-directory-p to))
+                         (eq file-creator 'dired-copy-file))
+                (setq to destname)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,25 +1473,25 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
+               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
 \f
 (defun dired-do-create-files (op-symbol file-creator operation arg
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4902,6 +4902,12 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun file-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (string= (file-truename (expand-file-name file1))
+                (file-truename (expand-file-name file2)))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -4928,10 +4934,12 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (file-equal-p directory newname)
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+                     (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Thierry Volpiatto]

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

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

> Many examples given here, so if everybody is ok with The function given
> by Drew, we could commit the attached patch to fix this bug:
Note also that the bug is still here with this code 
when copying on same system "/sudo::/foo" to "/foo"

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

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Michael Albinus]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Many examples given here, so if everybody is ok with The function given
>> by Drew, we could commit the attached patch to fix this bug:
> Note also that the bug is still here with this code 
> when copying on same system "/sudo::/foo" to "/foo"

One could also add it to Tramp for Emacs 24.1. But this sounds like a
new feature to me, and I would like to postpone it to Emacs 24.2. There
must be robust testing, if we start to handle such use cases.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>>
>>> Many examples given here, so if everybody is ok with The function given
>>> by Drew, we could commit the attached patch to fix this bug:
>> Note also that the bug is still here with this code 
>> when copying on same system "/sudo::/foo" to "/foo"
>
> One could also add it to Tramp for Emacs 24.1. But this sounds like a
> new feature to me, and I would like to postpone it to Emacs 24.2. There
> must be robust testing, if we start to handle such use cases.

IMHO we should fix this bug for most use cases with a compare function
maybe not perfect in many points but ok for most basic usages.
The function shown by Drew and I put in last patch as you said isn't
sufficient and fail in many cases even on local filesystem:

(defun bmkp-same-file-p (file1 file2)
  "Return non-nil if FILE1 and FILE2 name the same file.
If either name is not absolute, then it is expanded relative to
`default-directory' for the test."
  (and (equal (file-remote-p file1) (file-remote-p file2))
       (string= (file-truename (expand-file-name file1))
                (file-truename (expand-file-name file2)))))

(bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil

That would be for Emacs24.1, and we could work on the real thing in
tramp for 24.2

Here is my last work on this based on precedent example i sent and your
last advices; it doesn't cover many use cases as you point before, test
user, method etc... but works for all the use cases below:

#+BEGIN_SRC emacs-lisp
(defun file-equal-p (name1 name2)
  (if (or (file-remote-p name1)
          (file-remote-p name2))
      (let* ((n1     (file-name-as-directory
                      (expand-file-name name1)))
             (n2     (file-name-as-directory
                      (expand-file-name name2)))
             (rhost1 (file-remote-p n1 'host))
             (rhost2 (file-remote-p n2 'host))
             (lname1 (file-remote-p n1 'localname))
             (lname2 (file-remote-p n2 'localname))
             rem-n1 rem-n2)
        (cond ((and rhost1 (not rhost2))
               (setq rem-n1 (list (cons rhost1 (file-truename lname1))))
               (setq rem-n2 (list (cons (system-name) (file-truename n2)))))
              ((and (not rhost1) rhost2)
               (setq rem-n1 (list (cons (system-name) (file-truename n1))))
               (setq rem-n2 (list (cons rhost2 (file-truename lname2)))))
              ((and rhost1 rhost2)
               (setq rem-n1 (list (cons rhost1 (file-truename lname1))))
               (setq rem-n2 (list (cons rhost2 (file-truename lname2))))))
        (loop for (x1 . y1) in rem-n1
              for (x2 . y2) in rem-n2
              always (and (equal x1 x2)
                          (equal y1 y2))))
      (string= (file-name-as-directory
                (file-truename (expand-file-name name1)))
               (file-name-as-directory
                (file-truename (expand-file-name name2))))))

#+END_SRC

--8<---------------cut here---------------start------------->8---
(dont-compile
  (when (fboundp 'expectations)
    (expectations
      (desc "Local file name comparison: Symlink<=>truefile")
      (expect t
        (file-equal-p "~/.emacs.el" "~/.emacs.d/emacs-config-laptop/.emacs.el"))
      (desc "Local file name comparison")
      (expect t
        (file-equal-p "/home/thierry/Test" "~/Test"))
      (expect t
        (file-equal-p "/home/thierry/Test" "~/Test/"))
      (expect nil
        (file-equal-p "/home/thierry/Test" "/home/thierry/tmp/Test"))
      (expect t
        (file-equal-p "./save-scratch.el" "~/labo/tmp/save-scratch.el"))
      (expect nil
        (file-equal-p "/home/thierry/tmp" "/tmp"))
      (expect nil
        (file-equal-p "/home/thierry/test" "/home/thierry/Test"))
      (desc "Sudo file against local")
      (expect nil
        (file-equal-p "/sudo::/home/thierry/Test" "/sudo::~/Test"))
      (expect t
        (file-equal-p "/sudo::/home/thierry/Test" "~/Test"))
      (desc "Remote file name comparison with different methods")
      (expect t
        (file-equal-p "/ssh:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test"))
      (desc "Remote file name with localfile")
      (expect nil
        (file-equal-p "/ssh:thievol:/home/thierry/Test" "/home/thierry/Test"))
      (desc "Remote file name comparison with same methods same files")
      (expect t
        (file-equal-p "/scpc:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test")))))
--8<---------------cut here---------------end--------------->8---

22 expectations, 0 failures, 0 errors
Expectations finished at Sun Jan 15 20:04:10 2012




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

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

[Michael Albinus]

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

> IMHO we should fix this bug for most use cases with a compare function
> maybe not perfect in many points but ok for most basic usages.
> The function shown by Drew and I put in last patch as you said isn't
> sufficient and fail in many cases even on local filesystem:
>
> (defun bmkp-same-file-p (file1 file2)
>   "Return non-nil if FILE1 and FILE2 name the same file.
> If either name is not absolute, then it is expanded relative to
> `default-directory' for the test."
>   (and (equal (file-remote-p file1) (file-remote-p file2))
>        (string= (file-truename (expand-file-name file1))
>                 (file-truename (expand-file-name file2)))))
>
> (bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil

So it must be 

       (string= (directory-file-name (file-truename (expand-file-name file1)))
                (directory-file-name (file-truename (expand-file-name file2))))))

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> IMHO we should fix this bug for most use cases with a compare function
>> maybe not perfect in many points but ok for most basic usages.
>> The function shown by Drew and I put in last patch as you said isn't
>> sufficient and fail in many cases even on local filesystem:
>>
>> (defun bmkp-same-file-p (file1 file2)
>>   "Return non-nil if FILE1 and FILE2 name the same file.
>> If either name is not absolute, then it is expanded relative to
>> `default-directory' for the test."
>>   (and (equal (file-remote-p file1) (file-remote-p file2))
>>        (string= (file-truename (expand-file-name file1))
>>                 (file-truename (expand-file-name file2)))))
>>
>> (bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil
>
> So it must be 
>
>        (string= (directory-file-name (file-truename (expand-file-name file1)))
>                 (directory-file-name (file-truename (expand-file-name file2))))))

Of course, thanks.

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

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> IMHO we should fix this bug for most use cases with a compare function
>> maybe not perfect in many points but ok for most basic usages.
>> The function shown by Drew and I put in last patch as you said isn't
>> sufficient and fail in many cases even on local filesystem:
>>
>> (defun bmkp-same-file-p (file1 file2)
>>   "Return non-nil if FILE1 and FILE2 name the same file.
>> If either name is not absolute, then it is expanded relative to
>> `default-directory' for the test."
>>   (and (equal (file-remote-p file1) (file-remote-p file2))
>>        (string= (file-truename (expand-file-name file1))
>>                 (file-truename (expand-file-name file2)))))
>>
>> (bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil
>
> So it must be 
>
>        (string= (directory-file-name (file-truename (expand-file-name file1)))
>                 (directory-file-name (file-truename (expand-file-name file2))))))

So, any objections to apply my patch to trunk with these changes?

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

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

[Stefan Monnier]

>> (string= (directory-file-name (file-truename (expand-file-name file1)))
>> (directory-file-name (file-truename (expand-file-name file2))))))

> So, any objections to apply my patch to trunk with these changes?

Couldn't we use something closer to what we want to ideally use?
E.g. (equal (file-attributes file1) (file-attributes file2))?


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> (string= (directory-file-name (file-truename (expand-file-name file1)))
>>> (directory-file-name (file-truename (expand-file-name file2))))))
>
>> So, any objections to apply my patch to trunk with these changes?
>
> Couldn't we use something closer to what we want to ideally use?
> E.g. (equal (file-attributes file1) (file-attributes file2))?

We need at least the `file-truename' call. 

(equal (file-attributes (file-truename (expand-file-name file1)))
       (file-attributes (file-truename (expand-file-name file2))))))

I don't know, whether `file-truename' calls `expand-file-name'
internally. `tramp-sh-handle-file-truename' does. Maybe we don't need it.

We could also add already the check for the file name handler. When
there is no file name handler (Emacs 24.1), it doesn't hurt. Later on,
we don't need to touch the fucntion, again. And I'll start to add the
file name handler upstream Tramp, once the function is available in
Emacs 24.1.

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>> E.g. (equal (file-attributes file1) (file-attributes file2))?

> We need at least the `file-truename' call. 

> (equal (file-attributes (file-truename (expand-file-name file1)))
>        (file-attributes (file-truename (expand-file-name file2))))))

Why??!?!

> We could also add already the check for the file name handler.

Yes, that'd be fine.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> E.g. (equal (file-attributes file1) (file-attributes file2))?
>
>> We need at least the `file-truename' call. 
>
>> (equal (file-attributes (file-truename (expand-file-name file1)))
>>        (file-attributes (file-truename (expand-file-name file2))))))
>
> Why??!?!

albinus@slbhn1:[1187] touch 1
albinus@slbhn1:[1188] ln -s 1 2
albinus@slbhn1:[1189] ll 1 2
-rw-r--r-- 1 albinus smc3 197 Jan 16 16:22 1
lrwxrwxrwx 1 albinus smc3   1 Jan 16 16:22 2 -> 1

(file-attributes "/home/albinus/1") =>
(nil 1 441 823 (20244 16570) (20244 16570) (20244 16570) 197 "-rw-r--r--" nil 2708784 19)

(file-attributes "/home/albinus/2") =>
("1" 1 441 823 (20244 16577) (20244 16577) (20244 16577) 1 "lrwxrwxrwx" nil 2727905 19)

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>>>> E.g. (equal (file-attributes file1) (file-attributes file2))?
>>> We need at least the `file-truename' call. 
>>> (equal (file-attributes (file-truename (expand-file-name file1)))
>>> (file-attributes (file-truename (expand-file-name file2))))))
>> 
>> Why??!?!

> albinus@slbhn1:[1187] touch 1
> albinus@slbhn1:[1188] ln -s 1 2
> albinus@slbhn1:[1189] ll 1 2
> -rw-r--r-- 1 albinus smc3 197 Jan 16 16:22 1
> lrwxrwxrwx 1 albinus smc3   1 Jan 16 16:22 2 -> 1

> (file-attributes "/home/albinus/1") =>
> (nil 1 441 823 (20244 16570) (20244 16570) (20244 16570) 197 "-rw-r--r--" nil 2708784 19)

> (file-attributes "/home/albinus/2") =>
> ("1" 1 441 823 (20244 16577) (20244 16577) (20244 16577) 1 "lrwxrwxrwx" nil 2727905 19)

Ah, right.  So we don't need the full semantics of file-truename, but we
do need to force "follow the symlink, if any".  `file-truename' is
overkill, but I guess it's OK for now since I don't think we have
a quick replacement for this case.


        Stefan

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

[Thierry Volpiatto]

Hi Stefan and Michael,
so what is the state of this bug and what do you plan for this?

As a reminder, we needed:

1) A function to compare filenames locally.
2) A tramp handler for this function.
3) A function to check if file1 is subdir of file2, locally also.
4) A tramp handler for this one also?

We have more or less 1 and 3, need tramp handlers for them.

What else is needed?

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

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

[Stefan Monnier]

> so what is the state of this bug and what do you plan for this?

> As a reminder, we needed:

> 1) A function to compare filenames locally.
> 2) A tramp handler for this function.
> 3) A function to check if file1 is subdir of file2, locally also.
> 4) A tramp handler for this one also?

> We have more or less 1 and 3, need tramp handlers for them.

> What else is needed?

Just before we try and solve this problem the hard way:
I just tried:

   % ln -s erlang-otp erl
   % cp -r erl/lib erlang-otp/lib/inviso/

on my Debian system, and it told me "cp: impossible de créer un
répertoire (« erl/lib ») dans lui-même (« erlang-otp/lib/inviso/lib »)",
but note that it only told me so *after* performing the copy.
I.e. it only detected the problem when trying to make
erlang-otp/lib/inviso/lib/inviso/lib

So it seems that the coreutils guys have found it sufficient to detect
the inf-loop after the fact and interrupt the operation at that point
rather than to try and predict that the cp will loop and don't perform
it at all.
It might be easier to get a solution that catches all cases that way:
remember the name and identity (inode/file-attributes/younameit) of
the top directory we create, and whenever we're about to copy
a directory of the same name, check whether it happens to have the
same identity, in which case we've hit an inf-loop.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> It might be easier to get a solution that catches all cases that way:
> remember the name and identity (inode/file-attributes/younameit) of
> the top directory we create, and whenever we're about to copy
> a directory of the same name, check whether it happens to have the
> same identity, in which case we've hit an inf-loop.

Don't know whether it is such easy in Tramp. Must be checked. Remember,
Tramp could use tools like rsync and tar for copying directories.

>         Stefan

Best regards, Michael.

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

[Thierry Volpiatto]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>> so what is the state of this bug and what do you plan for this?
>
>> As a reminder, we needed:
>
>> 1) A function to compare filenames locally.
>> 2) A tramp handler for this function.
>> 3) A function to check if file1 is subdir of file2, locally also.
>> 4) A tramp handler for this one also?
>
>> We have more or less 1 and 3, need tramp handlers for them.
>
>> What else is needed?
>
> Just before we try and solve this problem the hard way:
> I just tried:
>
>    % ln -s erlang-otp erl
>    % cp -r erl/lib erlang-otp/lib/inviso/

We have to check if "erlang-otp/lib/inviso/" is a subdir of "erl/lib"
to resolve this, right?

The following function should work:

--8<---------------cut here---------------start------------->8---
(defun file-subdir-of-p (file1 file2)
  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
If directory FILE1 is the same than directory FILE2, return non--nil."
  (when (and (not (or (file-remote-p file1)
                      (file-remote-p file2)))
             (not (string= file1 "/"))
             (file-directory-p file1)
             (file-directory-p file2))
    (or (string= file2 "/")
        (loop with f1 = (expand-file-name (file-truename file1))
              with f2 = (expand-file-name (file-truename file2))
              with ls1 = (split-string f1 "/" t)
              with ls2 = (split-string f2 "/" t)
              for p = (string-match "^/" f1)
              for i in ls1
              for j in ls2
              when (string= i j)
              concat (if p (concat "/" i) (concat i "/"))
              into root
              finally return
              (equal (file-attributes (file-truename root))
                     (file-attributes f2))))))
--8<---------------cut here---------------end--------------->8---

Can you try?

(file-subdir-of-p "erlang-otp/lib/inviso/" "erl/lib")


> on my Debian system, and it told me "cp: impossible de créer un
> répertoire (« erl/lib ») dans lui-même (« erlang-otp/lib/inviso/lib »)",
> but note that it only told me so *after* performing the copy.
> I.e. it only detected the problem when trying to make
> erlang-otp/lib/inviso/lib/inviso/lib
>
> So it seems that the coreutils guys have found it sufficient to detect
> the inf-loop after the fact and interrupt the operation at that point
> rather than to try and predict that the cp will loop and don't perform
> it at all.
Do we have to strictly follow this?

> It might be easier to get a solution that catches all cases that way:
> remember the name and identity (inode/file-attributes/younameit) of
> the top directory we create,
"erl/lib"?

> and whenever we're about to copy a directory of the same name,
Not sure to fully understand this, do you mean
"and whenever we're about to copy the CONTENTS of a directory of the same
name?"

> check whether it happens to have the same identity, in which case
> we've hit an inf-loop.


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

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

[Stefan Monnier]

>>> so what is the state of this bug and what do you plan for this?
>> 
>>> As a reminder, we needed:
>> 
>>> 1) A function to compare filenames locally.
>>> 2) A tramp handler for this function.
>>> 3) A function to check if file1 is subdir of file2, locally also.
>>> 4) A tramp handler for this one also?
>> 
>>> We have more or less 1 and 3, need tramp handlers for them.
>> 
>>> What else is needed?
>> 
>> Just before we try and solve this problem the hard way:
>> I just tried:
>> 
>> % ln -s erlang-otp erl
>> % cp -r erl/lib erlang-otp/lib/inviso/

> We have to check if "erlang-otp/lib/inviso/" is a subdir of "erl/lib"
> to resolve this, right?

No, we just have to check if during the recursive copy we're trying to
read one of the directories we've just made.

>> So it seems that the coreutils guys have found it sufficient to detect
>> the inf-loop after the fact and interrupt the operation at that point
>> rather than to try and predict that the cp will loop and don't perform
>> it at all.
> Do we have to strictly follow this?

No, it's just an alternative approach.  The potential advantage is that
it does not require figuring out whether a file is within some
directory, it only requires checking actual equality between two
directories.

Another approach is to first get the complete list of files and only
copy them afterwards.  This doesn't require any comparison at all and
completely avoids the risk of inf-loop.

>> It might be easier to get a solution that catches all cases that way:
>> remember the name and identity (inode/file-attributes/younameit) of
>> the top directory we create,
> "erl/lib"?

No, we don't create erl/lib (it's the source instead), the top-level dir
we create is "erlang-otp/lib/inviso/lib".

>> and whenever we're about to copy a directory of the same name,
> Not sure to fully understand this, do you mean "and whenever we're
> about to copy the CONTENTS of a directory of the same name?"

In the recursive loop, the distinction between copying a directory and
copying its contents is not really relevant to this problem (the
recursive call says "copy foo and its contents").


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>>> so what is the state of this bug and what do you plan for this?
>>> 
>>>> As a reminder, we needed:
>>> 
>>>> 1) A function to compare filenames locally.
>>>> 2) A tramp handler for this function.
>>>> 3) A function to check if file1 is subdir of file2, locally also.
>>>> 4) A tramp handler for this one also?
>>> 
>>>> We have more or less 1 and 3, need tramp handlers for them.
>>> 
>>>> What else is needed?
>>> 
>>> Just before we try and solve this problem the hard way:
>>> I just tried:
>>> 
>>> % ln -s erlang-otp erl
>>> % cp -r erl/lib erlang-otp/lib/inviso/
>
>> We have to check if "erlang-otp/lib/inviso/" is a subdir of "erl/lib"
>> to resolve this, right?
>
> No, we just have to check if during the recursive copy we're trying to
> read one of the directories we've just made.

Ok, that is true for the solutions you propose below, but what's wrong
with the solution I have proposed:
Just checking if the destination directory is a subdirectory of the
directory we want to copy.

>>> So it seems that the coreutils guys have found it sufficient to detect
>>> the inf-loop after the fact and interrupt the operation at that point
>>> rather than to try and predict that the cp will loop and don't perform
>>> it at all.
>> Do we have to strictly follow this?
>
> No, it's just an alternative approach.  The potential advantage is that
> it does not require figuring out whether a file is within some
> directory, it only requires checking actual equality between two
> directories.
If we do not have to follow this, I would prefer not starting copying
stuff the user will have to remove afterward when he realize it was
an error (i.e copying a directory on itself).

> Another approach is to first get the complete list of files and only
> copy them afterwards.  This doesn't require any comparison at all and
> completely avoids the risk of inf-loop.
This may be slow isn't it?

>>> It might be easier to get a solution that catches all cases that way:
>>> remember the name and identity (inode/file-attributes/younameit) of
>>> the top directory we create,
>> "erl/lib"?
>
> No, we don't create erl/lib (it's the source instead), the top-level dir
> we create is "erlang-otp/lib/inviso/lib".
>
>>> and whenever we're about to copy a directory of the same name,
>> Not sure to fully understand this, do you mean "and whenever we're
>> about to copy the CONTENTS of a directory of the same name?"
>
> In the recursive loop, the distinction between copying a directory and
> copying its contents is not really relevant to this problem (the
> recursive call says "copy foo and its contents").

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

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

[Stefan Monnier]

> Ok, that is true for the solutions you propose below, but what's wrong
> with the solution I have proposed:
> Just checking if the destination directory is a subdirectory of the
> directory we want to copy.

It's not a bad plan, but it's difficult to make it catch all cases
because it's difficult to figure out if "the destination directory is
a subdirectory of the directory we want to copy".
[ e.g. because of ignored cases differences, or use of different names
  to refer to the same directory, because of MICROS~1 mangling.  ]

Of course checking if two directories are one and the same isn't that
easy to do it reliably either (e.g. for lack of inodes on Windows
systems, and actually I'm not sure what happens if we refer to the same
dir via two different mount points, using GNU/Linux's "bind" mounts, or
mounting dirs multiple times).

I guess the two options aren't mutually exclusive, so it's probably
worth doing a first check before starting the whole operation (trying
to find out if the destination is a parent of the source based on
file-truename), and then adding another check in the recursive loop to
try and detect inf-loops.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Ok, that is true for the solutions you propose below, but what's wrong
>> with the solution I have proposed:
>> Just checking if the destination directory is a subdirectory of the
>> directory we want to copy.
>
> It's not a bad plan, but it's difficult to make it catch all cases
> because it's difficult to figure out if "the destination directory is
> a subdirectory of the directory we want to copy".
> [ e.g. because of ignored cases differences, or use of different names
>   to refer to the same directory, because of MICROS~1 mangling.  ]
The function I sent works also on Windos, but yes maybe there is cases
where it doesn't work, don't know.
Would be nice if somebody find some use cases where it fails on windows.

> Of course checking if two directories are one and the same isn't that
> easy to do it reliably either (e.g. for lack of inodes on Windows
> systems, and actually I'm not sure what happens if we refer to the same
> dir via two different mount points, using GNU/Linux's "bind" mounts, or
> mounting dirs multiple times).
Hmm, didn't try that, recipe welcome.

> I guess the two options aren't mutually exclusive, so it's probably
> worth doing a first check before starting the whole operation (trying
> to find out if the destination is a parent of the source based on
> file-truename), and then adding another check in the recursive loop to
> try and detect inf-loops.
That seem good option, so actually only code to detect inf-loops is
missing to achieve that?

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

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Ok, that is true for the solutions you propose below, but what's wrong
>> with the solution I have proposed:
>> Just checking if the destination directory is a subdirectory of the
>> directory we want to copy.
>
> It's not a bad plan, but it's difficult to make it catch all cases
> because it's difficult to figure out if "the destination directory is
> a subdirectory of the directory we want to copy".
> [ e.g. because of ignored cases differences, or use of different names
>   to refer to the same directory, because of MICROS~1 mangling.  ]
>
> Of course checking if two directories are one and the same isn't that
> easy to do it reliably either (e.g. for lack of inodes on Windows
> systems, and actually I'm not sure what happens if we refer to the same
> dir via two different mount points, using GNU/Linux's "bind" mounts, or
> mounting dirs multiple times).
>
> I guess the two options aren't mutually exclusive, so it's probably
> worth doing a first check before starting the whole operation (trying
> to find out if the destination is a parent of the source based on
> file-truename), and then adding another check in the recursive loop to
> try and detect inf-loops.

Here a first shot of `copy-directory', with the first check disabled
(file-subdir-of-p) to test the detection of the inf-loop, can you have a
look?


--8<---------------cut here---------------start------------->8---
(defvar copy-directory-newdir-inode nil)
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
  "Copy DIRECTORY to NEWNAME.  Both args must be strings.
This function always sets the file modes of the output files to match
the corresponding input file.

The third arg KEEP-TIME non-nil means give the output files the same
last-modified time as the old ones.  (This works on only some systems.)

A prefix arg makes KEEP-TIME non-nil.

Noninteractively, the last argument PARENTS says whether to
create parent directories if they don't exist.  Interactively,
this happens by default.

If NEWNAME names an existing directory, copy DIRECTORY as a
subdirectory there.  However, if called from Lisp with a non-nil
optional argument COPY-CONTENTS, copy the contents of DIRECTORY
directly into NEWNAME instead."
  (interactive
   (let ((dir (read-directory-name
	       "Copy directory: " default-directory default-directory t nil)))
     (list dir
	   (read-directory-name
	    (format "Copy directory %s to: " dir)
	    default-directory default-directory nil nil)
	   current-prefix-arg t nil)))
  ;; (when (or (files-equal-p directory newname)
  ;;           (file-subdir-of-p newname directory))
  ;;   (error "Can't copy directory `%s' on itself" directory))
  ;; If default-directory is a remote directory, make sure we find its
  ;; copy-directory handler.
  (unwind-protect
       (let ((handler (or (find-file-name-handler directory 'copy-directory)
                          (find-file-name-handler newname 'copy-directory))))
         (if handler
             (funcall handler 'copy-directory directory newname keep-time parents)

             ;; Compute target name.
             (setq directory (file-truename (directory-file-name (expand-file-name directory)))
                   newname   (file-truename (directory-file-name (expand-file-name newname))))
             ;(setq copy-directory-newdir-inode (file-attributes newname))
             (cond ((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 and COPY-CONTENTS
                   ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
                   ((not copy-contents)
                    (setq newname (expand-file-name
                                   (file-name-nondirectory
                                    (directory-file-name directory))
                                   newname))
             
                    (and (file-exists-p newname)
                         (not (file-directory-p newname))
                         (error "Cannot overwrite non-directory %s with a directory"
                                newname))
                    (make-directory newname t)
                    (unless copy-directory-newdir-inode
                      (setq copy-directory-newdir-inode (nth 10 (file-attributes newname))))))

             ;; Copy recursively.
             (dolist (file
                       ;; We do not want to copy "." and "..".
                       (directory-files directory 'full
                                        directory-files-no-dot-files-regexp))
               (assert (not (equal (nth 10 (file-attributes file))
                                   copy-directory-newdir-inode))
                       nil "Hit inf-loop at `%s'" file)
               (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)))
                     (if (stringp (car attrs)) ; Symbolic link
                         (make-symbolic-link (car attrs) target t)
                         (copy-file file target t keep-time)))))

             ;; Set directory attributes.
             (let ((modes (file-modes directory))
                   (times (and keep-time (nth 5 (file-attributes directory)))))
               (if modes (set-file-modes newname modes))
               (if times (set-file-times newname times)))))
    (setq copy-directory-newdir-inode nil)))
--8<---------------cut here---------------end--------------->8---

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

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

[Stefan Monnier]

> Here a first shot of `copy-directory', with the first check disabled
> (file-subdir-of-p) to test the detection of the inf-loop, can you have a
> look?

I think we can install the file-subdir-of-p test now and leave the rest
for 24.2.  Can you (re)send the corresponding patch?  Note that
(or (files-equal-p directory newname)
    (file-subdir-of-p newname directory))
should be replaced by just (file-subdir-of-p newname directory), because
this primitive should be a "⊆" rather than "⊂".

> --8<---------------cut here---------------start------------->8---

I always prefer a patch rather than the resulting code, so I don't have
to look for the source code to see what's changed.


        Stefan

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

[Thierry Volpiatto]

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

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Here a first shot of `copy-directory', with the first check disabled
>> (file-subdir-of-p) to test the detection of the inf-loop, can you have a
>> look?
>
> I think we can install the file-subdir-of-p test now and leave the rest
> for 24.2.  Can you (re)send the corresponding patch?  Note that
> (or (files-equal-p directory newname)
>     (file-subdir-of-p newname directory))
> should be replaced by just (file-subdir-of-p newname directory), because
> this primitive should be a "⊆" rather than "⊂".
Done, you should have received the patch. 

>
> I always prefer a patch rather than the resulting code, so I don't have
> to look for the source code to see what's changed.
Ok, here the patch for only `copy-directory' with the check by
`file-subdir-of-p' disabled for testing purpose.


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

##Merge of all patches applied from revision 118951
## patch-r118952: Return Error when trying to copy a directory on itself.
## patch-r118953: * lisp/files.el (copy-directory): Improve error message.
## 
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4935,6 +4935,7 @@
               (equal (file-attributes (file-truename root))
                      (file-attributes f2))))))
 
+(defvar copy-directory-newdir-inode nil)
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -4961,54 +4962,63 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
-  (when (file-subdir-of-p newname directory)
-    (error "Can't copy directory `%s' on itself" directory))
+  ;; (when (file-subdir-of-p newname directory)
+  ;;   (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
-  (let ((handler (or (find-file-name-handler directory 'copy-directory)
-                     (find-file-name-handler newname 'copy-directory))))
-    (if handler
-	(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)))
-
-      (cond ((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 and COPY-CONTENTS
-	    ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
-	    ((not copy-contents)
-	     (setq newname (expand-file-name
-			    (file-name-nondirectory
-			     (directory-file-name directory))
-			    newname))
-	     (and (file-exists-p newname)
-		  (not (file-directory-p newname))
-		  (error "Cannot overwrite non-directory %s with a directory"
-			 newname))
-	     (make-directory newname t)))
-
-      ;; Copy recursively.
-      (dolist (file
-	       ;; 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)))
-	    (if (stringp (car attrs))   ; Symbolic link
-		(make-symbolic-link (car attrs) target t)
-	      (copy-file file target t keep-time)))))
-
-      ;; Set directory attributes.
-      (let ((modes (file-modes directory))
-	    (times (and keep-time (nth 5 (file-attributes directory)))))
-	(if modes (set-file-modes newname modes))
-	(if times (set-file-times newname times))))))
+  (unwind-protect
+       (let ((handler (or (find-file-name-handler directory 'copy-directory)
+                          (find-file-name-handler newname 'copy-directory))))
+         (if handler
+             (funcall handler 'copy-directory directory newname keep-time parents)
+
+             ;; Compute target name.
+             (setq directory (file-truename (directory-file-name (expand-file-name directory)))
+                   newname   (file-truename (directory-file-name (expand-file-name newname))))
+             (cond ((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 and COPY-CONTENTS
+                   ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
+                   ((not copy-contents)
+                    (setq newname (expand-file-name
+                                   (file-name-nondirectory
+                                    (directory-file-name directory))
+                                   newname))
+             
+                    (and (file-exists-p newname)
+                         (not (file-directory-p newname))
+                         (error "Cannot overwrite non-directory %s with a directory"
+                                newname))
+                    (make-directory newname t)
+                    (unless copy-directory-newdir-inode
+                      (setq copy-directory-newdir-inode (nth 10 (file-attributes newname))))))
+
+             ;; Copy recursively.
+             (dolist (file
+                       ;; We do not want to copy "." and "..".
+                       (directory-files directory 'full
+                                        directory-files-no-dot-files-regexp))
+               (assert (not (equal (nth 10 (file-attributes file))
+                                   copy-directory-newdir-inode))
+                       nil "Unable to create directory `%s' in itself `%s'"
+                       (file-name-nondirectory (directory-file-name file))
+                       (file-name-directory (directory-file-name newname)))
+               (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)))
+                     (if (stringp (car attrs)) ; Symbolic link
+                         (make-symbolic-link (car attrs) target t)
+                         (copy-file file target t keep-time)))))
+
+             ;; Set directory attributes.
+             (let ((modes (file-modes directory))
+                   (times (and keep-time (nth 5 (file-attributes directory)))))
+               (if modes (set-file-modes newname modes))
+               (if times (set-file-times newname times)))))
+    (setq copy-directory-newdir-inode nil)))
 \f
 (put 'revert-buffer-function 'permanent-local t)
 (defvar revert-buffer-function nil

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



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

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

[Thierry Volpiatto]

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

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> I think we can install the file-subdir-of-p test now and leave the rest
> for 24.2.  Can you (re)send the corresponding patch?  Note that
> (or (files-equal-p directory newname)
>     (file-subdir-of-p newname directory))
> should be replaced by just (file-subdir-of-p newname directory), because
> this primitive should be a "⊆" rather than "⊂".

I have removed one more occurence of `files-equal-p' no more needed in
dired-aux.el.
So this function is not needed actually; I have not removed it though.
Maybe I should and add it only after 24.1?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: dired-create-files modif --]
[-- Type: text/x-diff, Size: 26063 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1330061336 -3600
# Node ID b41b1ec2b6dbe7fa96efa4b1a0dcb3be8133a46c
# Parent  c136fe29a3a316a56bae9c9d8dec2d8add468d48
Fix bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy.

* lisp/files.el (files-equal-p): New, simple equality check between two filename.
(file-subdir-of-p): New, Check if file1 is subdir of file2.
(copy-directory): Return error when trying to copy a directory on itself.

* lisp/dired-aux.el (dired-copy-file-recursive): Same.
(dired-create-files): Modify destination when source is equal to dest when copying files.
Return also when dest is a subdir of source.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,26 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (file-subdir-of-p to from)
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1378,7 +1380,7 @@
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
+                                        &optional marker-char)
   "Create one or more new files from a list of existing files FN-LIST.
 This function also handles querying the user, updating Dired
 buffers, and displaying a success or failure message.
@@ -1401,10 +1403,14 @@
 Optional MARKER-CHAR is a character with which to mark every
 newfile's entry, or t to use the current marker character if the
 old file was marked."
-  (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
+  (let (dired-create-files-failures
+        failures
+        skipped
+        (success-count 0)
+        (total (length fn-list)))
+    (let (to
+          overwrite-query
+          overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -1430,10 +1436,26 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (file-directory-p to)
+                         (eq file-creator 'dired-copy-file))
+                (setq to destname))
+              (and (file-subdir-of-p destname from)
+                   (error "Can't copy directory `%s' on itself" from)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,25 +1478,25 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
+               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
 \f
 (defun dired-do-create-files (op-symbol file-creator operation arg
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -510,36 +510,14 @@
 		 (other :tag "Query" other))
   :group 'find-file)
 
-;; This is an odd variable IMO.
-;; You might wonder why it is needed, when we could just do:
-;; (set (make-local-variable 'enable-local-variables) nil)
-;; These two are not precisely the same.
-;; Setting this variable does not cause -*- mode settings to be
-;; ignored, whereas setting enable-local-variables does.
-;; Only three places in Emacs use this variable: tar and arc modes,
-;; and rmail.  The first two don't need it.  They already use
-;; inhibit-local-variables-regexps, which is probably enough, and
-;; could also just set enable-local-variables locally to nil.
-;; Them setting it has the side-effect that dir-locals cannot apply to
-;; eg tar files (?).  FIXME Is this appropriate?
-;; AFAICS, rmail is the only thing that needs this, and the only
-;; reason it uses it is for BABYL files (which are obsolete).
-;; These contain "-*- rmail -*-" in the first line, which rmail wants
-;; to respect, so that find-file on a BABYL file will switch to
-;; rmail-mode automatically (this is nice, but hardly essential,
-;; since most people are used to explicitly running a command to
-;; access their mail; M-x gnus etc).  Rmail files may happen to
-;; contain Local Variables sections in messages, which Rmail wants to
-;; ignore.  So AFAICS the only reason this variable exists is for a
-;; minor convenience feature for handling of an obsolete Rmail file format.
 (defvar local-enable-local-variables t
   "Like `enable-local-variables' but meant for buffer-local bindings.
 The meaningful values are nil and non-nil.  The default is non-nil.
 If a major mode sets this to nil, buffer-locally, then any local
-variables list in a file visited in that mode will be ignored.
-
-This variable does not affect the use of major modes specified
-in a -*- line.")
+variables list in the file will be ignored.
+
+This variable does not affect the use of major modes
+specified in a -*- line.")
 
 (defcustom enable-local-eval 'maybe
   "Control processing of the \"variable\" `eval' in a file's local variables.
@@ -981,18 +959,20 @@
 
 (defcustom remote-file-name-inhibit-cache 10
   "Whether to use the remote file-name cache for read access.
-When `nil', never expire cached values (caution)
-When `t', never use the cache (safe, but may be slow)
-A number means use cached values for that amount of seconds since caching.
-
-The attributes of remote files are cached for better performance.
-If they are changed outside of Emacs's control, the cached values
-become invalid, and must be reread.  If you are sure that nothing
-other than Emacs changes the files, you can set this variable to `nil'.
-
-If a remote file is checked regularly, it might be a good idea to
-let-bind this variable to a value less than the interval between
-consecutive checks.  For example:
+
+When `nil', always use the cached values.
+When `t', never use them.
+A number means use them for that amount of seconds since they were
+cached.
+
+File attributes of remote files are cached for better performance.
+If they are changed out of Emacs' control, the cached values
+become invalid, and must be invalidated.
+
+In case a remote file is checked regularly, it might be
+reasonable to let-bind this variable to a value less then the
+time period between two checks.
+Example:
 
   (defun display-time-file-nonempty-p (file)
     (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
@@ -2425,6 +2405,9 @@
 calling FUNCTION (if it's not nil), we delete the suffix that matched
 REGEXP and search the list again for another match.
 
+If the file name matches `inhibit-first-line-modes-regexps',
+then `auto-mode-alist' is not processed.
+
 The extensions whose FUNCTION is `archive-mode' should also
 appear in `auto-coding-alist' with `no-conversion' coding system.
 
@@ -2495,55 +2478,16 @@
 
 See also `auto-mode-alist'.")
 
-(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
-  'inhibit-file-local-variables-regexps "24.1")
-
-;; TODO really this should be a list of modes (eg tar-mode), not regexps,
-;; because we are duplicating info from auto-mode-alist.
-;; TODO many elements of this list are also in auto-coding-alist.
-(defvar inhibit-local-variables-regexps
-  (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
-		      "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
-		      "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
-		      "\\.7z\\'"
-		      "\\.sx[dmicw]\\'" "\\.odt\\'"
-		      "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
-  "List of regexps matching file names in which to ignore local variables.
-This includes `-*-' lines as well as trailing \"Local Variables\" sections.
-Files matching this list are typically binary file formats.
-They may happen to contain sequences that look like local variable
-specifications, but are not really, or they may be containers for
-member files with their own local variable sections, which are
-not appropriate for the containing file.
-See also `inhibit-local-variables-suffixes'.")
-
-(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
-  'inhibit-local-variables-suffixes "24.1")
-
-(defvar inhibit-local-variables-suffixes nil
-  "List of regexps matching suffixes to remove from file names.
-When checking `inhibit-local-variables-regexps', we first discard
+(defvar inhibit-first-line-modes-regexps
+  (mapcar 'purecopy '("\\.tar\\'" "\\.tgz\\'" "\\.tiff?\\'"
+		      "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
+  "List of regexps; if one matches a file name, don't look for `-*-'.")
+
+(defvar inhibit-first-line-modes-suffixes nil
+  "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
+When checking `inhibit-first-line-modes-regexps', we first discard
 from the end of the file name anything that matches one of these regexps.")
 
-;; TODO explicitly add case-fold-search t?
-(defun inhibit-local-variables-p ()
-  "Return non-nil if file local variables should be ignored.
-This checks the file (or buffer) name against `inhibit-local-variables-regexps'
-and `inhibit-local-variables-suffixes'."
-  (let ((temp inhibit-local-variables-regexps)
-	(name (if buffer-file-name
-		  (file-name-sans-versions buffer-file-name)
-		(buffer-name))))
-    (while (let ((sufs inhibit-local-variables-suffixes))
-	     (while (and sufs (not (string-match (car sufs) name)))
-	       (setq sufs (cdr sufs)))
-	     sufs)
-      (setq name (substring name 0 (match-beginning 0))))
-    (while (and temp
-		(not (string-match (car temp) name)))
-      (setq temp (cdr temp)))
-    temp))
-
 (defvar auto-mode-interpreter-regexp
   (purecopy "#![ \t]?\\([^ \t\n]*\
 /bin/env[ \t]\\)?\\([^ \t\n]+\\)")
@@ -2606,24 +2550,21 @@
 (defun set-auto-mode (&optional keep-mode-if-same)
   "Select major mode appropriate for current buffer.
 
-To find the right major mode, this function checks for a -*- mode tag
+To find the right major mode, this function checks for a -*- mode tag,
 checks for a `mode:' entry in the Local Variables section of the file,
 checks if it uses an interpreter listed in `interpreter-mode-alist',
 matches the buffer beginning against `magic-mode-alist',
 compares the filename against the entries in `auto-mode-alist',
 then matches the buffer beginning against `magic-fallback-mode-alist'.
 
-If `enable-local-variables' is nil, or if the file name matches
-`inhibit-local-variables-regexps', this function does not check
-for any mode: tag anywhere in the file.  If `local-enable-local-variables'
-is nil, then the only mode: tag that can be relevant is a -*- one.
+If `enable-local-variables' is nil, this function does not check for
+any mode: tag anywhere in the file.
 
 If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
 set the major mode only if that would change it.  In other words
 we don't actually set it to the same mode the buffer already has."
   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
-  (let ((try-locals (not (inhibit-local-variables-p)))
-	end done mode modes)
+  (let (end done mode modes)
     ;; Once we drop the deprecated feature where mode: is also allowed to
     ;; specify minor-modes (ie, there can be more than one "mode:"), we can
     ;; remove this section and just let (hack-local-variables t) handle it.
@@ -2631,9 +2572,7 @@
     (save-excursion
       (goto-char (point-min))
       (skip-chars-forward " \t\n")
-      ;; Note by design local-enable-local-variables does not matter here.
       (and enable-local-variables
-	   try-locals
 	   (setq end (set-auto-mode-1))
 	   (if (save-excursion (search-forward ":" end t))
 	       ;; Find all specifications for the `mode:' variable
@@ -2664,12 +2603,8 @@
 	      (or (set-auto-mode-0 mode keep-mode-if-same)
 		  ;; continuing would call minor modes again, toggling them off
 		  (throw 'nop nil))))))
-    ;; hack-local-variables checks local-enable-local-variables etc, but
-    ;; we might as well be explicit here for the sake of clarity.
     (and (not done)
 	 enable-local-variables
-	 local-enable-local-variables
-	 try-locals
 	 (setq mode (hack-local-variables t))
 	 (not (memq mode modes))	; already tried and failed
 	 (if (not (functionp mode))
@@ -2779,24 +2714,38 @@
 (defun set-auto-mode-1 ()
   "Find the -*- spec in the buffer.
 Call with point at the place to start searching from.
-If one is found, set point to the beginning and return the position
-of the end.  Otherwise, return nil; may change point.
-The variable `inhibit-local-variables-regexps' can cause a -*- spec to
-be ignored; but `enable-local-variables' and `local-enable-local-variables'
-have no effect."
+If one is found, set point to the beginning
+and return the position of the end.
+Otherwise, return nil; point may be changed."
   (let (beg end)
     (and
      ;; Don't look for -*- if this file name matches any
-     ;; of the regexps in inhibit-local-variables-regexps.
-     (not (inhibit-local-variables-p))
+     ;; of the regexps in inhibit-first-line-modes-regexps.
+     (let ((temp inhibit-first-line-modes-regexps)
+	   (name (if buffer-file-name
+		     (file-name-sans-versions buffer-file-name)
+		   (buffer-name))))
+       (while (let ((sufs inhibit-first-line-modes-suffixes))
+		(while (and sufs (not (string-match (car sufs) name)))
+		  (setq sufs (cdr sufs)))
+		sufs)
+	 (setq name (substring name 0 (match-beginning 0))))
+       (while (and temp
+		   (not (string-match (car temp) name)))
+	 (setq temp (cdr temp)))
+       (not temp))
+
      (search-forward "-*-" (line-end-position
-                            ;; If the file begins with "#!"  (exec
-                            ;; interpreter magic), look for mode frobs
-                            ;; in the first two lines.  You cannot
-                            ;; necessarily put them in the first line
-                            ;; of such a file without screwing up the
-                            ;; interpreter invocation.  The same holds
-                            ;; for '\" in man pages (preprocessor
+                            ;; If the file begins with "#!"
+                            ;; (exec interpreter magic), look
+                            ;; for mode frobs in the first two
+                            ;; lines.  You cannot necessarily
+                            ;; put them in the first line of
+                            ;; such a file without screwing up
+                            ;; the interpreter invocation.
+                            ;; The same holds for
+                            ;;   '\"
+                            ;; in man pages (preprocessor
                             ;; magic for the `man' program).
                             (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
      (progn
@@ -3141,41 +3090,19 @@
 If MODE-ONLY is non-nil, all we do is check whether a \"mode:\"
 is specified, and return the corresponding mode symbol, or nil.
 In this case, we try to ignore minor-modes, and only return a
-major-mode.
-
-If `enable-local-variables' or `local-enable-local-variables' is nil,
-this function does nothing.  If `inhibit-local-variables-regexps'
-applies to the file in question, the file is not scanned for
-local variables, but directory-local variables may still be applied."
-  ;; We don't let inhibit-local-variables-p influence the value of
-  ;; enable-local-variables, because then it would affect dir-local
-  ;; variables.  We don't want to search eg tar files for file local
-  ;; variable sections, but there is no reason dir-locals cannot apply
-  ;; to them.  The real meaning of inhibit-local-variables-p is "do
-  ;; not scan this file for local variables".
+major-mode."
   (let ((enable-local-variables
 	 (and local-enable-local-variables enable-local-variables))
 	result)
     (unless mode-only
       (setq file-local-variables-alist nil)
       (report-errors "Directory-local variables error: %s"
-	;; Note this is a no-op if enable-local-variables is nil.
 	(hack-dir-local-variables)))
-    ;; This entire function is basically a no-op if enable-local-variables
-    ;; is nil.  All it does is set file-local-variables-alist to nil.
-    (when enable-local-variables
-      ;; This part used to ignore enable-local-variables when mode-only
-      ;; was non-nil.  That was inappropriate, eg consider the
-      ;; (artificial) example of:
-      ;; (setq local-enable-local-variables nil)
-      ;; Open a file foo.txt that contains "mode: sh".
-      ;; It correctly opens in text-mode.
-      ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
-      (unless (or (inhibit-local-variables-p)
-		  ;; If MODE-ONLY is non-nil, and the prop line specifies a
-		  ;; mode, then we're done, and have no need to scan further.
-		  (and (setq result (hack-local-variables-prop-line mode-only))
-		       mode-only))
+    (when (or mode-only enable-local-variables)
+      ;; If MODE-ONLY is non-nil, and the prop line specifies a mode,
+      ;; then we're done, and have no need to scan further.
+      (unless (and (setq result (hack-local-variables-prop-line mode-only))
+		   mode-only)
 	;; Look for "Local variables:" line in last page.
 	(save-excursion
 	  (goto-char (point-max))
@@ -3265,13 +3192,14 @@
 					    (indirect-variable var))
 					  val) result)
 			    (error nil)))))
-		    (forward-line 1))))))))
-      ;; Now we've read all the local variables.
-      ;; If MODE-ONLY is non-nil, return whether the mode was specified.
-      (if mode-only result
-	;; Otherwise, set the variables.
-	(hack-local-variables-filter result nil)
-	(hack-local-variables-apply)))))
+		    (forward-line 1)))))))))
+    ;; Now we've read all the local variables.
+    ;; If MODE-ONLY is non-nil, return whether the mode was specified.
+    (cond (mode-only result)
+	  ;; Otherwise, set the variables.
+	  (enable-local-variables
+	   (hack-local-variables-filter result nil)
+	   (hack-local-variables-apply)))))
 
 (defun hack-local-variables-apply ()
   "Apply the elements of `file-local-variables-alist'.
@@ -3683,7 +3611,7 @@
   (interactive "FSet visited file name: ")
   (if (buffer-base-buffer)
       (error "An indirect buffer cannot visit a file"))
-  (let (truename old-try-locals)
+  (let (truename)
     (if filename
 	(setq filename
 	      (if (string-equal filename "")
@@ -3708,8 +3636,7 @@
 	(progn
 	  (and filename (lock-buffer filename))
 	  (unlock-buffer)))
-    (setq old-try-locals (not (inhibit-local-variables-p))
-	  buffer-file-name filename)
+    (setq buffer-file-name filename)
     (if filename			; make buffer name reflect filename.
 	(let ((new-name (file-name-nondirectory buffer-file-name)))
 	  (setq default-directory (file-name-directory buffer-file-name))
@@ -4861,13 +4788,7 @@
 (defun rename-uniquely ()
   "Rename current buffer to a similar name not already taken.
 This function is useful for creating multiple shell process buffers
-or multiple mail buffers, etc.
-
-Note that some commands, in particular those based on `compilation-mode'
-\(`compile', `grep', etc.) will reuse the current buffer if it has the
-appropriate mode even if it has been renamed.  So as well as renaming
-the buffer, you also need to switch buffers before running another
-instance of such commands."
+or multiple mail buffers, etc."
   (interactive)
   (save-match-data
     (let ((base-name (buffer-name)))
@@ -4985,6 +4906,35 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (equal (file-attributes (file-truename (expand-file-name file1)))
+              (file-attributes (file-truename (expand-file-name file2))))))
+
+(defun file-subdir-of-p (file1 file2)
+  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
+If directory FILE1 is the same than directory FILE2, return non--nil."
+  (when (and (not (or (file-remote-p file1)
+                      (file-remote-p file2)))
+             (not (string= file1 "/"))
+             (file-directory-p file1)
+             (file-directory-p file2))
+    (or (string= file2 "/")
+        (loop with f1 = (expand-file-name (file-truename file1))
+              with f2 = (expand-file-name (file-truename file2))
+              with ls1 = (split-string f1 "/" t)
+              with ls2 = (split-string f2 "/" t)
+              for p = (string-match "^/" f1)
+              for i in ls1
+              for j in ls2
+              when (string= i j)
+              concat (if p (concat "/" i) (concat i "/"))
+              into root
+              finally return
+              (equal (file-attributes (file-truename root))
+                     (file-attributes f2))))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -5011,10 +4961,12 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (file-subdir-of-p newname directory)
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+                     (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 
@@ -5048,7 +5000,7 @@
 	    (copy-directory file newname keep-time parents)
 	  (let ((target (expand-file-name (file-name-nondirectory file) newname))
 		(attrs (file-attributes file)))
-	    (if (stringp (car attrs)) ; Symbolic link
+	    (if (stringp (car attrs))   ; Symbolic link
 		(make-symbolic-link (car attrs) target t)
 	      (copy-file file target t keep-time)))))
 
@@ -5135,8 +5087,6 @@
 Optional third argument PRESERVE-MODES non-nil means don't alter
 the files modes.  Normally we reinitialize them using `normal-mode'.
 
-This function binds `revert-buffer-in-progress-p' non-nil while it operates.
-
 If the value of `revert-buffer-function' is non-nil, it is called to
 do all the work for this command.  Otherwise, the hooks
 `before-revert-hook' and `after-revert-hook' are run at the beginning

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


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

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

[Thierry Volpiatto]

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

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

> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>
>> I think we can install the file-subdir-of-p test now and leave the rest
>> for 24.2.  Can you (re)send the corresponding patch?  Note that
>> (or (files-equal-p directory newname)
>>     (file-subdir-of-p newname directory))
>> should be replaced by just (file-subdir-of-p newname directory), because
>> this primitive should be a "⊆" rather than "⊂".
>
> I have removed one more occurence of `files-equal-p' no more needed in
> dired-aux.el.
> So this function is not needed actually; I have not removed it though.
> Maybe I should and add it only after 24.1?

Just realize that this match was quite old.
I have merged this patch with last revision of today.
So ignore precedent and review this one.
I it's ok I will apply it on trunk.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Merge patch with last revision --]
[-- Type: text/x-diff, Size: 4998 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1330067166 -3600
# Node ID 71a95b366b8509169d01466c44f01c1bcd96d4f7
# Parent  d736ca342d20302be2fcb7e81f1c9e364b759663
Fix bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy.

* lisp/files.el (files-equal-p): New, simple equality check between two filename.
(file-subdir-of-p): New, Check if file1 is subdir of file2.
(copy-directory): Return error when trying to copy a directory on itself.

* lisp/dired-aux.el (dired-copy-file-recursive): Same.
(dired-create-files): Modify destination when source is equal to dest when copying files.
Return also when dest is a subdir of source.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,6 +1264,8 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (file-subdir-of-p to from)
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
 	     (eq t (car attrs))
@@ -1430,10 +1432,26 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (file-directory-p to)
+                         (eq file-creator 'dired-copy-file))
+                (setq to destname))
+              (and (file-subdir-of-p destname from)
+                   (error "Can't copy directory `%s' on itself" from)))
             (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
@@ -4985,6 +4985,35 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (equal (file-attributes (file-truename (expand-file-name file1)))
+              (file-attributes (file-truename (expand-file-name file2))))))
+
+(defun file-subdir-of-p (file1 file2)
+  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
+If directory FILE1 is the same than directory FILE2, return non--nil."
+  (when (and (not (or (file-remote-p file1)
+                      (file-remote-p file2)))
+             (not (string= file1 "/"))
+             (file-directory-p file1)
+             (file-directory-p file2))
+    (or (string= file2 "/")
+        (loop with f1 = (expand-file-name (file-truename file1))
+              with f2 = (expand-file-name (file-truename file2))
+              with ls1 = (split-string f1 "/" t)
+              with ls2 = (split-string f2 "/" t)
+              for p = (string-match "^/" f1)
+              for i in ls1
+              for j in ls2
+              when (string= i j)
+              concat (if p (concat "/" i) (concat i "/"))
+              into root
+              finally return
+              (equal (file-attributes (file-truename root))
+                     (file-attributes f2))))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -5011,6 +5040,8 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (file-subdir-of-p newname directory)
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)

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


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

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Date: Fri, 24 Feb 2012 08:16:08 +0100
> 
> Just realize that this match was quite old.
> I have merged this patch with last revision of today.
> So ignore precedent and review this one.
> I it's ok I will apply it on trunk.

Some feedback below.  Apologies if I say something silly because I
didn't track this discussion from the beginning.

> +  (when (file-subdir-of-p to from)
> +    (error "Can't copy directory `%s' on itself" from))

A better error message would be

  (error "Cannot copy `%s' into its subdirectory `%s'" from to)

IOW, don't assume that the fact of TO being a subdirectory of FROM is
immediately evident to the user, just by looking at one of them.

> +            ;; In this case the 'name-constructor' have set the destination
> +            ;; 'to' to "~/test/foo" because the old
> +            ;; emacs23 behavior of `copy-directory'
> +            ;; was no not create the subdir and copy instead the contents only.
                      ^^^^^^^^^^^^^
Something's wrong here.  Did you mean "to not create"?  If so, "not to
create the subdirectory and instead copy the contents" is clearer.

> +            ;; With it's new behavior
                       ^^^^
"its".  "It's" is a short for "it is", which is not what you want here.

>                                        (similar to cp shell command) we don't
                                                  ^^^^^^^^^^^^^^^^^^^
"to the `cp' shell command"

> +            ;; need such a construction, so modify the destination 'to' to
                  ^^^^^^^^^^^^^^^^^^^^^^^^
What "construction"?  This word doesn't belong here.

> +            ;; "~/test/" instead of "~/test/foo/".
> +            ;; If from and to are the same directory do the same,

Suggest to use FROM and TO, in caps, to distinguish arguments from the
rest of the comment text.

> +                   (error "Can't copy directory `%s' on itself" from)))

See above for a better error message text.

> +(defun files-equal-p (file1 file2)
> +  "Return non-nil if FILE1 and FILE2 name the same file."
> +  (and (equal (file-remote-p file1) (file-remote-p file2))
> +       (equal (file-attributes (file-truename (expand-file-name file1)))
> +              (file-attributes (file-truename (expand-file-name file2))))))

I don't understand why you use expand-file-name here: file-truename
does it for you anyway.

> +(defun file-subdir-of-p (file1 file2)
> +  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
> +If directory FILE1 is the same than directory FILE2, return non--nil."

Suggest to modify the doc string as follows:

  "Return non-nil if FILE1 is a subdirectory of FILE2.
Note that a directory is treated by this function as a subdirectory of itself."

Btw, I would call the arguments DIR1 and DIR2, otherwise the above
sounds awkward ("FILE1 is a subdirectory ...") and even begs a
question about what happens if FILE1 is not a directory, but a file
living inside the directory FILE2.

> +  (when (and (not (or (file-remote-p file1)
> +                      (file-remote-p file2)))
> +             (not (string= file1 "/"))

Unixism alert!  What about the equivalent "X:/" on Windows?

Also, what should the following return?

   (file-subdir-of-p "/" "/")

According to the doc string, it should return non-nil, but the above
string= condition would seem to cause it return nil, right?

> +    (or (string= file2 "/")

Same here, on both accounts.  Why do you single-case "/", anyway?
It's as good a directory as any.

> +        (loop with f1 = (expand-file-name (file-truename file1))
> +              with f2 = (expand-file-name (file-truename file2))

file-truename already expands its argument, so why would you need to
run it through expand-file-name again?

> +              for p = (string-match "^/" f1)

Unixism alert again!

> +              (equal (file-attributes (file-truename root))
> +                     (file-attributes f2))))))

Why don't you use files-equal-p here?

> +  (when (file-subdir-of-p newname directory)
> +    (error "Can't copy directory `%s' on itself" directory))

See above.

Finally, it looks like this function only works when its two arguments
already exist; when they don't, it returns nil.  If this is the
intent, it should be reflected in the doc string.

Thanks.

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

[Thierry Volpiatto]

Hi Eli and thanks for your feedback.

Eli Zaretskii <eliz@gnu.org> writes:

> Some feedback below.  Apologies if I say something silly because I
> didn't track this discussion from the beginning.
>
>> +  (when (file-subdir-of-p to from)
>> +    (error "Can't copy directory `%s' on itself" from))
>
> A better error message would be
>
>   (error "Cannot copy `%s' into its subdirectory `%s'" from to)
Agree.

> IOW, don't assume that the fact of TO being a subdirectory of FROM is
> immediately evident to the user, just by looking at one of them.
>
>> +            ;; In this case the 'name-constructor' have set the destination
>> +            ;; 'to' to "~/test/foo" because the old
>> +            ;; emacs23 behavior of `copy-directory'
>> +            ;; was no not create the subdir and copy instead the contents only.
>                       ^^^^^^^^^^^^^
> Something's wrong here.  Did you mean "to not create"?  If so, "not to
> create the subdirectory and instead copy the contents" is clearer.
>
>> +            ;; With it's new behavior
>                        ^^^^
> "its".  "It's" is a short for "it is", which is not what you want here.
Yes thanks, I always do this mistake.

>>                                        (similar to cp shell command) we don't
>                                                   ^^^^^^^^^^^^^^^^^^^
> "to the `cp' shell command"
>
>> +            ;; need such a construction, so modify the destination 'to' to
>                   ^^^^^^^^^^^^^^^^^^^^^^^^
> What "construction"?  This word doesn't belong here.
>
>> +            ;; "~/test/" instead of "~/test/foo/".
>> +            ;; If from and to are the same directory do the same,
Ok for all corrections in comments.

> Suggest to use FROM and TO, in caps, to distinguish arguments from the
> rest of the comment text.
>
>> +                   (error "Can't copy directory `%s' on itself" from)))
>
> See above for a better error message text.
Same agree on this.

>> +(defun files-equal-p (file1 file2)
>> +  "Return non-nil if FILE1 and FILE2 name the same file."
>> +  (and (equal (file-remote-p file1) (file-remote-p file2))
>> +       (equal (file-attributes (file-truename (expand-file-name file1)))
>> +              (file-attributes (file-truename (expand-file-name file2))))))
>
> I don't understand why you use expand-file-name here: file-truename
> does it for you anyway.
Yes, agree, vestiges of precedents changes.

>> +(defun file-subdir-of-p (file1 file2)
>> +  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
>> +If directory FILE1 is the same than directory FILE2, return non--nil."
>
> Suggest to modify the doc string as follows:
>
>   "Return non-nil if FILE1 is a subdirectory of FILE2.
> Note that a directory is treated by this function as a subdirectory of itself."
Ok

> Btw, I would call the arguments DIR1 and DIR2, otherwise the above
> sounds awkward ("FILE1 is a subdirectory ...") and even begs a
> question about what happens if FILE1 is not a directory, but a file
> living inside the directory FILE2.
Agree.

>> +  (when (and (not (or (file-remote-p file1)
>> +                      (file-remote-p file2)))
>> +             (not (string= file1 "/"))
>
> Unixism alert!  What about the equivalent "X:/" on Windows?
Think this is no more needed.

> Also, what should the following return?
>
>    (file-subdir-of-p "/" "/")
>
> According to the doc string, it should return non-nil, but the above
> string= condition would seem to cause it return nil, right?
Right.

>> +    (or (string= file2 "/")
>
> Same here, on both accounts.  Why do you single-case "/", anyway?
> It's as good a directory as any.
Should be removed yes.

>> +        (loop with f1 = (expand-file-name (file-truename file1))
>> +              with f2 = (expand-file-name (file-truename file2))
>
> file-truename already expands its argument, so why would you need to
> run it through expand-file-name again?
Yes same as above.

>> +              for p = (string-match "^/" f1)
>
> Unixism alert again!
No, it is not, this allow the function to work both on window and nix.
See (if p (concat "/" i) (concat i "/"))
Will add comment there.

>> +              (equal (file-attributes (file-truename root))
>> +                     (file-attributes f2))))))
>
> Why don't you use files-equal-p here?
I think I can, don't remember though, I have to check.

>> +  (when (file-subdir-of-p newname directory)
>> +    (error "Can't copy directory `%s' on itself" directory))
>
> See above.
Same agree.

> Finally, it looks like this function only works when its two arguments
> already exist; when they don't, it returns nil.  If this is the
> intent, it should be reflected in the doc string.
It is not the intent, but that is a good question, what if I copy e.g:

~/tmp/Test to ~/tmp/Test/Test1

where Test1 is a non--existing subdir of Test.

Will check this, thanks.

Though that the change that would follow later after 24.1 should fix
this, falling back with the same behavior as 'cp'.

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

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

[Thierry Volpiatto]

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

Eli Zaretskii <eliz@gnu.org> writes:

> A better error message would be
>
>   (error "Cannot copy `%s' into its subdirectory `%s'" from to)
Done

Have fixed commented block in `dired-create-files', have a look.

> I don't understand why you use expand-file-name here: file-truename
> does it for you anyway.
Fixed.

> Suggest to modify the doc string as follows:
Done.

Have modified `file-subdir-of-p' according to your advices.
Please have a look. (Tested with success on windows also)

(file-subdir-of-p "/" "/") works now.

> Finally, it looks like this function only works when its two arguments
> already exist; when they don't, it returns nil.  If this is the
> intent, it should be reflected in the doc string.
Fixed docstring.
Fixed `copy-directory' by doing another check of `file-subdir-of-p'
after creation of the non--existing subdir. Thanks for this.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Improved version with Eli advices --]
[-- Type: text/x-diff, Size: 5846 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1330085238 -3600
# Node ID 3006935d19d27ff609e7f691d436efcdeb3b928f
# Parent  d736ca342d20302be2fcb7e81f1c9e364b759663
Fix bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy.

* lisp/files.el (files-equal-p): New, simple equality check between two filename.
(file-subdir-of-p): New, Check if file1 is subdir of file2.
(copy-directory): Return error when trying to copy a directory on itself.

* lisp/dired-aux.el (dired-copy-file-recursive): Same.
(dired-create-files): Modify destination when source is equal to dest when copying files.
Return also when dest is a subdir of source.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,6 +1264,8 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (file-subdir-of-p to from)
+    (error "Cannot copy `%s' into its subdirectory `%s'" from to))
   (let ((attrs (file-attributes from)))
     (if (and recursive
 	     (eq t (car attrs))
@@ -1430,10 +1432,30 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself or one of its subdirectories.
+            ;; e.g "~/foo/" => "~/test/"
+            ;; or "~/foo/" =>"~/foo/"
+            ;; or "~/foo/ => ~/foo/bar/")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; TO to "~/test/foo" because the old emacs23 behavior
+            ;; of `copy-directory' was to not create the subdirectory
+            ;; and instead copy the contents.
+            ;; With the new behavior of `copy-directory'
+            ;; (similar to the `cp' shell command) we don't
+            ;; need such a construction of the target directory,
+            ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (file-directory-p to)
+                         (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)))
             (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
@@ -4985,6 +4985,34 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (equal (file-attributes (file-truename file1))
+              (file-attributes (file-truename file2)))))
+
+(defun file-subdir-of-p (dir1 dir2)
+  "Return non-nil if DIR1 is a subdirectory of DIR2.
+Note that a directory is treated by this function as a subdirectory of itself.
+This function only works when its two arguments already exist,
+when they don't, it returns nil."
+  (when (and (not (or (file-remote-p dir1)
+                      (file-remote-p dir2)))
+             (file-directory-p dir1)
+             (file-directory-p dir2))
+    (loop with f1 = (file-truename dir1)
+          with f2 = (file-truename dir2)
+          with ls1 = (or (split-string f1 "/" t) (list "/"))
+          with ls2 = (or (split-string f2 "/" t) (list "/"))
+          for p = (string-match "^/" f1)
+          for i in ls1
+          for j in ls2
+          when (string= i j)
+          concat (if p (concat "/" i) (concat i "/"))
+          into root
+          finally return
+          (files-equal-p (file-truename root) f2))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -5011,6 +5039,9 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (file-subdir-of-p newname directory)
+    (error "Cannot copy `%s' into its subdirectory `%s'"
+           directory newname))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
@@ -5025,7 +5056,12 @@
       (cond ((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))
+	     (make-directory newname parents)
+             ;; `file-subdir-of-p' doesn't handle non--existing directories,
+             ;; so double check now if NEWNAME is not a subdir of DIRECTORY.
+             (and (file-subdir-of-p newname directory)
+                  (error "Cannot copy `%s' into its subdirectory `%s'"
+                         directory newname)))
 	    ;; If NEWNAME is an existing directory and COPY-CONTENTS
 	    ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
 	    ((not copy-contents)

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



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

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

[Michael Albinus]

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

> --- a/lisp/files.el
> +++ b/lisp/files.el
> +(defun files-equal-p (file1 file2)
> +
> +(defun file-subdir-of-p (dir1 dir2)

For both functions, please check for a file name handler, and call it if
available. It doesn't matter that they are not implemented yet; there is
the fallback to the native implementation in that case.

With this check, I could start to implement the file name handlers in
Tramp's upstream repository.

> +(defun files-equal-p (file1 file2)
> +  "Return non-nil if FILE1 and FILE2 name the same file."
> +  (and (equal (file-remote-p file1) (file-remote-p file2))
> +       (equal (file-attributes (file-truename file1))
> +              (file-attributes (file-truename file2)))))

This implementation requires, that inode number and filesystem device
number are always unique. This is true for local files, if you run a
Unix-like system. It is not guaranteed for remote files. And it is even
not guaranted, if the local system is Windows: on mounted drives, the
returned inode number is 0:

(file-attributes "y:/.emacs")
=> (nil 1 101567 513 (20295 15877) (20234 46272) (20234 46272) 33083 "-rw-rw-rw-" nil 0 (47631 . 5881))

Best regards, Michael.

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

[Thierry Volpiatto]

Hi Michael,

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

> For both functions, please check for a file name handler, and call it if
> available. It doesn't matter that they are not implemented yet; there is
> the fallback to the native implementation in that case.
>
> With this check, I could start to implement the file name handlers in
> Tramp's upstream repository.
Do you mean something like in copy-directory:

--8<---------------cut here---------------start------------->8---
  (let ((handler (or (find-file-name-handler directory 'copy-directory)
		     (find-file-name-handler newname 'copy-directory))))
    (if handler
	(funcall handler 'copy-directory directory newname keep-time parents)
--8<---------------cut here---------------end--------------->8---


>> +(defun files-equal-p (file1 file2)
>> +  "Return non-nil if FILE1 and FILE2 name the same file."
>> +  (and (equal (file-remote-p file1) (file-remote-p file2))
>> +       (equal (file-attributes (file-truename file1))
>> +              (file-attributes (file-truename file2)))))
>
> This implementation requires, that inode number and filesystem device
> number are always unique. This is true for local files, if you run a
> Unix-like system. It is not guaranteed for remote files. And it is even
> not guaranted, if the local system is Windows: on mounted drives, the
> returned inode number is 0:
That annoying because the solution proposed by Stephane (stopping the
loop before being infinite) is based on Inode comparison, at least as I
have implemented it.

> (file-attributes "y:/.emacs")
> => (nil 1 101567 513 (20295 15877) (20234 46272) (20234 46272) 33083 "-rw-rw-rw-" nil 0 (47631 . 5881))

So what do you propose for such a case?

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

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

[Michael Albinus]

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

> Hi Michael,

Hi Thierry,

>> For both functions, please check for a file name handler, and call it if
>> available. It doesn't matter that they are not implemented yet; there is
>> the fallback to the native implementation in that case.
>>
>> With this check, I could start to implement the file name handlers in
>> Tramp's upstream repository.
> Do you mean something like in copy-directory:
>
> --8<---------------cut here---------------start------------->8---
>   (let ((handler (or (find-file-name-handler directory 'copy-directory)
> 		     (find-file-name-handler newname 'copy-directory))))
>     (if handler
> 	(funcall handler 'copy-directory directory newname keep-time parents)
> --8<---------------cut here---------------end--------------->8---

Yes. And in the example you have shown, please add COPY-CONTENTS to the
call of the handler, this is another error in `copy-directory'.

> So what do you propose for such a case?

Check, whether inode number and device number are trustworthy. A value
of 0 or '(0 0) isn't. Fall back to the hard way (compare file names via
string-equal).

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: Eli Zaretskii <eliz@gnu.org>,  10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 13:54:16 +0100
> 
> > +(defun files-equal-p (file1 file2)
> > +  "Return non-nil if FILE1 and FILE2 name the same file."
> > +  (and (equal (file-remote-p file1) (file-remote-p file2))
> > +       (equal (file-attributes (file-truename file1))
> > +              (file-attributes (file-truename file2)))))
> 
> This implementation requires, that inode number and filesystem device
> number are always unique. This is true for local files, if you run a
> Unix-like system. It is not guaranteed for remote files. And it is even
> not guaranted, if the local system is Windows: on mounted drives, the
> returned inode number is 0:

Mounted how (i.e. with what command or feature)?

Btw, this function is only interested in directories; do directories
also return a zero for inode in that case?

Anyway, I'd consider this a bug in `stat' implemented in w32.c, and
wouldn't bother the Lisp code with that.  The probability of 2
directories having _all_ of their attributes identical is very small,
even if we don't fix this in w32.c.  As an additional precaution, we
could compare their absolute file names as well.

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> This implementation requires, that inode number and filesystem device
>> number are always unique. This is true for local files, if you run a
>> Unix-like system. It is not guaranteed for remote files. And it is even
>> not guaranted, if the local system is Windows: on mounted drives, the
>> returned inode number is 0:
>
> Mounted how (i.e. with what command or feature)?

Don't know, somebody has added "network drives" to my login. All I can
say is

--8<---------------cut here---------------start------------->8---
U:\>net use
New connections will be remembered.

Status       Local     Remote                    Network
-------------------------------------------------------------------------------
Disconnected R:        \\ASLSDA0\ZENTRAL         Microsoft Windows Network
OK           U:        \\DESTGSFILN2\lb01177$    Microsoft Windows Network
OK           Y:        \\sambager1\albinus       Microsoft Windows Network
The command completed successfully.
--8<---------------cut here---------------end--------------->8---

> Btw, this function is only interested in directories; do directories
> also return a zero for inode in that case?

We are speaking about (defun files-equal-p (file1 file2) ...
This is also for files.

However, there is the same problem with directories:

(file-attributes "y:/")
=> (t 1 101567 513 (0 0) (0 0) (0 0) 0 "drwxrwxrwx" nil 0 (47631 . 5881))

> Anyway, I'd consider this a bug in `stat' implemented in w32.c, and
> wouldn't bother the Lisp code with that.

OK, that would be fine. Do we know, that device number and inode number
are trustworthy on all systems Emacs runs? When I've started with Tramp
years ago, it was the first lesson I've learnt, that we shouldn't use
inode and device numbers for serious things. And I have the impression,
both values aren't used heavily (this was a result of code inspection
some years ago, it might have changed).

> The probability of 2 directories having _all_ of their attributes
> identical is very small, even if we don't fix this in w32.c.

We are also speaking about files. And then it is a problem. Example:

On UNIX:

# cp -p ~/.emacs ~/to-be-tested

On Windows (y: is my UNIX home directory):

(equal (file-attributes "y:/.emacs") (file-attributes "y:/to-be-tested"))
=> t

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: thierry.volpiatto@gmail.com,  10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 16:19:13 +0100
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> This implementation requires, that inode number and filesystem device
> >> number are always unique. This is true for local files, if you run a
> >> Unix-like system. It is not guaranteed for remote files. And it is even
> >> not guaranted, if the local system is Windows: on mounted drives, the
> >> returned inode number is 0:
> >
> > Mounted how (i.e. with what command or feature)?
> 
> Don't know, somebody has added "network drives" to my login. All I can
> say is
> 
> --8<---------------cut here---------------start------------->8---
> U:\>net use
> New connections will be remembered.
> 
> Status       Local     Remote                    Network
> -------------------------------------------------------------------------------
> Disconnected R:        \\ASLSDA0\ZENTRAL         Microsoft Windows Network
> OK           U:        \\DESTGSFILN2\lb01177$    Microsoft Windows Network
> OK           Y:        \\sambager1\albinus       Microsoft Windows Network
> The command completed successfully.
> --8<---------------cut here---------------end--------------->8---

And all of the \\server\share\foo directories, and also those below
them, return zero inodes?

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> Disconnected R:        \\ASLSDA0\ZENTRAL         Microsoft Windows Network
>> OK           U:        \\DESTGSFILN2\lb01177$    Microsoft Windows Network
>> OK           Y:        \\sambager1\albinus       Microsoft Windows Network
>> The command completed successfully.
>> --8<---------------cut here---------------end--------------->8---
>
> And all of the \\server\share\foo directories, and also those below
> them, return zero inodes?

I haven't checked. If it's important, I could do on Monday. Just tell me.

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: thierry.volpiatto@gmail.com,  10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 21:35:00 +0100
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> Disconnected R:        \\ASLSDA0\ZENTRAL         Microsoft Windows Network
> >> OK           U:        \\DESTGSFILN2\lb01177$    Microsoft Windows Network
> >> OK           Y:        \\sambager1\albinus       Microsoft Windows Network
> >> The command completed successfully.
> >> --8<---------------cut here---------------end--------------->8---
> >
> > And all of the \\server\share\foo directories, and also those below
> > them, return zero inodes?
> 
> I haven't checked. If it's important, I could do on Monday. Just tell me.

I'd like to know the extent of the problem.  Specifically, does _any_
networked drive trigger this problem, or just some of them?  If the
latter, is it perhaps limited to Samba (which seems to be the type of
the mount there), or anyway to the specific kind of software that
manages the mounted volume?

TIA

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> >> Disconnected R:        \\ASLSDA0\ZENTRAL         Microsoft Windows Network
>> >> OK           U:        \\DESTGSFILN2\lb01177$    Microsoft Windows Network
>> >> OK           Y:        \\sambager1\albinus       Microsoft Windows Network
>> >> The command completed successfully.
>> >> --8<---------------cut here---------------end--------------->8---
>> >
>> > And all of the \\server\share\foo directories, and also those below
>> > them, return zero inodes?
>> 
>> I haven't checked. If it's important, I could do on Monday. Just tell me.
>
> I'd like to know the extent of the problem.  Specifically, does _any_
> networked drive trigger this problem, or just some of them?  If the
> latter, is it perhaps limited to Samba (which seems to be the type of
> the mount there), or anyway to the specific kind of software that
> manages the mounted volume?

OK, here we are. The active network drives are DESTGSFILN2, which says

Domain=[RES1] OS=[Windows Server 2003 3790 Service Pack 2] Server=[Windows Server 2003 5.2]

and sambager1, claiming

Domain=[RES1] OS=[Unix] Server=[Samba 3.4.9]

My local machine, running Emacs 24.0.91, says

Domain=[EMEA] OS=[Windows 5.1] Server=[Windows 2000 LAN Manager]

It seems to run Windows XP Pro Service Pack 3. I'm not aware of a
special program mounting network drives.

The test results are:

--8<---------------cut here---------------start------------->8---
(file-attributes "//DESTGSFILN2/lb01177$")
(t 1 101567 513 (0 0) (0 0) (0 0) 0 "drwxrwxrwx" nil 0 (40652 . 16428))

(file-attributes "//DESTGSFILN2/lb01177$/.emacs.d")
(t 1 101567 513 (20299 16187) (18667 19266) (18567 12095) 0 "drwxrwxrwx" nil 0 (40652 . 16428))

(file-attributes "//DESTGSFILN2/lb01177$/.emacs.d/tramp")
(nil 1 101567 513 (19690 12422) (18667 19266) (18667 19266) 926 "-rw-rw-rw-" nil 0 (40652 . 16428))

(file-attributes "//sambager1/albinus")
(t 1 101567 513 (0 0) (0 0) (0 0) 0 "drwxrwxrwx" nil 0 (47631 . 5881))

(file-attributes "//sambager1/albinus/.emacs.d")
(t 1 101567 513 (20299 15958) (20295 47753) (20295 47753) 0 "drwxrwxrwx" nil 0 (47631 . 5881))

(file-attributes "//sambager1/albinus/.emacs.d/tramp")
(nil 1 101567 513 (20299 14091) (20295 47753) (20295 47753) 14769 "-rw-rw-rw-" nil 0 (47631 . 5881))
--8<---------------cut here---------------end--------------->8---

I would say, that a zero inode is returned in any case of a network drive
located file.

> TIA

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: thierry.volpiatto@gmail.com,  10489@debbugs.gnu.org
> Date: Mon, 27 Feb 2012 09:39:16 +0100
> 
> I would say, that a zero inode is returned in any case of a network drive
> located file.

Thanks for the data.

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

[Thierry Volpiatto]

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

>
> For both functions, please check for a file name handler, and call it if
> available. It doesn't matter that they are not implemented yet; there is
> the fallback to the native implementation in that case.

What about the check for file-remote-p in `file-subdir-of-p':

      (when (and (not (or (file-remote-p dir1)
                          (file-remote-p dir2)))

Is that ok for you?
Anyway you could always modify these functions for your need afterward.

> With this check, I could start to implement the file name handlers in
> Tramp's upstream repository.

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

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

[Michael Albinus]

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

Hi Thierry,

> What about the check for file-remote-p in `file-subdir-of-p':
>
>       (when (and (not (or (file-remote-p dir1)
>                           (file-remote-p dir2)))
>
> Is that ok for you?

No. Call a file name handler, and forget the rest.

> Anyway you could always modify these functions for your need afterward.

Sure. But I want to be able to tell "If you are using Emacs 24.1, take
Tramp 2.2.5, (which is more recent than the built-in) and your problem
will be solved". This guy hasn't to patch anything.

Best regards, Michael.

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Cc: 10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 13:18:05 +0100
> 
> Have modified `file-subdir-of-p' according to your advices.
> Please have a look. (Tested with success on windows also)

Looks good to me, thanks.

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

[Thierry Volpiatto]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
>> Cc: 10489@debbugs.gnu.org
>> Date: Fri, 24 Feb 2012 13:18:05 +0100
>> 
>> Have modified `file-subdir-of-p' according to your advices.
>> Please have a look. (Tested with success on windows also)
>
> Looks good to me, thanks.
Ok thanks, If no objections, I will apply this patch tonight.

However, Michael I would like to have more precisions for the call of
tramp handlers.

Thanks.

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

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

[Michael Albinus]

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

> However, Michael I would like to have more precisions for the call of
> tramp handlers.

What exactly? It's always the same scenario: Check for the handler, and
if there is any, call it. You can reuse the code snippet from all
functions which do so.

If you are uncertain, show your code; I'll comment.

> Thanks.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> However, Michael I would like to have more precisions for the call of
>> tramp handlers.
>
> What exactly?

Should the handler be called at the beginning of the function?
If it's the case, something is wrong in copy-directory.

> It's always the same scenario: Check for the handler, and if there is
> any, call it. You can reuse the code snippet from all functions which
> do so.
>
> If you are uncertain, show your code; I'll comment.
>
>> Thanks.
>
> Best regards, Michael.

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

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

[Michael Albinus]

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

> Should the handler be called at the beginning of the function?

In general, yes. But sometimes, there is the same code to be applied in
the native function and the handler. So it is done in the native code,
and the handler avoids that code.

> If it's the case, something is wrong in copy-directory.

I will check later on.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> However, Michael I would like to have more precisions for the call of
>> tramp handlers.
>
> What exactly? It's always the same scenario: Check for the handler, and
> if there is any, call it. You can reuse the code snippet from all
> functions which do so.
>
> If you are uncertain, show your code; I'll comment.
So here the functions, please have a look:

(defun files-equal-p (file1 file2)
  "Return non-nil if FILE1 and FILE2 name the same file."
  (let ((handler (or (find-file-name-handler file1 'files-equal-p)
                     (find-file-name-handler file2 'files-equal-p))))
    (if handler
        (funcall handler 'files-equal-p file1 file2)
      (and (equal (file-remote-p file1) (file-remote-p file2))
           (equal (file-attributes (file-truename file1))
                  (file-attributes (file-truename file2)))))))

(defun file-subdir-of-p (dir1 dir2)
  "Return non-nil if DIR1 is a subdirectory of DIR2.
Note that a directory is treated by this function as a subdirectory of itself.
This function only works when its two arguments already exist,
when they don't, it returns nil."
  (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
                     (find-file-name-handler dir2 'file-subdir-of-p))))
    (if handler
        (funcalll handler 'file-subdir-of-p dir1 dir2)
      (when (and (file-directory-p dir1)
                 (file-directory-p dir2))
        (loop with f1 = (file-truename dir1)
              with f2 = (file-truename dir2)
              with ls1 = (or (split-string f1 "/" t) (list "/"))
              with ls2 = (or (split-string f2 "/" t) (list "/"))
              for p = (string-match "^/" f1)
              for i in ls1
              for j in ls2
              when (string= i j)
              concat (if p (concat "/" i) (concat i "/"))
              into root
              finally return
              (files-equal-p (file-truename root) f2))))))


BTW I have added the COPY-CONTENTS arg to your handler in
`copy-directory'.

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

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

[Drew Adams]

Just a quick question about this:

>> +       (equal (file-attributes (file-truename (expand-file-name file1)))
>> +              (file-attributes (file-truename (expand-file-name file2))))))
>
> I don't understand why you use expand-file-name here:
> file-truename does it for you anyway.

That's true, but only for Emacs 24+.  Is there any chance that this code will be
used (say by Tramp) with Emacs < 24, where `file-truename' does not expand a
relative file name?

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

[Michael Albinus]

"Drew Adams" <drew.adams@oracle.com> writes:

>> I don't understand why you use expand-file-name here:
>> file-truename does it for you anyway.
>
> That's true, but only for Emacs 24+.  Is there any chance that this
> code will be used (say by Tramp) with Emacs < 24, where
> `file-truename' does not expand a relative file name?

"This code" belongs to a function introduced with Emacs 24. Tramp cannot
use it for older/other Emacsen, because it does not exist there :-)

If Tramp *emulates* this code, it is responsible to do it correctly.

Best regards, Michael.

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

[Drew Adams]

> >> I don't understand why you use expand-file-name here:
> >> file-truename does it for you anyway.
> >
> > That's true, but only for Emacs 24+.  Is there any chance that this
> > code will be used (say by Tramp) with Emacs < 24, where
> > `file-truename' does not expand a relative file name?
> 
> "This code" belongs to a function introduced with Emacs 24. 
> Tramp cannot use it for older/other Emacsen, because it does
> not exist there :-)
> 
> If Tramp *emulates* this code, it is responsible to do it correctly.

I see.  I guess by the last part you mean that if the next Tramp version (which
will presumably take advantage of this) were to be used with an older Emacs
version, then it would test `(fboundp 'files-equal-p)' and if nil do something
else (e.g. emulate it) to test equality.  Is that what you meant?

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

[Michael Albinus]

"Drew Adams" <drew.adams@oracle.com> writes:

> I see.  I guess by the last part you mean that if the next Tramp
> version (which will presumably take advantage of this) were to be used
> with an older Emacs version, then it would test `(fboundp
> 'files-equal-p)' and if nil do something else (e.g. emulate it) to
> test equality.  Is that what you meant?

Yes.

Best regards, Michael.

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

[Michael Albinus]

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

> (defun files-equal-p (file1 file2)
>   "Return non-nil if FILE1 and FILE2 name the same file."
>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
>                      (find-file-name-handler file2 'files-equal-p))))
>     (if handler
>         (funcall handler 'files-equal-p file1 file2)
>       (and (equal (file-remote-p file1) (file-remote-p file2))

Not needed anymore, you have called the handler already.

>            (equal (file-attributes (file-truename file1))
>                   (file-attributes (file-truename file2)))))))

Here we have the discussion about the inode numbers. But this is an edge
case; let's go this way. Eli will fix it for Windows :-)

> (defun file-subdir-of-p (dir1 dir2)
>   "Return non-nil if DIR1 is a subdirectory of DIR2.
> Note that a directory is treated by this function as a subdirectory of itself.
> This function only works when its two arguments already exist,
> when they don't, it returns nil."
>   (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
>                      (find-file-name-handler dir2 'file-subdir-of-p))))
>     (if handler
>         (funcalll handler 'file-subdir-of-p dir1 dir2)
>       (when (and (file-directory-p dir1)
>                  (file-directory-p dir2))
>         (loop with f1 = (file-truename dir1)
>               with f2 = (file-truename dir2)
>               with ls1 = (or (split-string f1 "/" t) (list "/"))
>               with ls2 = (or (split-string f2 "/" t) (list "/"))
>               for p = (string-match "^/" f1)
>               for i in ls1
>               for j in ls2
>               when (string= i j)
>               concat (if p (concat "/" i) (concat i "/"))
>               into root
>               finally return
>               (files-equal-p (file-truename root) f2))))))

Looks OK on the first glance.

> BTW I have added the COPY-CONTENTS arg to your handler in
> `copy-directory'.

Thanks.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> (defun files-equal-p (file1 file2)
>>   "Return non-nil if FILE1 and FILE2 name the same file."
>>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
>>                      (find-file-name-handler file2 'files-equal-p))))
>>     (if handler
>>         (funcall handler 'files-equal-p file1 file2)
>>       (and (equal (file-remote-p file1) (file-remote-p file2))
>
> Not needed anymore, you have called the handler already.
You mean this is not needed:

(and (equal (file-remote-p file1) (file-remote-p file2))

right?

>>            (equal (file-attributes (file-truename file1))
>>                   (file-attributes (file-truename file2)))))))
>
> Here we have the discussion about the inode numbers. But this is an edge
> case; let's go this way. Eli will fix it for Windows :-)
Yes I leave it as it is because it still not clear what to do here.
Think it is safe enough anyway.


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

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

[Michael Albinus]

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

>> Not needed anymore, you have called the handler already.
> You mean this is not needed:
>
> (and (equal (file-remote-p file1) (file-remote-p file2))
>
> right?

Yes.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>>> Not needed anymore, you have called the handler already.
>> You mean this is not needed:
>>
>> (and (equal (file-remote-p file1) (file-remote-p file2))
>>
>> right?
>
> Yes.
Thanks, applied.

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

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 17:02:16 +0100
> 
> (defun files-equal-p (file1 file2)
>   "Return non-nil if FILE1 and FILE2 name the same file."
>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
>                      (find-file-name-handler file2 'files-equal-p))))
>     (if handler
>         (funcall handler 'files-equal-p file1 file2)

If FILE1 and FILE2 have different 'files-equal-p handlers, which one
of them, if any, should be invoked here?

IOW, shouldn't we invoke a file handler only if it can handle _both_
files?  Also, if each file has a different handler, doesn't that in
itself already mean the files are not equal?

> (defun file-subdir-of-p (dir1 dir2)
>   "Return non-nil if DIR1 is a subdirectory of DIR2.
> Note that a directory is treated by this function as a subdirectory of itself.
> This function only works when its two arguments already exist,
> when they don't, it returns nil."
>   (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
>                      (find-file-name-handler dir2 'file-subdir-of-p))))
>     (if handler
>         (funcalll handler 'file-subdir-of-p dir1 dir2)

Same issue here.  Except that, unlike in the files-equal-p case, it's
not so clear what to do if each file has a different handler, or if
one has a handler, but the other doesn't.

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>,  10489@debbugs.gnu.org
>> Date: Fri, 24 Feb 2012 17:02:16 +0100
>> 
>> (defun files-equal-p (file1 file2)
>>   "Return non-nil if FILE1 and FILE2 name the same file."
>>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
>>                      (find-file-name-handler file2 'files-equal-p))))
>>     (if handler
>>         (funcall handler 'files-equal-p file1 file2)
>
> If FILE1 and FILE2 have different 'files-equal-p handlers, which one
> of them, if any, should be invoked here?

The one for FILE1.

> IOW, shouldn't we invoke a file handler only if it can handle _both_
> files?  Also, if each file has a different handler, doesn't that in
> itself already mean the files are not equal?

We shouldn't add too much to file name handler optimization here. The
handler will know what to do.

Likely, there won't be different handlers. It's always
`tramp-file-name-handler', which calls the respective sub-handlers.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
>>> Cc: Eli Zaretskii <eliz@gnu.org>,  10489@debbugs.gnu.org
>>> Date: Fri, 24 Feb 2012 17:02:16 +0100
>>> 
>>> (defun files-equal-p (file1 file2)
>>>   "Return non-nil if FILE1 and FILE2 name the same file."
>>>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
>>>                      (find-file-name-handler file2 'files-equal-p))))
>>>     (if handler
>>>         (funcall handler 'files-equal-p file1 file2)
>>
>> If FILE1 and FILE2 have different 'files-equal-p handlers, which one
>> of them, if any, should be invoked here?
>
> The one for FILE1.
>
>> IOW, shouldn't we invoke a file handler only if it can handle _both_
>> files?  Also, if each file has a different handler, doesn't that in
>> itself already mean the files are not equal?
>
> We shouldn't add too much to file name handler optimization here. The
> handler will know what to do.
>
> Likely, there won't be different handlers. It's always
> `tramp-file-name-handler', which calls the respective sub-handlers.

Now we have an error until you write handlers:

tramp-file-name-for-operation: unknown file I/O primitive:
file-subdir-of-p

This happen when copying with sudo method.

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

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

[Michael Albinus]

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

> Now we have an error until you write handlers:
>
> tramp-file-name-for-operation: unknown file I/O primitive:
> file-subdir-of-p
>
> This happen when copying with sudo method.

Should be fixed now.

Btw, it might be useful if you could add documentation about
`files-equal-p' and `file-subdir-of-p' in doc/lispref/files.texi.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Now we have an error until you write handlers:
>>
>> tramp-file-name-for-operation: unknown file I/O primitive:
>> file-subdir-of-p
>>
>> This happen when copying with sudo method.
>
> Should be fixed now.
Thanks.

> Btw, it might be useful if you could add documentation about
> `files-equal-p' and `file-subdir-of-p' in doc/lispref/files.texi.
I will have a look.

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

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

[Michael Albinus]

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

>> Btw, it might be useful if you could add documentation about
>> `files-equal-p' and `file-subdir-of-p' in doc/lispref/files.texi.
> I will have a look.

Thanks.

The implementation of `files-equal-p' returns t, if both FILE1 and FILE2
do not exist. Either it is a bug, or it must be documented.

Best regards, Michael.

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

[Thierry Volpiatto]

Hi Michael,

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>>> Btw, it might be useful if you could add documentation about
>>> `files-equal-p' and `file-subdir-of-p' in doc/lispref/files.texi.
>> I will have a look.
>
> Thanks.
>
> The implementation of `files-equal-p' returns t,

Of course,
(equal nil nil)=>t
where nil and nil are the file-attributes of non--existing files.

> if both FILE1 and FILE2 do not exist. Either it is a bug, or it must
> be documented.

We can fallback to string comparison when one of the file-attributes
return nil.
It would also make file-subdir-of-p working with non--existing dirnames.
(with one optional arg):

--8<---------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4991,10 +4991,16 @@
                      (find-file-name-handler file2 'files-equal-p))))
     (if handler
         (funcall handler 'files-equal-p file1 file2)
-      (equal (file-attributes (file-truename file1))
-             (file-attributes (file-truename file2))))))
-
-(defun file-subdir-of-p (dir1 dir2)
+      (let ((f1-attr (file-attributes (file-truename file1)))
+            (f2-attr (file-attributes (file-truename file2))))
+        (if (and f1-attr f2-attr)
+            (equal f1-attr f2-attr)
+          (string= (file-truename
+                    (file-name-as-directory file1))
+                   (file-truename
+                    (file-name-as-directory file2))))))))
+
+(defun file-subdir-of-p (dir1 dir2 &optional noexist)
   "Return non-nil if DIR1 is a subdirectory of DIR2.
 Note that a directory is treated by this function as a subdirectory of itself.
 This function only works when its two arguments already exist,
@@ -5003,8 +5009,9 @@
                      (find-file-name-handler dir2 'file-subdir-of-p))))
     (if handler
         (funcall handler 'file-subdir-of-p dir1 dir2)
-      (when (and (file-directory-p dir1)
-                 (file-directory-p dir2))
+      (when (or noexist
+                (and (file-directory-p dir1)
+                     (file-directory-p dir2)))
         (loop with f1 = (file-truename dir1)
               with f2 = (file-truename dir2)
               with ls1 = (or (split-string f1 "/" t) (list "/"))
--8<---------------cut here---------------end--------------->8---



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

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

[Stefan Monnier]

>> if both FILE1 and FILE2 do not exist. Either it is a bug, or it must
>> be documented.

Since file-equal-p checks equality of *files* as opposed to equality of
file *names*, all we need to do is to remind (in the docstring) that
this predicate is only defined on existing files.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>>> if both FILE1 and FILE2 do not exist. Either it is a bug, or it must
>>> be documented.
>
> Since file-equal-p checks equality of *files* as opposed to equality of
> file *names*, all we need to do is to remind (in the docstring) that
> this predicate is only defined on existing files.
I have modified files-equal-p and file-subdir-of-p to work with
non--existing files, this allow to remove one call to file-subdir-of-p
in copy-directory and not create the initial top directory in this case
(not in this patch yet).


--8<---------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4986,25 +4986,33 @@
       (delete-directory-internal directory)))))
 
 (defun files-equal-p (file1 file2)
-  "Return non-nil if FILE1 and FILE2 name the same file."
+  "Return non-nil if FILE1 and FILE2 name the same file.
+This function works even on non--existing files."
   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
                      (find-file-name-handler file2 'files-equal-p))))
     (if handler
         (funcall handler 'files-equal-p file1 file2)
-      (equal (file-attributes (file-truename file1))
-             (file-attributes (file-truename file2))))))
-
-(defun file-subdir-of-p (dir1 dir2)
+      (let ((f1-attr (file-attributes (file-truename file1)))
+            (f2-attr (file-attributes (file-truename file2))))
+        (if (and f1-attr f2-attr)
+            (equal f1-attr f2-attr)
+          (string= (file-truename
+                    (file-name-as-directory file1))
+                   (file-truename
+                    (file-name-as-directory file2))))))))
+
+(defun file-subdir-of-p (dir1 dir2 &optional noexist)
   "Return non-nil if DIR1 is a subdirectory of DIR2.
 Note that a directory is treated by this function as a subdirectory of itself.
-This function only works when its two arguments already exist,
-when they don't, it returns nil."
+This function only works when its two arguments already exist unless
+optional argument NOEXIST is non--nil, otherwise it returns nil."
   (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
                      (find-file-name-handler dir2 'file-subdir-of-p))))
     (if handler
-        (funcall handler 'file-subdir-of-p dir1 dir2)
-      (when (and (file-directory-p dir1)
-                 (file-directory-p dir2))
+        (funcall handler 'file-subdir-of-p dir1 dir2 noexist)
+      (when (or noexist
+                (and (file-directory-p dir1)
+                     (file-directory-p dir2)))
         (loop with f1 = (file-truename dir1)
               with f2 = (file-truename dir2)
               with ls1 = (or (split-string f1 "/" t) (list "/"))
--8<---------------cut here---------------end--------------->8---

I will apply it today if no objections.

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

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

[Stefan Monnier]

> I have modified files-equal-p and file-subdir-of-p to work with
> non--existing files,

Calling files-equal-p on non-existing files makes no sense, so I don't
think we should support it (at least not until we have concrete
evidence that it is needed, at which point we can decide what we intend
it to mean).


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> I have modified files-equal-p and file-subdir-of-p to work with
>> non--existing files,
>
> Calling files-equal-p on non-existing files makes no sense, so I don't
> think we should support it (at least not until we have concrete
> evidence that it is needed, at which point we can decide what we intend
> it to mean).
It is useful to handle e.g
(copy-directory "~/test" "~/test/test1")
where test1 is a non--existing directory.
Actually a check is done once test1 is build and stop the loop, 
so this would avoid creating an unuseful new directory.

We could give an optional arg noexist to files-equal-p.

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

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

[Stefan Monnier]

>>> I have modified files-equal-p and file-subdir-of-p to work with
>>> non--existing files,
>> Calling files-equal-p on non-existing files makes no sense, so I don't
>> think we should support it (at least not until we have concrete
>> evidence that it is needed, at which point we can decide what we intend
>> it to mean).
> It is useful to handle e.g
> (copy-directory "~/test" "~/test/test1")
> where test1 is a non--existing directory.

I see why we might want to signal an error to the user when she does
(copy-directory "~/test" "~/test/test1"), but I don't see why that
implies that we need files-equal-p to handle non-existent files.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>>> I have modified files-equal-p and file-subdir-of-p to work with
>>>> non--existing files,
>>> Calling files-equal-p on non-existing files makes no sense, so I don't
>>> think we should support it (at least not until we have concrete
>>> evidence that it is needed, at which point we can decide what we intend
>>> it to mean).
>> It is useful to handle e.g
>> (copy-directory "~/test" "~/test/test1")
>> where test1 is a non--existing directory.
>
> I see why we might want to signal an error to the user when she does
> (copy-directory "~/test" "~/test/test1"), but I don't see why that
> implies that we need files-equal-p to handle non-existent files.
Because if we don't do that, we have to create new directory Test1 and
then test if Test1 is a subdir of Test.
This just to avoid that.

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

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

[Michael Albinus]

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

>> I see why we might want to signal an error to the user when she does
>> (copy-directory "~/test" "~/test/test1"), but I don't see why that
>> implies that we need files-equal-p to handle non-existent files.
> Because if we don't do that, we have to create new directory Test1 and
> then test if Test1 is a subdir of Test.
> This just to avoid that.

This has to be handled in copy-directory. files-equal-p can (will!) be
used also somewhere else.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>>> I see why we might want to signal an error to the user when she does
>>> (copy-directory "~/test" "~/test/test1"), but I don't see why that
>>> implies that we need files-equal-p to handle non-existent files.
>> Because if we don't do that, we have to create new directory Test1 and
>> then test if Test1 is a subdir of Test.
>> This just to avoid that.
>
> This has to be handled in copy-directory.
It is actually handled in copy-directory.


> files-equal-p can (will!) be used also somewhere else.
It's why I propose a new optional arg for it.

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

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

[Stefan Monnier]

> Because if we don't do that, we have to create new directory Test1 and
> then test if Test1 is a subdir of Test.

No we don't have to do that.  We can do the extra work in copy-directory
(so we call file-equal-p on "~/test" rather than on "~/test/test1" when
"~/test/test1" doesn't exist yet).


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Because if we don't do that, we have to create new directory Test1 and
>> then test if Test1 is a subdir of Test.
>
> No we don't have to do that.  We can do the extra work in copy-directory
> (so we call file-equal-p on "~/test" rather than on "~/test/test1" when
> "~/test/test1" doesn't exist yet).
If you don't create test1, you will never have a value of
file-attributes for it, and file-directory-p will return always nil on
test1.

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

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

[Stefan Monnier]

>>> Because if we don't do that, we have to create new directory Test1 and
>>> then test if Test1 is a subdir of Test.
>> No we don't have to do that.  We can do the extra work in copy-directory
>> (so we call file-equal-p on "~/test" rather than on "~/test/test1" when
>> "~/test/test1" doesn't exist yet).
> If you don't create test1, you will never have a value of
> file-attributes for it, and file-directory-p will return always nil on
> test1.

I don't understand why you think that's a problem.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>>>> Because if we don't do that, we have to create new directory Test1 and
>>>> then test if Test1 is a subdir of Test.
>>> No we don't have to do that.  We can do the extra work in copy-directory
>>> (so we call file-equal-p on "~/test" rather than on "~/test/test1" when
>>> "~/test/test1" doesn't exist yet).
>> If you don't create test1, you will never have a value of
>> file-attributes for it, and file-directory-p will return always nil on
>> test1.
>
> I don't understand why you think that's a problem.
It's me who don't understand you, sorry.

We want to do:

(copy-directory "~/test" "~/test/test1")

"~/test/test1" is a non--existing directory.

Actually in copy-directory, I create "~/test/test1", and after doing
this, I check if this newly created directory is a subdir or "~/test" in
which case I exit with error.

If you don't create "test1" and file-subdir-of-p is unable to handle a
non--existing directory,I don't understand how you want to do.

It's so simple to do at start of function:

(file-subdir-of-p "~/test/test1" "~/test" 'noexist)

Where the NOEXIST arg allow file-subdir-of-p to bypass the
file-directory-p check (who will return nil on "test1").

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

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

[Michael Albinus]

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

> If you don't create "test1" and file-subdir-of-p is unable to handle a
> non--existing directory,I don't understand how you want to do.

I was saying that files-equal-p returns unexpected results in case both
files do not exist. I haven't spoken about file-subdir-of-p.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> If you don't create "test1" and file-subdir-of-p is unable to handle a
>> non--existing directory,I don't understand how you want to do.
>
> I was saying that files-equal-p returns unexpected results in case both
> files do not exist. 
In this case this version return nil even if noexist is not provided.

(defun files-equal-p (file1 file2 &optional noexist)
  "Return non-nil if FILE1 and FILE2 name the same file.
This function works even on non--existing files."
  (let ((handler (or (find-file-name-handler file1 'files-equal-p)
                     (find-file-name-handler file2 'files-equal-p))))
    (if handler
        (funcall handler 'files-equal-p file1 file2 noexist)
      (let ((f1-attr (file-attributes (file-truename file1)))
            (f2-attr (file-attributes (file-truename file2))))
        (if (and f1-attr f2-attr)
            (equal f1-attr f2-attr)
          (when noexist
            (string= (file-truename
                      (file-name-as-directory file1))
                     (file-truename
                      (file-name-as-directory file2)))))))))



> I haven't spoken about file-subdir-of-p.
>
> Best regards, Michael.

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

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

[Michael Albinus]

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

> In this case this version return nil even if noexist is not provided.
>
> (defun files-equal-p (file1 file2 &optional noexist)

We can continue to discuss, whether NOEXIST is needed. I believe it
isn't, people could use `file-exists-p'.

But I'm not (one of) the Emacs maintainer(s), who decide.

Best regards, Michael.

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

[Stefan Monnier]

>> If you don't create "test1" and file-subdir-of-p is unable to handle a
>> non--existing directory,I don't understand how you want to do.
> I was saying that files-equal-p returns unexpected results in case both
> files do not exist. I haven't spoken about file-subdir-of-p.

Exactly.  I don't think noexist is needed for subdir-p (it should accept
a non-existing dir for the `dir1' argument, without any need for
a noexist arg and it should reject a non-existing dir2), but I can live
with it, but file-equal-p only makes sense for existing files and should
not have a `noexist' argument.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>>> If you don't create "test1" and file-subdir-of-p is unable to handle a
>>> non--existing directory,I don't understand how you want to do.
>> I was saying that files-equal-p returns unexpected results in case both
>> files do not exist. I haven't spoken about file-subdir-of-p.
>
> Exactly.  I don't think noexist is needed for subdir-p (it should accept
> a non-existing dir for the `dir1' argument, without any need for
> a noexist arg and it should reject a non-existing dir2), but I can live
> with it, but file-equal-p only makes sense for existing files and should
> not have a `noexist' argument.
Ah! yes, thats sound good.
Just need to remove check of file-directory-p for dir1 in f-subdir-of-p.

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

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

[Thierry Volpiatto]

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

> Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>
>>>> If you don't create "test1" and file-subdir-of-p is unable to handle a
>>>> non--existing directory,I don't understand how you want to do.
>>> I was saying that files-equal-p returns unexpected results in case both
>>> files do not exist. I haven't spoken about file-subdir-of-p.
>>
>> Exactly.  I don't think noexist is needed for subdir-p (it should accept
>> a non-existing dir for the `dir1' argument, without any need for
>> a noexist arg and it should reject a non-existing dir2), but I can live
>> with it, but file-equal-p only makes sense for existing files and should
>> not have a `noexist' argument.
> Ah! yes, thats sound good.
> Just need to remove check of file-directory-p for dir1 in f-subdir-of-p.
Note that the last check:
(files-equal-p (file-truename root) dir2)
can be:
(files-equal-p root dir2)
file-truename is not needed here.

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

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>>
>>>>> If you don't create "test1" and file-subdir-of-p is unable to handle a
>>>>> non--existing directory,I don't understand how you want to do.
>>>> I was saying that files-equal-p returns unexpected results in case both
>>>> files do not exist. I haven't spoken about file-subdir-of-p.
>>>
>>> Exactly.  I don't think noexist is needed for subdir-p (it should accept
>>> a non-existing dir for the `dir1' argument, without any need for
>>> a noexist arg and it should reject a non-existing dir2), but I can live
>>> with it, but file-equal-p only makes sense for existing files and should
>>> not have a `noexist' argument.
>> Ah! yes, thats sound good.
>> Just need to remove check of file-directory-p for dir1 in f-subdir-of-p.
> Note that the last check:
> (files-equal-p (file-truename root) dir2)
> can be:
> (files-equal-p root dir2)
> file-truename is not needed here.
Here the patch:

--8<---------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4999,13 +4999,12 @@
 (defun file-subdir-of-p (dir1 dir2)
   "Return non-nil if DIR1 is a subdirectory of DIR2.
 A directory is considered to be a subdirectory of itself.
-Return nil if DIR1 or DIR2 are not existing directories."
+Return nil if top directory DIR2 is not an existing directory."
   (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
                      (find-file-name-handler dir2 'file-subdir-of-p))))
     (if handler
         (funcall handler 'file-subdir-of-p dir1 dir2)
-      (when (and (file-directory-p dir1)
-                 (file-directory-p dir2))
+      (when (file-directory-p dir2) ; Top dir must exist.
 	(setq dir1 (file-truename dir1)
 	      dir2 (file-truename dir2))
 	(let ((ls1  (or (split-string dir1 "/" t) '("/")))
@@ -5019,7 +5018,7 @@
 	    (setq ls1 (cdr ls1)
 		  ls2 (cdr ls2)))
 	  (unless mismatch
-	    (files-equal-p (file-truename root) dir2)))))))
+	    (files-equal-p root dir2)))))))
 
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
@@ -5065,12 +5064,7 @@
       (cond ((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)
-             ;; `file-subdir-of-p' doesn't handle non--existing directories,
-             ;; so double check now if NEWNAME is not a subdir of DIRECTORY.
-             (and (file-subdir-of-p newname directory)
-                  (error "Cannot copy `%s' into its subdirectory `%s'"
-                         directory newname)))
+	     (make-directory newname parents))
 	    ;; If NEWNAME is an existing directory and COPY-CONTENTS
 	    ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
 	    ((not copy-contents)
--8<---------------cut here---------------end--------------->8---

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

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

[Michael Albinus]

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

> Here the patch:

`files-equal-p' still returns t for two non-existing files. Shall be
fixed too.

Btw, this is the only primitive function which has the prefix "files-",
all other start with prefix "file-". Is this necessary?

(No it is not important, but if we want change it, we must do it before
the 24.1 release).

Best regards, Michael.

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

[Thierry Volpiatto]

Hi Michael,

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Here the patch:
>
> `files-equal-p' still returns t for two non-existing files. Shall be
> fixed too.
Fixed.

> Btw, this is the only primitive function which has the prefix "files-",
> all other start with prefix "file-". Is this necessary?
I wrote files because comparing two files, but I don't care of this,
just rename it to file-
> (No it is not important, but if we want change it, we must do it before
> the 24.1 release).

--8<---------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4985,27 +4985,27 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
-(defun files-equal-p (file1 file2)
+(defun file-equal-p (file1 file2)
   "Return non-nil if FILE1 and FILE2 name the same file.
 Ordinary files are considered to be the same if `file-attributes'
 returns `equal' values for them."
-  (let ((handler (or (find-file-name-handler file1 'files-equal-p)
-                     (find-file-name-handler file2 'files-equal-p))))
+  (let ((handler (or (find-file-name-handler file1 'file-equal-p)
+                     (find-file-name-handler file2 'file-equal-p))))
     (if handler
-        (funcall handler 'files-equal-p file1 file2)
-      (equal (file-attributes (file-truename file1))
-             (file-attributes (file-truename file2))))))
+        (funcall handler 'file-equal-p file1 file2)
+      (let ((f1-attr (file-attributes (file-truename file1)))
+            (f2-attr (file-attributes (file-truename file2))))
+        (and f1-attr f2-attr (equal f1-attr f2-attr))))))
 
 (defun file-subdir-of-p (dir1 dir2)
   "Return non-nil if DIR1 is a subdirectory of DIR2.
 A directory is considered to be a subdirectory of itself.
-Return nil if DIR1 or DIR2 are not existing directories."
+Return nil if top directory DIR2 is not an existing directory."
   (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
                      (find-file-name-handler dir2 'file-subdir-of-p))))
     (if handler
         (funcall handler 'file-subdir-of-p dir1 dir2)
-      (when (and (file-directory-p dir1)
-                 (file-directory-p dir2))
+      (when (file-directory-p dir2) ; Top dir must exist.
 	(setq dir1 (file-truename dir1)
 	      dir2 (file-truename dir2))
 	(let ((ls1  (or (split-string dir1 "/" t) '("/")))
@@ -5019,7 +5019,7 @@
 	    (setq ls1 (cdr ls1)
 		  ls2 (cdr ls2)))
 	  (unless mismatch
-	    (files-equal-p (file-truename root) dir2)))))))
+	    (file-equal-p root dir2)))))))
 
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
@@ -5065,12 +5065,7 @@
       (cond ((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)
-             ;; `file-subdir-of-p' doesn't handle non--existing directories,
-             ;; so double check now if NEWNAME is not a subdir of DIRECTORY.
-             (and (file-subdir-of-p newname directory)
-                  (error "Cannot copy `%s' into its subdirectory `%s'"
-                         directory newname)))
+	     (make-directory newname parents))
 	    ;; If NEWNAME is an existing directory and COPY-CONTENTS
 	    ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
 	    ((not copy-contents)
--8<---------------cut here---------------end--------------->8---

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

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

[Michael Albinus]

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

> Hi Michael,

Hi Thierry,

>> `files-equal-p' still returns t for two non-existing files. Shall be
>> fixed too.
> Fixed.

Looks good to me. Thanks!

>> Btw, this is the only primitive function which has the prefix "files-",
>> all other start with prefix "file-". Is this necessary?
> I wrote files because comparing two files, but I don't care of this,
> just rename it to file-

Thanks as well. I will change the name in Tramp once you have committed
your patch (or, even better, you do it in tramp.el when committing your
patch).

Still some nit-picking :-)

> -(defun files-equal-p (file1 file2)
> +(defun file-equal-p (file1 file2)
>    "Return non-nil if FILE1 and FILE2 name the same file.
>  Ordinary files are considered to be the same if `file-attributes'
>  returns `equal' values for them."

The file name handler implementation might not use `file-attributes'
(that's why we call the handler). Better, you don't say it such strictly
in the doc-string. Furthermore, I would like to see the phrase
"... existing files ..." somewhere.

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Hi Michael,
>
> Hi Thierry,
>
>>> `files-equal-p' still returns t for two non-existing files. Shall be
>>> fixed too.
>> Fixed.
>
> Looks good to me. Thanks!
>
>>> Btw, this is the only primitive function which has the prefix "files-",
>>> all other start with prefix "file-". Is this necessary?
>> I wrote files because comparing two files, but I don't care of this,
>> just rename it to file-
>
> Thanks as well. I will change the name in Tramp once you have committed
> your patch (or, even better, you do it in tramp.el when committing your
> patch).
Done (in tramp.el too)

> Still some nit-picking :-)
>
>> -(defun files-equal-p (file1 file2)
>> +(defun file-equal-p (file1 file2)
>>    "Return non-nil if FILE1 and FILE2 name the same file.
>>  Ordinary files are considered to be the same if `file-attributes'
>>  returns `equal' values for them."
>
> The file name handler implementation might not use `file-attributes'
> (that's why we call the handler). Better, you don't say it such strictly
> in the doc-string. Furthermore, I would like to see the phrase
> "... existing files ..." somewhere.
Done for "existing files", I have removed mention of `files-attributes'
comparison, as I really don't know what to put there.
I have fixed basically files.texi accordingly.
I leave more sophisticated documentation about tramp handler to you. ;-)

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

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

[Michael Albinus]

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

>> Thanks as well. I will change the name in Tramp once you have committed
>> your patch (or, even better, you do it in tramp.el when committing your
>> patch).
> Done (in tramp.el too)

>> The file name handler implementation might not use `file-attributes'
>> (that's why we call the handler). Better, you don't say it such strictly
>> in the doc-string. Furthermore, I would like to see the phrase
>> "... existing files ..." somewhere.
> Done for "existing files", I have removed mention of `files-attributes'
> comparison, as I really don't know what to put there.
> I have fixed basically files.texi accordingly.

Thanks!

> I leave more sophisticated documentation about tramp handler to you. ;-)

This could wait, until there are file name handler implementations.

Best regards, Michael.

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

[Stefan Monnier]

> `files-equal-p' still returns t for two non-existing files. Shall be
> fixed too.

I don't see why that should be fixed: files-equal-p only works for
existing files.  If one or both of the files don't exist, the return
value is unspecified.  Oh, yes, the doc needs to be fixed to say it clearly.

> Btw, this is the only primitive function which has the prefix "files-",
> all other start with prefix "file-". Is this necessary?

Agreed, using "file-" would be better.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>> `files-equal-p' still returns t for two non-existing files. Shall be
>> fixed too.
>
> I don't see why that should be fixed: files-equal-p only works for
> existing files.  If one or both of the files don't exist, the return
> value is unspecified.  Oh, yes, the doc needs to be fixed to say it clearly.

Why is this better than returning nil (which is easy to achieve)?
Because it doesn't matter?

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>>> `files-equal-p' still returns t for two non-existing files. Shall be
>>> fixed too.
>> I don't see why that should be fixed: files-equal-p only works for
>> existing files.  If one or both of the files don't exist, the return
>> value is unspecified.  Oh, yes, the doc needs to be fixed to say it clearly.
> Why is this better than returning nil (which is easy to achieve)?

It's not.

> Because it doesn't matter?

Yup,


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>>> `files-equal-p' still returns t for two non-existing files. Shall be
>>>> fixed too.
>>> I don't see why that should be fixed: files-equal-p only works for
>>> existing files.  If one or both of the files don't exist, the return
>>> value is unspecified.  Oh, yes, the doc needs to be fixed to say it clearly.
>> Why is this better than returning nil (which is easy to achieve)?
>
> It's not.

I see. There might be optimizations in file name handlers, for example
returning immediately t when both file names are identical.

Maybe we could change the entry in files.texi like this:

--8<---------------cut here---------------start------------->8---
*** /home/albinus/src/emacs/doc/lispref/files.texi.~107463~  2012-02-29 11:58:54.000000000 +0100
--- /home/albinus/src/emacs/doc/lispref/files.texi  2012-02-29 11:58:55.000000000 +0100
***************
*** 1020,1028 ****
  
  @defun file-equal-p file1 file2
  This function returns @code{t} if the files @var{file1} and
! @var{file2} name the same file.  Two ordinary files are considered to
! be the same if the function @code{file-attributes} (@pxref{File
! Attributes}) returns @code{equal} values for them.
  @end defun
  
  @defun file-subdir-of-p dir1 dir2
--- 1020,1034 ----
  
  @defun file-equal-p file1 file2
  This function returns @code{t} if the files @var{file1} and
! @var{file2} name the same file.  If @var{file1} or @var{file2} does
! not exist, the return value is unspecified.
! 
! If two files are equal, it does not imply that both file names specify
! accessible files.  For example, @file{/sudo::/foo/bar} might be
! accessible, but @file{file:///foo/bar} might not.  (@pxref{Remote
! Files,, Remote Files, emacs, The GNU Emacs Manual}, and
! @pxref{Supported URL Types,, Supported URL Types, url, URL
! Programmer's Manual})
  @end defun
  
  @defun file-subdir-of-p dir1 dir2
--8<---------------cut here---------------end--------------->8---

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

> Maybe we could change the entry in files.texi like this:
[...]
>   @defun file-equal-p file1 file2
>   This function returns @code{t} if the files @var{file1} and
> ! @var{file2} name the same file.  If @var{file1} or @var{file2} does
> ! not exist, the return value is unspecified.

That looks good.

> ! If two files are equal, it does not imply that both file names specify
> ! accessible files.  For example, @file{/sudo::/foo/bar} might be
> ! accessible, but @file{file:///foo/bar} might not.  (@pxref{Remote
> ! Files,, Remote Files, emacs, The GNU Emacs Manual}, and
> ! @pxref{Supported URL Types,, Supported URL Types, url, URL
> ! Programmer's Manual})

I'd rather not get into such issues in the doc.


        Stefan

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Maybe we could change the entry in files.texi like this:
> [...]
>>   @defun file-equal-p file1 file2
>>   This function returns @code{t} if the files @var{file1} and
>> ! @var{file2} name the same file.  If @var{file1} or @var{file2} does
>> ! not exist, the return value is unspecified.
>
> That looks good.
What can be done also is to return a string in this case.
So possible return values could be e.g:
"unspecified" => mean one of the files doesn't exists.
nil           => files exist and are not equal
t             => files exist and are equal.

>> ! If two files are equal, it does not imply that both file names specify
>> ! accessible files.  For example, @file{/sudo::/foo/bar} might be
>> ! accessible, but @file{file:///foo/bar} might not.  (@pxref{Remote
>> ! Files,, Remote Files, emacs, The GNU Emacs Manual}, and
>> ! @pxref{Supported URL Types,, Supported URL Types, url, URL
>> ! Programmer's Manual})
>
> I'd rather not get into such issues in the doc.
>
>
>         Stefan

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

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

[Stefan Monnier]

>>> Maybe we could change the entry in files.texi like this:
>> [...]
>>> @defun file-equal-p file1 file2
>>> This function returns @code{t} if the files @var{file1} and
>>> ! @var{file2} name the same file.  If @var{file1} or @var{file2} does
>>> ! not exist, the return value is unspecified.
>> 
>> That looks good.
> What can be done also is to return a string in this case.
> So possible return values could be e.g:
> "unspecified" => mean one of the files doesn't exists.
> nil           => files exist and are not equal
> t             => files exist and are equal.

No, we may decide in the future to return a particular value (maybe not
always the same one), but we don't know yet what might be useful, so
instead we say it's not specified.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Maybe we could change the entry in files.texi like this:
> [...]
>>   @defun file-equal-p file1 file2
>>   This function returns @code{t} if the files @var{file1} and
>> ! @var{file2} name the same file.  If @var{file1} or @var{file2} does
>> ! not exist, the return value is unspecified.
>
> That looks good.

Committed to files.texi and files.el.

>         Stefan

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>>> Btw, it might be useful if you could add documentation about
>>> `files-equal-p' and `file-subdir-of-p' in doc/lispref/files.texi.
>> I will have a look.
>
> Thanks.
>
> The implementation of `files-equal-p' returns t, if both FILE1 and FILE2
> do not exist. Either it is a bug, or it must be documented.
>
> Best regards, Michael.
To finish this thread, I would like to say I am not happy with the last
changes made to file-subdir-of-p by Chong Yidong without ANY
notifications.
Even after discussion about CL integration in Emacs, it seem it is not
for tomorrow.
i.e what is your problem with loop?

You will see that files.el contain this code at beginning of file:

(eval-when-compile (require 'cl))
 
-- 
  Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

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

[Michael Albinus]

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

> To finish this thread, I would like to say I am not happy with the last
> changes made to file-subdir-of-p by Chong Yidong without ANY
> notifications.
> Even after discussion about CL integration in Emacs, it seem it is not
> for tomorrow.
> i.e what is your problem with loop?

I cannot speak for Chong, but personally I dislike CL's loop. It isn't
readable, and so it decreases maintanability of such a basic package
like files.el.

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

[Thierry Volpiatto]

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> To finish this thread, I would like to say I am not happy with the last
>> changes made to file-subdir-of-p by Chong Yidong without ANY
>> notifications.
>> Even after discussion about CL integration in Emacs, it seem it is not
>> for tomorrow.
>> i.e what is your problem with loop?
>
> I cannot speak for Chong, but personally I dislike CL's loop.
Like many Emacs maintainers unfortunately.

> It isn't readable, and so it decreases maintanability of such a basic
> package like files.el.
I disagree.
Once you are used to it, it is more readable and easier to maintain.

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

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

[Drew Adams]

> > I cannot speak for Chong, but personally I dislike CL's loop.
> Like many Emacs maintainers unfortunately.
> 
> > It isn't readable, and so it decreases maintanability of 
> > such a basic package like files.el.
> I disagree.
> Once you are used to it, it is more readable and easier to maintain.

AFAIK, `loop' is a macro, so its use in Emacs source code is not a no-no.  There
is no need to require cl.el at runtime, in order to use `loop'.

(I personally am not a big fan of `loop', but I do use it sometimes.)

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

[Chong Yidong]

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

> To finish this thread, I would like to say I am not happy with the
> last changes made to file-subdir-of-p by Chong Yidong without ANY
> notifications.  Even after discussion about CL integration in Emacs,
> it seem it is not for tomorrow.  i.e what is your problem with loop?

Sorry, I would have brought it up in this thread except that I thought
the discussion was over.  I generally have no problem with Common Lisp,
but I'm not sure we want to have loop macros in a core Emacs file yet.
Since that code was easily translatable from Loop into Lisp, I went
ahead and did it.

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

[Thierry Volpiatto]

Chong Yidong <cyd@gnu.org> writes:

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> To finish this thread, I would like to say I am not happy with the
>> last changes made to file-subdir-of-p by Chong Yidong without ANY
>> notifications.  Even after discussion about CL integration in Emacs,
>> it seem it is not for tomorrow.  i.e what is your problem with loop?
>
> Sorry, I would have brought it up in this thread except that I thought
> the discussion was over.
> I generally have no problem with Common Lisp, but I'm not sure we want
> to have loop macros in a core Emacs file yet.
Note that "(eval-when-compile (require 'cl))" is at start of files.el.

> Since that code was easily translatable from Loop into Lisp, I went
> ahead and did it.

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

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: Thierry Volpiatto <thierry.volpiatto@gmail.com>,  10489@debbugs.gnu.org
> Date: Fri, 24 Feb 2012 21:33:26 +0100
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> >> Cc: Eli Zaretskii <eliz@gnu.org>,  10489@debbugs.gnu.org
> >> Date: Fri, 24 Feb 2012 17:02:16 +0100
> >> 
> >> (defun files-equal-p (file1 file2)
> >>   "Return non-nil if FILE1 and FILE2 name the same file."
> >>   (let ((handler (or (find-file-name-handler file1 'files-equal-p)
> >>                      (find-file-name-handler file2 'files-equal-p))))
> >>     (if handler
> >>         (funcall handler 'files-equal-p file1 file2)
> >
> > If FILE1 and FILE2 have different 'files-equal-p handlers, which one
> > of them, if any, should be invoked here?
> 
> The one for FILE1.

Can you explain why?  My question wasn't rhetorical, it was due to a
real confusion about what should be done in this situation and why.

> > IOW, shouldn't we invoke a file handler only if it can handle _both_
> > files?  Also, if each file has a different handler, doesn't that in
> > itself already mean the files are not equal?
> 
> We shouldn't add too much to file name handler optimization here. The
> handler will know what to do.

"Will know" how?  Is it documented anywhere how to write a handler so
it handles such situations?  If so, please point me to that
documentation, and perhaps I will see the light there.

> Likely, there won't be different handlers. It's always
> `tramp-file-name-handler', which calls the respective sub-handlers.

??? Are we to assume that a file-handler is always the Tramp handler?
What about others, like jka-compr?

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

[Stefan Monnier]

>> > If FILE1 and FILE2 have different 'files-equal-p handlers, which one
>> > of them, if any, should be invoked here?
>> The one for FILE1.
> Can you explain why?

It's just a convention.  We already do that in the few other file
primitives that bump into the same problem.

> My question wasn't rhetorical, it was due to a real confusion about
> what should be done in this situation and why.

It's the responsibility of FILE1's handler to check FILE2's handler.

>> > Also, if each file has a different handler, doesn't that in
>> > itself already mean the files are not equal?

No: /foo should be equal to file:///foo (if you use url-handler-mode)
but they don't use the same handler.

>> We shouldn't add too much to file name handler optimization here.
>> The handler will know what to do.
> "Will know" how?  Is it documented anywhere how to write a handler so
> it handles such situations?  If so, please point me to that
> documentation, and perhaps I will see the light there.

There is no right answer, in general, so no it's not documented.  But at
least the file handler's writer, thanks to his knowledge of the special
semantics of his handler, should be able to write something useful.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> "Will know" how?  Is it documented anywhere how to write a handler so
>> it handles such situations?  If so, please point me to that
>> documentation, and perhaps I will see the light there.
>
> There is no right answer, in general, so no it's not documented.  But at
> least the file handler's writer, thanks to his knowledge of the special
> semantics of his handler, should be able to write something useful.

Existing handlers behave correctly, as far as I see. But maybe we could
add a sentence fo files.texi, node "Magic File Names", that a handler
shall be aware of this.

>         Stefan

Best regards, Michael.

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> > Also, if each file has a different handler, doesn't that in
>>> > itself already mean the files are not equal?
>
> No: /foo should be equal to file:///foo (if you use url-handler-mode)
> but they don't use the same handler.

It will be hard to detect that /sudo::/foo is equal to file:///foo. And
the result might be different, when file:///foo and /sudo::/foo are
compared, because another file name handler is involved.

Maybe we shouldn't try to detect this, and we should regard them as not
equal.

>         Stefan

Best regards, Michael.

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

[Thierry Volpiatto]

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

> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>
>>>> > Also, if each file has a different handler, doesn't that in
>>>> > itself already mean the files are not equal?
>>
>> No: /foo should be equal to file:///foo (if you use url-handler-mode)
>> but they don't use the same handler.
>
> It will be hard to detect that /sudo::/foo is equal to file:///foo. And
> the result might be different, when file:///foo and /sudo::/foo are
> compared, because another file name handler is involved.
>
> Maybe we shouldn't try to detect this, and we should regard them as not
> equal.
Agree, don't think that in real life people try do something like 
copy /sudo::/foo ==> file:///foo

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

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

[Stefan Monnier]

>> It will be hard to detect that /sudo::/foo is equal to file:///foo.

Maybe (in this case it might be reasonably easy, but of course there are
harder cases).  But the fact that it's sometimes hard doesn't justify
preventing file-handlers from trying to handle it when they can.
I.e. don't just assume "different file-handler => different file".

> Agree, don't think that in real life people try do something like 
> copy /sudo::/foo ==> file:///foo

This whole bug report started because someone tried to make a similarly
silly "copy to itself".


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> It will be hard to detect that /sudo::/foo is equal to file:///foo.
>
> Maybe (in this case it might be reasonably easy, but of course there are
> harder cases).

We would need a function `file-local-representation' or something like
this, which returns "/foo" in both file name handler implementations.
Tramp's file name handler doesn't know of URL syntax, and vice versa.

And no, I do NOT propose to add this. Sounds like overengineering to me.

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>>>> It will be hard to detect that /sudo::/foo is equal to file:///foo.
>> Maybe (in this case it might be reasonably easy, but of course there are
>> harder cases).

> We would need a function `file-local-representation' or something like
> this, which returns "/foo" in both file name handler implementations.
> Tramp's file name handler doesn't know of URL syntax, and vice versa.

Tramp's knowledge of the semantics of "/sudo::" lets it simply turn
(file-equal-p "/sudo::/foo" "file:///foo") into (file-equal-p "/foo"
"file:///foo"), after which the url-handler-mode can do the same kind of
trivial reasoning.

> And no, I do NOT propose to add this. Sounds like overengineering to me.

Neither do I.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> Tramp's knowledge of the semantics of "/sudo::" lets it simply turn
> (file-equal-p "/sudo::/foo" "file:///foo") into (file-equal-p "/foo"
> "file:///foo"), after which the url-handler-mode can do the same kind of
> trivial reasoning.

Hmm. Yes. How simple :-)

>         Stefan

Thanks, and best regards, Michael.

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

[Stefan Monnier]

>> Tramp's knowledge of the semantics of "/sudo::" lets it simply turn
>> (file-equal-p "/sudo::/foo" "file:///foo") into (file-equal-p "/foo"
>> "file:///foo"), after which the url-handler-mode can do the same kind of
>> trivial reasoning.
> Hmm. Yes. How simple :-)

I suspect this simple approach wouldn't quite work in various corner
cases (e.g. when testing (file-equal-p "/sudo::/foo/bar" "file:///baz")
and where /foo/bar is a symlink to /baz, but where /foo is only
accessible to root ;-)


        Stefan

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> Likely, there won't be different handlers. It's always
>> `tramp-file-name-handler', which calls the respective sub-handlers.
>
> ??? Are we to assume that a file-handler is always the Tramp handler?
> What about others, like jka-compr?

I stay corrected, there's also `url-file-handler'.

For the other file name handlers, I do not expect that they will offer
an own implementation of `files-equal-p' and alike. They will go out of
the way.

Best regards, Michael.

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

[Stefan Monnier]

>>> Likely, there won't be different handlers. It's always
>>> `tramp-file-name-handler', which calls the respective sub-handlers.
>> ??? Are we to assume that a file-handler is always the Tramp handler?
>> What about others, like jka-compr?
> I stay corrected, there's also `url-file-handler'.

I'm sure there are others.
I seem to remember bumping into a package recently which implemented yet
another file-name-handler of the same general kind.


        Stefan

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

[Lennart Borgman]

On Sat, Feb 25, 2012 at 15:35, Stefan Monnier <monnier@iro.umontreal.ca> wrote:
>>>> Likely, there won't be different handlers. It's always
>>>> `tramp-file-name-handler', which calls the respective sub-handlers.
>>> ??? Are we to assume that a file-handler is always the Tramp handler?
>>> What about others, like jka-compr?
>> I stay corrected, there's also `url-file-handler'.
>
> I'm sure there are others.
> I seem to remember bumping into a package recently which implemented yet
> another file-name-handler of the same general kind.

I have implemented one in nXhtml for handling file types that Emacs
itself should not handle.

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

[Michael Albinus]

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

> Hi Stefan and Michael,

Hi Thierry,

> 1) A function to compare filenames locally.
> 2) A tramp handler for this function.
> 3) A function to check if file1 is subdir of file2, locally also.
> 4) A tramp handler for this one also?
>
> We have more or less 1 and 3, need tramp handlers for them.

1 and 3 can be done without Tramp and ange-ftp handlers. Those handlers
could be written easily afterwards; whether they shall be added to Emacs
24.1 depends on the release plans (which I don't know). If 24.1 will be
released soon, I would be in favor to add the handlers after the release.

Best regards, Michael.

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

[Thierry Volpiatto]

Hi Michael,

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Hi Stefan and Michael,
>
> Hi Thierry,
>
>> 1) A function to compare filenames locally.
>> 2) A tramp handler for this function.
>> 3) A function to check if file1 is subdir of file2, locally also.
>> 4) A tramp handler for this one also?
>>
>> We have more or less 1 and 3, need tramp handlers for them.
>
> 1 and 3 can be done without Tramp and ange-ftp handlers.

Yes we have already 1 and 3, (though 3 could be achieved differently as
Stefan suggest, don't know)

> Those handlers could be written easily afterwards; whether they shall
> be added to Emacs 24.1 depends on the release plans (which I don't
> know). If 24.1 will be released soon, I would be in favor to add the
> handlers after the release.
Sound good.


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

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

[Andreas Schwab]

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

> Michael Albinus <michael.albinus@gmx.de> writes:
>
>> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>>
>>> IMHO we should fix this bug for most use cases with a compare function
>>> maybe not perfect in many points but ok for most basic usages.
>>> The function shown by Drew and I put in last patch as you said isn't
>>> sufficient and fail in many cases even on local filesystem:
>>>
>>> (defun bmkp-same-file-p (file1 file2)
>>>   "Return non-nil if FILE1 and FILE2 name the same file.
>>> If either name is not absolute, then it is expanded relative to
>>> `default-directory' for the test."
>>>   (and (equal (file-remote-p file1) (file-remote-p file2))
>>>        (string= (file-truename (expand-file-name file1))
>>>                 (file-truename (expand-file-name file2)))))
>>>
>>> (bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil
>>
>> So it must be 
>>
>>        (string= (directory-file-name (file-truename (expand-file-name file1)))
>>                 (directory-file-name (file-truename (expand-file-name file2))))))
>
> So, any objections to apply my patch to trunk with these changes?

You also need to check whether the target is a subdirectory of the
source.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

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

[Thierry Volpiatto]

Andreas Schwab <schwab@linux-m68k.org> writes:

> You also need to check whether the target is a subdirectory of the
> source.
Indeed yes, is there already a function to check this?
If not what about something like this:

#+BEGIN_SRC lisp
(defun file-subdir-of-p (file1 file2)
  "Check if FILE1 is a subdirectory of FILE2."
  (when (and (not (or (file-remote-p file1)
                      (file-remote-p file2)))
             (file-directory-p file1)
             (file-directory-p file2))
    (loop with f1 = (expand-file-name file1)
          with f2 = (expand-file-name file2)
          with ls1 = (split-string f1 "/" t)
          with ls2 = (split-string f2 "/" t)
          for p = (string-match "^/" f1)
          for i in ls1
          for j in ls2
          when (string= i j)
          concat (if p (concat "/" i) (concat i "/"))
          into root
          finally return
          ;; Use here `file-equal-p' when ready to work.
          (string= (directory-file-name root)
                   (directory-file-name f2)))))

#+END_SRC

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

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

[Thierry Volpiatto]

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

> Andreas Schwab <schwab@linux-m68k.org> writes:
>
>> You also need to check whether the target is a subdirectory of the
>> source.
> Indeed yes, is there already a function to check this?
> If not what about something like this:

BTW this work also for equality between two directories.
(both GNU/Linux and Windows)

#+BEGIN_SRC lisp
(defun file-subdir-of-p (file1 file2)
  "Check if FILE1 is a subdirectory of FILE2."
  (when (and (not (or (file-remote-p file1)
                      (file-remote-p file2)))
             (not (string= file1 "/"))
             (file-directory-p file1)
             (file-directory-p file2))
    (or (string= file2 "/")
        (loop with f1 = (expand-file-name file1)
              with f2 = (expand-file-name file2)
              with ls1 = (split-string f1 "/" t)
              with ls2 = (split-string f2 "/" t)
              for p = (string-match "^/" f1)
              for i in ls1
              for j in ls2
              when (string= i j)
              concat (if p (concat "/" i) (concat i "/"))
              into root
              finally return
              ;; Use here `file-equal-p' when ready to work.
              (string= (file-truename (directory-file-name root))
                       (file-truename(directory-file-name f2)))))))

#+END_SRC



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

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

[Thierry Volpiatto]

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

Andreas Schwab <schwab@linux-m68k.org> writes:

>> So, any objections to apply my patch to trunk with these changes?
>
> You also need to check whether the target is a subdirectory of the
> source.

To clarify:

--8<---------------cut here---------------start------------->8---
thierry@thierry-MM061:~$ cd ~/tmp/Test/
thierry@thierry-MM061:~/tmp/Test$ ls -R
.:
Test1

./Test1:
Test2

./Test1/Test2:
Test3

./Test1/Test2/Test3:
thierry@thierry-MM061:~/tmp/Test$ LC_ALL=C cp -r ~/tmp/Test/ ~/tmp/Test/Test1/Test2/Test3/
cp: cannot copy a directory, `/home/thierry/tmp/Test/', into itself, `/home/thierry/tmp/Test/Test1/Test2/Test3/Test'
--8<---------------cut here---------------end--------------->8---

So we need to check this. (See `file-subdir-of-p' in this patch)


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

##Merge of all patches applied from revision 118409
## patch-r118414: Bugfix bug#10489, dired-do-copy may create infinite directory hierarchy.
## patch-r118411: * lisp/dired-aux.el (dired-copy-file-recursive): Use file-equal-p.
## patch-r118412: * lisp/files.el (file-subdir-of-p): Check if file1 is subdir of file2.
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,27 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (or (files-equal-p from to)
+            (file-subdir-of-p from to))
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1378,7 +1381,7 @@
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
+                                        &optional marker-char)
   "Create one or more new files from a list of existing files FN-LIST.
 This function also handles querying the user, updating Dired
 buffers, and displaying a success or failure message.
@@ -1401,10 +1404,14 @@
 Optional MARKER-CHAR is a character with which to mark every
 newfile's entry, or t to use the current marker character if the
 old file was marked."
-  (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
+  (let (dired-create-files-failures
+        failures
+        skipped
+        (success-count 0)
+        (total (length fn-list)))
+    (let (to
+          overwrite-query
+          overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -1430,10 +1437,25 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (or (files-equal-p from destname)
+                             (file-directory-p to))
+                         (eq file-creator 'dired-copy-file))
+                (setq to destname)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,25 +1478,25 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
+               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
 \f
 (defun dired-do-create-files (op-symbol file-creator operation arg
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4902,6 +4902,35 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (equal (file-attributes (file-truename (expand-file-name file1)))
+              (file-attributes (file-truename (expand-file-name file2))))))
+
+(defun file-subdir-of-p (file1 file2)
+  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
+If directory FILE1 is the same than directory FILE2, return non--nil."
+  (when (and (not (or (file-remote-p file1)
+                      (file-remote-p file2)))
+             (not (string= file1 "/"))
+             (file-directory-p file1)
+             (file-directory-p file2))
+    (or (string= file2 "/")
+        (loop with f1 = (expand-file-name file1)
+              with f2 = (expand-file-name file2)
+              with ls1 = (split-string f1 "/" t)
+              with ls2 = (split-string f2 "/" t)
+              for p = (string-match "^/" f1)
+              for i in ls1
+              for j in ls2
+              when (string= i j)
+              concat (if p (concat "/" i) (concat i "/"))
+              into root
+              finally return
+              (string= (file-truename (directory-file-name root))
+                       (file-truename (directory-file-name f2)))))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -4928,10 +4957,13 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (or (files-equal-p directory newname)
+            (file-subdir-of-p directory newname))
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+                     (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 

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


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

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

[Thierry Volpiatto]

[-- Attachment #1.1: Type: text/plain, Size: 440 bytes --]

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

> Andreas Schwab <schwab@linux-m68k.org> writes:
>
>>> So, any objections to apply my patch to trunk with these changes?
>>
>> You also need to check whether the target is a subdirectory of the
>> source.
Sorry the last patch sent haven't the last changes included.
Here the good one.

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Singlepatch-r118414ToTip.patch --]
[-- Type: text/x-diff, Size: 8817 bytes --]

##Merge of all patches applied from revision 118409
## patch-r118414: Bugfix bug#10489, dired-do-copy may create infinite directory hierarchy.
## patch-r118411: * lisp/dired-aux.el (dired-copy-file-recursive): Use file-equal-p.
## patch-r118412: * lisp/files.el (file-subdir-of-p): Check if file1 is subdir of file2.
## 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1264,24 +1264,27 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
 				       preserve-time top recursive)
+  (when (or (files-equal-p from to)
+            (file-subdir-of-p to from))
+    (error "Can't copy directory `%s' on itself" from))
   (let ((attrs (file-attributes from)))
     (if (and recursive
-	     (eq t (car attrs))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(copy-directory from to preserve-time)
+             (eq t (car attrs))
+             (or (eq recursive 'always)
+                 (yes-or-no-p (format "Recursive copies of %s? " from))))
+        ;; This is a directory.
+        (copy-directory from to preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
-	  (if (stringp (car attrs))
-	      ;; It is a symlink
-	      (make-symbolic-link (car attrs) to ok-flag)
-	    (copy-file from to ok-flag preserve-time))
-	(file-date-error
-	 (push (dired-make-relative from)
-	       dired-create-files-failures)
-	 (dired-log "Can't set date on %s:\n%s\n" from err))))))
+          (if (stringp (car attrs))
+              ;; It is a symlink
+              (make-symbolic-link (car attrs) to ok-flag)
+            (copy-file from to ok-flag preserve-time))
+        (file-date-error
+         (push (dired-make-relative from)
+               dired-create-files-failures)
+         (dired-log "Can't set date on %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1378,7 +1381,7 @@
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
+                                        &optional marker-char)
   "Create one or more new files from a list of existing files FN-LIST.
 This function also handles querying the user, updating Dired
 buffers, and displaying a success or failure message.
@@ -1401,10 +1404,14 @@
 Optional MARKER-CHAR is a character with which to mark every
 newfile's entry, or t to use the current marker character if the
 old file was marked."
-  (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
+  (let (dired-create-files-failures
+        failures
+        skipped
+        (success-count 0)
+        (total (length fn-list)))
+    (let (to
+          overwrite-query
+          overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -1430,10 +1437,27 @@
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
-	    (when (and (file-directory-p from)
-		       (file-directory-p to)
-		       (eq file-creator 'dired-copy-file))
-	      (setq to (file-name-directory to)))
+            ;; Handle the `dired-copy-file' file-creator specially
+            ;; When copying a directory to another directory or
+            ;; possibly to itself.
+            ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo")
+            ;; In this case the 'name-constructor' have set the destination
+            ;; 'to' to "~/test/foo" because the old
+            ;; emacs23 behavior of `copy-directory'
+            ;; was no not create the subdir and copy instead the contents only.
+            ;; With it's new behavior (similar to cp shell command) we don't
+            ;; need such a construction, so modify the destination 'to' to
+            ;; "~/test/" instead of "~/test/foo/".
+            ;; If from and to are the same directory do the same,
+            ;; the error will be handled by `dired-copy-file-recursive'.
+            (let ((destname (file-name-directory to)))
+              (when (and (file-directory-p from)
+                         (or (files-equal-p from destname)
+                             (file-directory-p to))
+                         (eq file-creator 'dired-copy-file))
+                (setq to destname))
+              (and (file-subdir-of-p destname from)
+                   (error "Can't copy directory `%s' on itself" from)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1456,25 +1480,25 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		total (dired-plural-s total))
+               operation (length failures)
+               total (dired-plural-s total))
        failures))
      (skipped
       (dired-log-summary
        (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
+               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
 \f
 (defun dired-do-create-files (op-symbol file-creator operation arg
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4902,6 +4902,35 @@
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
+(defun files-equal-p (file1 file2)
+  "Return non-nil if FILE1 and FILE2 name the same file."
+  (and (equal (file-remote-p file1) (file-remote-p file2))
+       (equal (file-attributes (file-truename (expand-file-name file1)))
+              (file-attributes (file-truename (expand-file-name file2))))))
+
+(defun file-subdir-of-p (file1 file2)
+  "Check if FILE1 is a subdirectory of FILE2 on current filesystem.
+If directory FILE1 is the same than directory FILE2, return non--nil."
+  (when (and (not (or (file-remote-p file1)
+                      (file-remote-p file2)))
+             (not (string= file1 "/"))
+             (file-directory-p file1)
+             (file-directory-p file2))
+    (or (string= file2 "/")
+        (loop with f1 = (expand-file-name file1)
+              with f2 = (expand-file-name file2)
+              with ls1 = (split-string f1 "/" t)
+              with ls2 = (split-string f2 "/" t)
+              for p = (string-match "^/" f1)
+              for i in ls1
+              for j in ls2
+              when (string= i j)
+              concat (if p (concat "/" i) (concat i "/"))
+              into root
+              finally return
+              (string= (file-truename (directory-file-name root))
+                       (file-truename (directory-file-name f2)))))))
+
 (defun copy-directory (directory newname &optional keep-time parents copy-contents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
 This function always sets the file modes of the output files to match
@@ -4928,10 +4957,13 @@
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
 	   current-prefix-arg t nil)))
+  (when (or (files-equal-p directory newname)
+            (file-subdir-of-p directory newname))
+    (error "Can't copy directory `%s' on itself" directory))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+                     (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 

[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

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

[Stefan Monnier]

> What about this?
> (defun file-name-equal-p (name1 name2 &optional dir)
>   (let* ((n1     (file-truename (expand-file-name name1 dir)))

There's a crucial line missing between the above two.  It should clearly
document what this function is expected to do.  E.g. it should make it
clear if (and if so, to what extent) the function is allowed to refer to
the actual file system(s) as opposed to only relying on the
provided strings.


        Stefan

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

[Michael Albinus]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> What about this?
>> (defun file-name-equal-p (name1 name2 &optional dir)
>>   (let* ((n1     (file-truename (expand-file-name name1 dir)))
>
> There's a crucial line missing between the above two.  It should clearly
> document what this function is expected to do.  E.g. it should make it
> clear if (and if so, to what extent) the function is allowed to refer to
> the actual file system(s) as opposed to only relying on the
> provided strings.

If the file name strings are not obviously equal, `file-truename' will
refer to the underlying file system(s). There will be some checks to
avoid this for remote files, for example due to different host names
used in both file names, but this are implementation details.

This is the difference to `file-remote-p', which works only with the
given file name strings. Something like

(defun file-equal-p (name1 name2 &optional dir)
  "Return non-nil if NAME1 and NAME2 refer to the same file in the file system.
If either name is not absolute, then it is expanded relative to
DIR (if given) or `default-directory' for the test."
  (let ((fn1 (expand-file-name name1 dir))
	(fn2 (expand-file-name name2 dir)))
    (cond
     ((string-equal fn1 fn2))
     ((and (file-remote-p fn1) (file-remote-p fn2))
      (let ((handler (or (find-file-name-handler fn1 'file-equal-p)
			 (find-file-name-handler fn2 'file-equal-p))))
	(if handler (funcall handler 'file-equal-p name1 name2 dir))))
     ((or (file-remote-p fn1) (file-remote-p fn2)) nil)
     (t (if the-var-which-tells-us-case-insensitivity
	    (string-equal (downcase (file-truename fn1))
			  (downcase (file-truename fn1)))
	  (string-equal (file-truename fn1) (file-truename fn1))))))

>         Stefan

Best regards, Michael.

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

[Stefan Monnier]

>> There's a crucial line missing between the above two.  It should clearly
>> document what this function is expected to do.  E.g. it should make it
>> clear if (and if so, to what extent) the function is allowed to refer to
>> the actual file system(s) as opposed to only relying on the
>> provided strings.
> If the file name strings are not obviously equal, `file-truename' will

I don't mean "document what the code currently does" but "document
what the code should do".

>   "Return non-nil if NAME1 and NAME2 refer to the same file in the file system.
> If either name is not absolute, then it is expanded relative to
> DIR (if given) or `default-directory' for the test."

That description is too vague: an implementation based on comparing
file-attributes would seem to fit, whereas it's clearly not the semantic
we want to provide.


        Stefan

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

[Eli Zaretskii]

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Fri, 13 Jan 2012 20:55:23 -0500
> Cc: 10489@debbugs.gnu.org, Thierry Volpiatto <thierry.volpiatto@gmail.com>
> 
> >> There's a crucial line missing between the above two.  It should clearly
> >> document what this function is expected to do.  E.g. it should make it
> >> clear if (and if so, to what extent) the function is allowed to refer to
> >> the actual file system(s) as opposed to only relying on the
> >> provided strings.
> > If the file name strings are not obviously equal, `file-truename' will
> 
> I don't mean "document what the code currently does" but "document
> what the code should do".

Same thing in this case.  If we want to resolve the various cases of
equivalent file names, we have no alternative but hitting the disk.

> >   "Return non-nil if NAME1 and NAME2 refer to the same file in the file system.
> > If either name is not absolute, then it is expanded relative to
> > DIR (if given) or `default-directory' for the test."
> 
> That description is too vague: an implementation based on comparing
> file-attributes would seem to fit, whereas it's clearly not the semantic
> we want to provide.

Sorry, I'm not following.  Why does a possibly different
implementation make the doc string "too vague"?  IOW, the doc string
_should_ be sufficiently "vague" to allow a change in the
implementation without breaking the API or the semantics, right?

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

[Stefan Monnier]

> > I don't mean "document what the code currently does" but "document
> > what the code should do".
> Same thing in this case.

I was just pointing out that basing the docstring on a sample
implementation is not the right way to do it.

> If we want to resolve the various cases of equivalent file names, we
> have no alternative but hitting the disk.

IIRC that's indeed the case if we want to consider equal the VFAT file
systems monste~1.  And that's exactly the kind of thing I want us to
decide by writing the docstring.  For POSIX the same question comes up
with symlinks.

>> >   "Return non-nil if NAME1 and NAME2 refer to the same file in the
>> > file system.  If either name is not absolute, then it is expanded
>> > relative to DIR (if given) or `default-directory' for the test."
>> That description is too vague: an implementation based on comparing
>> file-attributes would seem to fit, whereas it's clearly not the semantic
>> we want to provide.
> Sorry, I'm not following.  Why does a possibly different
> implementation make the doc string "too vague"?  IOW, the doc string
> _should_ be sufficiently "vague" to allow a change in the
> implementation without breaking the API or the semantics, right?

To me "the same name" is something quite different from "the same file".
I think file-name-equal-p should make it clear that it means "same name"
and not "same file" because we may want to use it without knowing if the
file exists and without opening a remote connection.

IIUC the original problem in dired-do-copy needs to test "same file"
rather than "same name", so it should not use file-name-equal-p but
file-equal-p (which would rely on file-attributes, presumably).


        Stefan

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

[Eli Zaretskii]

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Cc: michael.albinus@gmx.de,  10489@debbugs.gnu.org,  thierry.volpiatto@gmail.com
> Date: Sat, 14 Jan 2012 09:19:51 -0500
> 
> To me "the same name" is something quite different from "the same file".
> I think file-name-equal-p should make it clear that it means "same name"
> and not "same file" because we may want to use it without knowing if the
> file exists and without opening a remote connection.

"Same file name" would only do case-insensitive comparison on
DOS/Windows and exact comparison otherwise.  That doesn't need to hit
the disk.

> IIUC the original problem in dired-do-copy needs to test "same file"
> rather than "same name", so it should not use file-name-equal-p but
> file-equal-p (which would rely on file-attributes, presumably).

I agree; this thread discusses file-equal-p.

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

[Thierry Volpiatto]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>
> IIUC the original problem in dired-do-copy
In dired-create-files.

> needs to test "same file" rather than "same name", so it should not
> use file-name-equal-p but file-equal-p (which would rely on
> file-attributes, presumably).

How do you compare two files with file-attributes?
Locally, equal is ok, but when using /sudo::.. the gid-change, inode
and device-num are differents:

/home/thierry/Test:

--8<---------------cut here---------------start------------->8---
(:type t :links 2 :uid "thierry" :gid "thierry" :access-time
       (20241 21214)
       :modif-time
       (20241 20731)
       :status
       (20241 20731)
       :size 4096 :mode "drwxrwxr-x" :gid-change nil 
       :inode 4598437 :device-num 2049)
--8<---------------cut here---------------end--------------->8---

/sudo::/home/thierry/Test

--8<---------------cut here---------------start------------->8---
(:type t :links 2 :uid "thierry" :gid "thierry" :access-time
       (20241 21214)
       :modif-time
       (20241 20731)
       :status
       (20241 20731)
       :size 4096 :mode "drwxrwxr-x" :gid-change t 
       :inode (70 . 10917)
       :device-num (-1 . 0))
--8<---------------cut here---------------end--------------->8---

On info we have:
`(5888 2 . 43978)'
      has an inode number of 6473924464520138.

`(15479 . 46724)'
      is on the file-system device whose number is 1014478468.

How do you get such results?

Thanks.

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

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

[Michael Albinus]

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

> How do you compare two files with file-attributes?
> Locally, equal is ok, but when using /sudo::.. the gid-change, inode
> and device-num are differents:

This must be implemented by respective file name handlers, like
`tramp-handle-file-equal-p', `ange-ftp-file-equal-p', `url-file-equal-p' ...

> /sudo::/home/thierry/Test
>
> (:type t :links 2 :uid "thierry" :gid "thierry" :access-time
>        (20241 21214)
>        :modif-time
>        (20241 20731)
>        :status
>        (20241 20731)
>        :size 4096 :mode "drwxrwxr-x" :gid-change t 
>        :inode (70 . 10917)
>        :device-num (-1 . 0))

`tramp-*-handle-file-attributes' create virtual inodes and device
numbers. They cannot be used directly for comparison.

Same for `ange-ftp-file-attributes'.

> Thanks.

Best regards, Michael.

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

[Thierry Volpiatto]

Thanks Michael for explanation.

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

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> How do you compare two files with file-attributes?
>> Locally, equal is ok, but when using /sudo::.. the gid-change, inode
>> and device-num are differents:
>
> This must be implemented by respective file name handlers, like
> `tramp-handle-file-equal-p', `ange-ftp-file-equal-p', `url-file-equal-p' ...
>
>> /sudo::/home/thierry/Test
>>
>> (:type t :links 2 :uid "thierry" :gid "thierry" :access-time
>>        (20241 21214)
>>        :modif-time
>>        (20241 20731)
>>        :status
>>        (20241 20731)
>>        :size 4096 :mode "drwxrwxr-x" :gid-change t 
>>        :inode (70 . 10917)
>>        :device-num (-1 . 0))
>
> `tramp-*-handle-file-attributes' create virtual inodes and device
> numbers. They cannot be used directly for comparison.
>
> Same for `ange-ftp-file-attributes'.
>
>> Thanks.
>
> Best regards, Michael.

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

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

[Drew Adams]

> >  (and (equal (file-remote-p file1) (file-remote-p file2))
> 
> Why is the file-remote-p needed?

If that test fails then (because either at least one of the files is not remote
or their access methods/hosts are different) we save a trip to remote machines
to determine truenames.

If that test succeeds then either both are local or both are remote, and in the
latter case they have the same host etc.

IOW, the idea is to try to do as much as possible based only on the strings
(names), and to fail if possible that way without accessing anything remotely.

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

[Eli Zaretskii]

> From: "Drew Adams" <drew.adams@oracle.com>
> Date: Fri, 13 Jan 2012 06:14:01 -0800
> Cc: 10489@debbugs.gnu.org
> 
> FWIW, this is what Bookmark+ uses, based on some input from Michael:
> 
> (defun bmkp-same-file-p (file1 file2)
>   "Return non-nil if FILE1 and FILE2 name the same file.
> If either name is not absolute, then it is expanded relative to
> `default-directory' for the test."
>   (and (equal (file-remote-p file1) (file-remote-p file2))
>        (string= (file-truename (expand-file-name file1))
>                 (file-truename (expand-file-name file2)))))

Which is obviously wrong on case-insensitive filesystems.

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

[Drew Adams]

> > FWIW, this is what Bookmark+ uses, based on some input from Michael:
> > 
> > (defun bmkp-same-file-p (file1 file2)
> >   "Return non-nil if FILE1 and FILE2 name the same file.
> > If either name is not absolute, then it is expanded relative to
> > `default-directory' for the test."
> >   (and (equal (file-remote-p file1) (file-remote-p file2))
> >        (string= (file-truename (expand-file-name file1))
> >                 (file-truename (expand-file-name file2)))))
> 
> Which is obviously wrong on case-insensitive filesystems.

Yes.

If both files are local then we can check whether to ignore case using what
Michael or Stefan suggested (the standard value of
`read-file-name-completion-ignore-case' or, better, some to-be-created constant
for this purpose).

But if both files are remote then the remote system setting(s) would need to be
checked.

Here is a modified version of the above code, which I expect (untested) DTRT for
local files and just punts for remote file names (assumes that they are
case-sensitive).  Perhaps Michael has a good suggestion wrt treating that case.

(defun bmkp-same-file-p (file1 file2)
  "Return non-nil if FILE1 and FILE2 name the same file.
If either name is not absolute, then it is expanded relative to
`default-directory' for the test."
  (let* ((remote1  (bmkp-file-remote-p file1))
         (remote2  (bmkp-file-remote-p file2))
         (ignore-case-p
          (and (not remote1) (not remote2)
               (eval (car (get 'read-file-name-completion-ignore-case
                               'standard-value))))))
    (and (equal remote1 remote2)
         (compare-strings (file-truename (expand-file-name file1))
                          (file-truename (expand-file-name file2))
                          ignore-case-p))))

----

BTW, I notice in `abbreviate-file-name' this code:

;; To fix this right, we need a `file-name-case-sensitive-p'
;; function, but we don't have that yet, so just guess.
(let ((case-fold-search
       (memq system-type '(ms-dos windows-nt darwin cygwin))))

That same value is used to define the standard value of
`read-file-name-completion-ignore-case'.  Presumably it would be better for code
to check that standard value (or some TBD constant, as Stefan suggested) than to
rely on an explicit list of systems here and there in the code.  IOW,
define/maintain the value in a single place.

There are other places in the code where we try to determine case-sensitivity of
file names based on `system-type'.  And we don't always use the same system list
for this. E.g., in `files.el' alone:

We use this in `set-auto-mode':

(memq system-type '(windows-nt cygwin))

And this in `dir-locals-find-file', `make-backup-file-name-1',
`make-auto-save-file-name', `file-relative-name',
`shell-quote-wildcard-pattern', and `file-name-invalid-regexp':

(memq system-type '(windows-nt cygwin ms-dos))

And this in `insert-directory':

(memq system-type '(ms-dos windows-nt))

And this in `buffer-file-numbers-unique':

(memq system-type '(windows-nt))

And again, in `abbreviate-file-name' we use:

(memq system-type '(ms-dos windows-nt darwin cygwin))

Now maybe some of those tests are not for case-sensitivity (I didn't take the
time to look closely).  Or maybe, even when they are, there are good reasons for
such differences.

But perhaps one or more of them should in fact have the same value as
`read-file-name-completion-ignore-case' (or said TBD constant), and would
benefit from being replaced by that?

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

[Drew Adams]

> (defun bmkp-same-file-p (file1 file2)
>   "Return non-nil if FILE1 and FILE2 name the same file.
> If either name is not absolute, then it is expanded relative to
> `default-directory' for the test."
>   (let* ((remote1  (bmkp-file-remote-p file1))
>          (remote2  (bmkp-file-remote-p file2))
>          (ignore-case-p
>           (and (not remote1) (not remote2)
>                (eval (car (get 'read-file-name-completion-ignore-case
>                                'standard-value))))))
>     (and (equal remote1 remote2)
>          (compare-strings (file-truename (expand-file-name file1))
>                           (file-truename (expand-file-name file2))
>                           ignore-case-p))))

Sorry, that `compare-strings' sexp is obviously not right.  The last 3 lines
should be this:

(and (equal remote1 remote2)
     (let ((ft1  (file-truename (expand-file-name file1)))
           (ft2  (file-truename (expand-file-name file2))))
       (compare-strings ft1 0 (length ft1) ft2 0 (length ft2)
                        ignore-case-p)))))

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

[Eli Zaretskii]

> From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
> Date: Fri, 13 Jan 2012 10:38:45 +0100
> 
> Here a version of the patch that use `equal'

Thanks, but as I wrote elsewhere, I don't think using `equal' will
help.

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

[Michael Heerdegen]

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