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: Thu, 23 Feb 2012 17:01:51 +0100 Message-ID: <87d395y1w0.fsf@gmail.com> References: <87mx9su32g.fsf@web.de> <83fwfik92e.fsf@gnu.org> <87mx9q1sz7.fsf@gmail.com> <87vcodm8ns.fsf@gmx.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> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1330012970 32434 80.91.229.3 (23 Feb 2012 16:02:50 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 23 Feb 2012 16:02:50 +0000 (UTC) Cc: 10489@debbugs.gnu.org, Michael Albinus To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Feb 23 17:02:47 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 1S0b82-0006VT-Uu for geb-bug-gnu-emacs@m.gmane.org; Thu, 23 Feb 2012 17:02:47 +0100 Original-Received: from localhost ([::1]:44740 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0b82-0006kg-J9 for geb-bug-gnu-emacs@m.gmane.org; Thu, 23 Feb 2012 11:02:46 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:46186) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0b7v-0006kE-9Y for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2012 11:02:44 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1S0b7q-0005sJ-MM for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2012 11:02:39 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:49285) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1S0b7q-0005sF-F2 for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2012 11:02:34 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1S0bAE-00075h-IO for bug-gnu-emacs@gnu.org; Thu, 23 Feb 2012 11:05: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: Thu, 23 Feb 2012 16:05: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 Original-Received: via spool by 10489-submit@debbugs.gnu.org id=B10489.133001307527219 (code B ref 10489); Thu, 23 Feb 2012 16:05:02 +0000 Original-Received: (at 10489) by debbugs.gnu.org; 23 Feb 2012 16:04:35 +0000 Original-Received: from localhost ([127.0.0.1]:52907 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0b9m-00074x-Ik for submit@debbugs.gnu.org; Thu, 23 Feb 2012 11:04:35 -0500 Original-Received: from mail-wi0-f172.google.com ([209.85.212.172]:47229) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1S0b9j-00074f-8p for 10489@debbugs.gnu.org; Thu, 23 Feb 2012 11:04:33 -0500 Original-Received: by wibhm9 with SMTP id hm9so855859wib.3 for <10489@debbugs.gnu.org>; Thu, 23 Feb 2012 08:01:56 -0800 (PST) Received-SPF: pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.101.37 as permitted sender) client-ip=10.180.101.37; Authentication-Results: mr.google.com; spf=pass (google.com: domain of thierry.volpiatto@gmail.com designates 10.180.101.37 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.101.37]) by 10.180.101.37 with SMTP id fd5mr4878048wib.1.1330012916494 (num_hops = 1); Thu, 23 Feb 2012 08:01:56 -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=O5mA/wf3uw9ONxB7zXz+/7kbbWIg4dMoMQQABbviSnQ=; b=lNpigkOwdpV1AjXC9b0kn/xSotgfZAuyZfFeYhWKcOpGvE07DqIDX0wGRIY/vk7YGF etWTRQy7zN30G9TqFmdJZp/JNCKiUfrxZya6ITkwzdXv6QCpWjCpUuntGQUl9rSyc4Ro VlA+0ON6vXXxpT7Ekai2vFXKP3aghO5WNdgxk= Original-Received: by 10.180.101.37 with SMTP id fd5mr3984385wib.1.1330012916388; Thu, 23 Feb 2012 08:01:56 -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 hb10sm8326974wib.10.2012.02.23.08.01.53 (version=TLSv1/SSLv3 cipher=OTHER); Thu, 23 Feb 2012 08:01:55 -0800 (PST) In-Reply-To: (Stefan Monnier's message of "Wed, 22 Feb 2012 17:00:08 -0500") 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:57137 Archived-At: Stefan Monnier 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