From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 10489@debbugs.gnu.org
Subject: bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy
Date: Fri, 24 Feb 2012 13:18:05 +0100 [thread overview]
Message-ID: <87r4xkwhky.fsf@gmail.com> (raw)
In-Reply-To: <834nugtwqf.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 24 Feb 2012 11:19:04 +0200")
[-- 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
next prev parent reply other threads:[~2012-02-24 12:18 UTC|newest]
Thread overview: 174+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-01-12 19:35 bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy Michael Heerdegen
2012-01-12 21:33 ` Thierry Volpiatto
2012-01-13 7:23 ` Eli Zaretskii
2012-01-13 8:38 ` Thierry Volpiatto
2012-01-13 10:31 ` Eli Zaretskii
2012-01-13 11:19 ` Thierry Volpiatto
2012-01-13 12:01 ` Juanma Barranquero
2012-01-13 12:41 ` Eli Zaretskii
2012-01-13 13:01 ` Michael Albinus
2012-01-13 13:11 ` Juanma Barranquero
2012-01-13 13:13 ` Juanma Barranquero
2012-01-13 13:18 ` Juanma Barranquero
2012-01-13 13:32 ` Michael Albinus
2012-01-13 13:27 ` Stefan Monnier
2012-01-13 14:06 ` Thierry Volpiatto
2012-01-13 14:44 ` Michael Albinus
2012-01-13 15:13 ` Stefan Monnier
2012-01-13 15:17 ` Juanma Barranquero
2012-01-13 15:29 ` Michael Albinus
2012-01-13 16:59 ` Drew Adams
2012-01-13 9:38 ` Thierry Volpiatto
2012-01-13 9:49 ` Michael Albinus
2012-01-13 11:00 ` Thierry Volpiatto
2012-01-13 12:48 ` Michael Albinus
2012-01-13 13:55 ` Thierry Volpiatto
2012-01-13 14:14 ` Drew Adams
2012-01-13 15:06 ` Juanma Barranquero
2012-01-13 15:14 ` Michael Albinus
2012-01-13 18:43 ` Thierry Volpiatto
2012-01-13 18:57 ` Drew Adams
2012-01-13 19:11 ` Thierry Volpiatto
2012-01-13 19:21 ` Drew Adams
2012-01-13 19:35 ` Michael Albinus
2012-01-13 20:56 ` Drew Adams
2012-01-13 18:59 ` Thierry Volpiatto
2012-01-13 19:04 ` Michael Albinus
2012-01-13 19:17 ` Thierry Volpiatto
2012-01-14 8:00 ` Eli Zaretskii
2012-01-14 10:25 ` Thierry Volpiatto
2012-01-15 12:50 ` Michael Albinus
2012-01-15 17:20 ` Thierry Volpiatto
2012-01-15 17:31 ` Thierry Volpiatto
2012-01-15 18:24 ` Michael Albinus
2012-01-15 19:09 ` Thierry Volpiatto
2012-01-15 19:49 ` Michael Albinus
2012-01-15 21:01 ` Thierry Volpiatto
2012-01-16 8:58 ` Thierry Volpiatto
2012-01-16 13:56 ` Stefan Monnier
2012-01-16 14:13 ` Michael Albinus
2012-01-16 15:18 ` Stefan Monnier
2012-01-16 15:27 ` Michael Albinus
2012-01-16 21:40 ` Stefan Monnier
2012-02-21 16:53 ` Thierry Volpiatto
2012-02-21 17:59 ` Stefan Monnier
2012-02-21 19:46 ` Michael Albinus
2012-02-21 20:58 ` Thierry Volpiatto
2012-02-21 22:51 ` Stefan Monnier
2012-02-22 21:37 ` Thierry Volpiatto
2012-02-22 22:00 ` Stefan Monnier
2012-02-23 6:15 ` Thierry Volpiatto
2012-02-23 16:01 ` Thierry Volpiatto
2012-02-23 17:18 ` Stefan Monnier
2012-02-23 22:10 ` Thierry Volpiatto
2012-02-24 5:37 ` Thierry Volpiatto
2012-02-24 7:16 ` Thierry Volpiatto
2012-02-24 9:19 ` Eli Zaretskii
2012-02-24 9:49 ` Thierry Volpiatto
2012-02-24 12:18 ` Thierry Volpiatto [this message]
2012-02-24 12:54 ` Michael Albinus
2012-02-24 13:36 ` Thierry Volpiatto
2012-02-24 15:00 ` Michael Albinus
2012-02-24 14:33 ` Eli Zaretskii
2012-02-24 15:19 ` Michael Albinus
2012-02-24 19:42 ` Eli Zaretskii
2012-02-24 20:35 ` Michael Albinus
2012-02-25 6:21 ` Eli Zaretskii
2012-02-27 8:39 ` Michael Albinus
2012-02-27 17:40 ` Eli Zaretskii
2012-02-24 14:45 ` Thierry Volpiatto
2012-02-24 15:23 ` Michael Albinus
2012-02-24 14:39 ` Eli Zaretskii
2012-02-24 14:50 ` Thierry Volpiatto
2012-02-24 15:26 ` Michael Albinus
2012-02-24 15:52 ` Thierry Volpiatto
2012-02-24 16:17 ` Michael Albinus
2012-02-24 16:02 ` Thierry Volpiatto
2012-02-24 16:15 ` Drew Adams
2012-02-24 16:25 ` Michael Albinus
2012-02-24 16:42 ` Drew Adams
2012-02-24 17:04 ` Michael Albinus
2012-02-24 16:21 ` Michael Albinus
2012-02-24 17:23 ` Thierry Volpiatto
2012-02-24 18:43 ` Michael Albinus
2012-02-24 20:06 ` Thierry Volpiatto
2012-02-24 20:04 ` Eli Zaretskii
2012-02-24 20:33 ` Michael Albinus
2012-02-24 21:54 ` Thierry Volpiatto
2012-02-25 8:56 ` Michael Albinus
2012-02-25 9:08 ` Thierry Volpiatto
2012-02-26 9:48 ` Michael Albinus
2012-02-26 19:48 ` Thierry Volpiatto
2012-02-26 21:40 ` Stefan Monnier
2012-02-27 6:45 ` Thierry Volpiatto
2012-02-27 7:45 ` Stefan Monnier
2012-02-27 8:04 ` Thierry Volpiatto
2012-02-27 10:34 ` Stefan Monnier
2012-02-27 11:06 ` Thierry Volpiatto
2012-02-27 11:10 ` Michael Albinus
2012-02-27 11:34 ` Thierry Volpiatto
2012-02-27 13:24 ` Stefan Monnier
2012-02-27 14:59 ` Thierry Volpiatto
2012-02-27 17:38 ` Stefan Monnier
2012-02-27 18:34 ` Thierry Volpiatto
2012-02-27 19:08 ` Michael Albinus
2012-02-27 19:33 ` Thierry Volpiatto
2012-02-27 19:49 ` Michael Albinus
2012-02-27 21:58 ` Stefan Monnier
2012-02-27 22:11 ` Thierry Volpiatto
2012-02-28 6:12 ` Thierry Volpiatto
2012-02-28 7:14 ` Thierry Volpiatto
2012-02-28 7:34 ` Michael Albinus
2012-02-28 8:15 ` Thierry Volpiatto
2012-02-28 8:31 ` Michael Albinus
2012-02-28 9:34 ` Thierry Volpiatto
2012-02-28 10:15 ` Michael Albinus
2012-02-28 19:29 ` Stefan Monnier
2012-02-28 19:53 ` Michael Albinus
2012-02-29 2:01 ` Stefan Monnier
2012-02-29 11:04 ` Michael Albinus
2012-02-29 16:48 ` Stefan Monnier
2012-02-29 17:52 ` Thierry Volpiatto
2012-03-01 2:33 ` Stefan Monnier
2012-03-01 8:37 ` Michael Albinus
2012-02-27 10:40 ` Thierry Volpiatto
2012-02-27 11:03 ` Michael Albinus
2012-02-27 11:29 ` Thierry Volpiatto
2012-02-27 14:19 ` Drew Adams
2012-02-27 13:54 ` Chong Yidong
2012-02-27 15:15 ` Thierry Volpiatto
2012-02-25 7:05 ` Eli Zaretskii
2012-02-25 9:56 ` Stefan Monnier
2012-02-25 13:05 ` Michael Albinus
2012-02-25 15:36 ` Michael Albinus
2012-02-25 15:53 ` Thierry Volpiatto
2012-02-25 22:41 ` Stefan Monnier
2012-02-26 9:21 ` Michael Albinus
2012-02-26 21:38 ` Stefan Monnier
2012-02-27 8:19 ` Michael Albinus
2012-02-27 10:39 ` Stefan Monnier
2012-02-25 13:03 ` Michael Albinus
2012-02-25 14:35 ` Stefan Monnier
2012-02-25 14:56 ` Lennart Borgman
2012-02-21 19:43 ` Michael Albinus
2012-02-21 21:03 ` Thierry Volpiatto
2012-01-16 14:09 ` Andreas Schwab
2012-01-16 19:14 ` Thierry Volpiatto
2012-01-17 6:06 ` Thierry Volpiatto
2012-01-21 13:01 ` Thierry Volpiatto
2012-01-21 16:02 ` Thierry Volpiatto
2012-01-13 19:43 ` Stefan Monnier
2012-01-13 22:51 ` Michael Albinus
2012-01-14 1:55 ` Stefan Monnier
2012-01-14 8:59 ` Eli Zaretskii
2012-01-14 14:19 ` Stefan Monnier
2012-01-14 15:55 ` Eli Zaretskii
2012-01-15 5:59 ` Thierry Volpiatto
2012-01-15 12:40 ` Michael Albinus
2012-01-15 17:28 ` Thierry Volpiatto
2012-01-13 15:31 ` Drew Adams
2012-01-13 15:41 ` Eli Zaretskii
2012-01-13 16:56 ` Drew Adams
2012-01-15 18:42 ` Drew Adams
2012-01-13 10:32 ` Eli Zaretskii
2012-03-22 2:18 ` Michael Heerdegen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87r4xkwhky.fsf@gmail.com \
--to=thierry.volpiatto@gmail.com \
--cc=10489@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).