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 08:16:08 +0100 Message-ID: <87vcmwwvk7.fsf@gmail.com> References: <87mx9su32g.fsf@web.de> <87pqekopb5.fsf@gmail.com> <87hazwoost.fsf@gmail.com> <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> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1330067889 22804 80.91.229.3 (24 Feb 2012 07:18:09 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 24 Feb 2012 07:18:09 +0000 (UTC) To: 10489@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Feb 24 08:18:09 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from [140.186.70.17] (helo=lists.gnu.org) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1S0pPn-0007zC-6r for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 08:18:03 +0100 Original-Received: from localhost ([::1]:54635 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pPU-0004NV-VF for geb-bug-gnu-emacs@m.gmane.org; Fri, 24 Feb 2012 02:17:44 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:56659) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pPS-0004NM-60 for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:17:43 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0pPN-00032r-R2 for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:17:42 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:49675) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pPN-00032N-Kc for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:17:37 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1S0pRi-0005oX-HB for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:20:02 -0500 X-Loop: help-debbugs@gnu.org In-Reply-To: <87mx9su32g.fsf@web.de> 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 07:20:02 +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 X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.133006796022292 (code B ref -1); Fri, 24 Feb 2012 07:20:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 24 Feb 2012 07:19:20 +0000 Original-Received: from localhost ([127.0.0.1]:53298 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0pR1-0005nU-Gd for submit@debbugs.gnu.org; Fri, 24 Feb 2012 02:19:20 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:41441) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0pQx-0005nF-0Q for submit@debbugs.gnu.org; Fri, 24 Feb 2012 02:19:16 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0pON-0002ww-LO for submit@debbugs.gnu.org; Fri, 24 Feb 2012 02:16:37 -0500 Original-Received: from lists.gnu.org ([140.186.70.17]:51391) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pON-0002wn-Ia for submit@debbugs.gnu.org; Fri, 24 Feb 2012 02:16:35 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:56490) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pOH-0004J5-6Q for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:16:33 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0pOF-0002vs-2n for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:16:28 -0500 Original-Received: from plane.gmane.org ([80.91.229.3]:51613) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0pOE-0002vi-MT for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 02:16:27 -0500 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1S0pOB-0006xd-A4 for bug-gnu-emacs@gnu.org; Fri, 24 Feb 2012 08:16:23 +0100 Original-Received: from lbe83-2-78-243-104-167.fbx.proxad.net ([78.243.104.167]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 24 Feb 2012 08:16:23 +0100 Original-Received: from thierry.volpiatto by lbe83-2-78-243-104-167.fbx.proxad.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 24 Feb 2012 08:16:23 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 148 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: lbe83-2-78-243-104-167.fbx.proxad.net User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.93 (gnu/linux) Cancel-Lock: sha1:U3BAdJiY9tuHaE3Aoo6WWsSLCKg= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) 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:57158 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Thierry Volpiatto writes: > Stefan Monnier 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. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=patch-r118916.patch Content-Description: Merge patch with last revision # HG changeset patch # User Thierry Volpiatto # 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) --=-=-= Content-Type: text/plain -- Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997 --=-=-=--