From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.bugs Subject: bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy Date: Fri, 24 Feb 2012 13:18:05 +0100 Message-ID: <87r4xkwhky.fsf@gmail.com> References: <87mx9su32g.fsf@web.de> <87ty3w9639.fsf@gmx.de> <8762gckckt.fsf@gmail.com> <87pqek9269.fsf@gmx.de> <87r4z0yqfx.fsf@gmail.com> <871uqzn3bc.fsf@gmx.de> <871uqz651u.fsf@gmx.de> <87pqd89lh4.fsf@gmail.com> <87mx8b3nvb.fsf@gmail.com> <87pqd6wnvv.fsf@gmail.com> <87d395y1w0.fsf@gmail.com> <87zkc8x04p.fsf@gmail.com> <87vcmwwvk7.fsf@gmail.com> <834nugtwqf.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1330085940 26685 80.91.229.3 (24 Feb 2012 12:19:00 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 24 Feb 2012 12:19:00 +0000 (UTC) Cc: 10489@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Feb 24 13:18:58 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1S0u6x-0002d5-3M for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 13:18:55 +0100 Original-Received: from localhost ([::1]:34516 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0u6p-00036g-8o for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 07:18:47 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:49713) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0u6h-00036Q-6a for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 07:18:45 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0u6e-0005do-6M for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 07:18:38 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:49869) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0u6e-0005dJ-0l for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 07:18:36 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1S0u8z-0004GT-Vp for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 07:21:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Thierry Volpiatto Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 24 Feb 2012 12:21:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 10489 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 10489-submit@debbugs.gnu.org id=B10489.133008606016385 (code B ref 10489); Fri, 24 Feb 2012 12:21:01 +0000 Original-Received: (at 10489) by debbugs.gnu.org; 24 Feb 2012 12:21:00 +0000 Original-Received: from localhost ([127.0.0.1]:53492 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0u8u-0004GA-9e for submit@debbugs.gnu.org; Fri, 24 Feb 2012 07:20:57 -0500 Original-Received: from mail-wi0-f172.google.com ([209.85.212.172]:59783) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0u8n-0004Fr-Q5 for 10489@debbugs.gnu.org; Fri, 24 Feb 2012 07:20:52 -0500 Original-Received: by wibhm9 with SMTP id hm9so1397971wib.3 for <10489@debbugs.gnu.org>; Fri, 24 Feb 2012 04:18:10 -0800 (PST) Received-SPF: pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.80.40 as permitted sender) client-ip=10.180.80.40; Authentication-Results: mr.google.com; spf=pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.80.40 as permitted sender) smtp.mail=thierry.volpiatto@gmail.com; dkim=pass header.i=thierry.volpiatto@gmail.com Original-Received: from mr.google.com ([10.180.80.40]) by 10.180.80.40 with SMTP id o8mr3927354wix.10.1330085890324 (num_hops = 1); Fri, 24 Feb 2012 04:18:10 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=IMLxkNShxSHOgMvUhvUYbkI4iZq2Atf3jzl/AnPSPes=; b=GWLO7+BbGP/fFXeofSkiVU2SfL32BTRiv0bYrLT7tq1xBm05sah/xDV5NOXU7/sav6 D0ibzqP040nUsXew48P/18w1fbHdX26t7fq7usZVGS4rmDMV9dFPV46CWqhaw6mda6Dd zeidv1tZaWci131+AMTDPlsF0A3JUi0CYUPsU= Original-Received: by 10.180.80.40 with SMTP id o8mr3143113wix.10.1330085890229; Fri, 24 Feb 2012 04:18:10 -0800 (PST) Original-Received: from thierry-MM061 (lbe83-2-78-243-104-167.fbx.proxad.net. [78.243.104.167]) by mx.google.com with ESMTPS id cs4sm7728666wib.8.2012.02.24.04.18.07 (version=TLSv1/SSLv3 cipher=OTHER); Fri, 24 Feb 2012 04:18:09 -0800 (PST) In-Reply-To: <834nugtwqf.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 24 Feb 2012 11:19:04 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.93 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:57164 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii 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. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=patch-r118916.patch Content-Description: Improved version with Eli advices # HG changeset patch # User Thierry Volpiatto # 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) --=-=-= Content-Type: text/plain -- Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997 --=-=-=--