Package: emacs;
Reported by: michael_heerdegen <at> web.de
Date: Thu, 12 Jan 2012 19:36:01 UTC
Severity: important
Tags: patch
Merged with 11130
Found in version 24.0.92
Done: Chong Yidong <cyd <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Thierry Volpiatto <thierry.volpiatto <at> gmail.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 10489 <at> debbugs.gnu.org, Michael Albinus <michael.albinus <at> gmx.de> Subject: bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy Date: Thu, 23 Feb 2012 17:01:51 +0100
Stefan Monnier <monnier <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.