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, 13 Jan 2012 20:17:43 +0100 Message-ID: <87pqen76p4.fsf@gmail.com> References: <87mx9su32g.fsf@web.de> <87sjjkfvwt.fsf@gmail.com> <8362ggkquq.fsf@gnu.org> <87lipcrlga.fsf@gmail.com> <87fwfkc4pn.fsf@gmx.de> <87fwfjsw8t.fsf@gmail.com> <87aa5rdazl.fsf@gmx.de> <87d3anogf5.fsf@gmail.com> <011AEED9E81C4DEFA6B1E03B0F57F28F@us.oracle.com> <878vlbljnc.fsf@gmx.de> <8739bj8mu1.fsf@gmail.com> <87fwfjo24c.fsf@gmx.de> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-Trace: dough.gmane.org 1326482314 21681 80.91.229.12 (13 Jan 2012 19:18:34 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 13 Jan 2012 19:18:34 +0000 (UTC) Cc: 10489@debbugs.gnu.org To: Michael Albinus Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Jan 13 20:18:29 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Rlmdx-0003MZ-9y for geb-bug-gnu-emacs@m.gmane.org; Fri, 13 Jan 2012 20:18:29 +0100 Original-Received: from localhost ([::1]:42446 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rlmdw-0003XL-R3 for geb-bug-gnu-emacs@m.gmane.org; Fri, 13 Jan 2012 14:18:28 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:50531) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rlmdt-0003Wy-69 for bug-gnu-emacs@gnu.org; Fri, 13 Jan 2012 14:18:26 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Rlmdr-000818-NB for bug-gnu-emacs@gnu.org; Fri, 13 Jan 2012 14:18:25 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:33813) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rlmdr-000811-LT for bug-gnu-emacs@gnu.org; Fri, 13 Jan 2012 14:18:23 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1RlmeT-0002RZ-Ny for bug-gnu-emacs@gnu.org; Fri, 13 Jan 2012 14:19:01 -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, 13 Jan 2012 19:19: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: Original-Received: via spool by 10489-submit@debbugs.gnu.org id=B10489.13264823199365 (code B ref 10489); Fri, 13 Jan 2012 19:19:01 +0000 Original-Received: (at 10489) by debbugs.gnu.org; 13 Jan 2012 19:18:39 +0000 Original-Received: from localhost ([127.0.0.1]:56719 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1Rlme6-0002Qz-Rt for submit@debbugs.gnu.org; Fri, 13 Jan 2012 14:18:39 -0500 Original-Received: from mail-wi0-f172.google.com ([209.85.212.172]:37786) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1Rlme4-0002Qs-6T for 10489@debbugs.gnu.org; Fri, 13 Jan 2012 14:18:37 -0500 Original-Received: by wibhj6 with SMTP id hj6so702811wib.3 for <10489@debbugs.gnu.org>; Fri, 13 Jan 2012 11:17:57 -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=YSZH4xipgfqbBIZZJc/C6XTnykNX2iSqv+wLcS0nf34=; b=GpHahL6RwsG4c8hRgb3SPKTc0NjnvLg8D8h+jxNg7Vawl15wFhhDBFnbaW/00u8k0a 4SX8ZNFAS3IjRBTn919aa003yTLKRWySUeRgPvx/q+fQWnby2r3j2IUI0iuyE/WEYv+7 NtT7vE+X6TKMzvVBWobhinafvGM67KijsDOV0= Original-Received: by 10.180.100.234 with SMTP id fb10mr2316388wib.5.1326482277033; Fri, 13 Jan 2012 11:17:57 -0800 (PST) Original-Received: from thierry-MM061 (121.77.197.77.rev.sfr.net. [77.197.77.121]) by mx.google.com with ESMTPS id ga4sm12222753wbb.4.2012.01.13.11.17.51 (version=TLSv1/SSLv3 cipher=OTHER); Fri, 13 Jan 2012 11:17:54 -0800 (PST) In-Reply-To: <87fwfjo24c.fsf@gmx.de> (Michael Albinus's message of "Fri, 13 Jan 2012 20:04:35 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.92 (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:55711 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Michael Albinus writes: > Thierry Volpiatto writes: > >> What about this? >> >> (defun file-name-equal-p (name1 name2 &optional dir) >> (let* ((n1 (file-truename (expand-file-name name1 dir))) >> (n2 (file-truename (expand-file-name name2 dir))) >> (rhost1 (file-remote-p n1 'host)) >> (rhost2 (file-remote-p n2 'host)) >> (lname1 (file-remote-p n1 'localname)) >> (lname2 (file-remote-p n2 'localname)) >> (rem-n1 (if rhost1 >> (list (cons rhost1 lname1)) >> (list (cons (system-name) n1)))) >> (rem-n2 (if rhost2 >> (list (cons rhost2 lname2)) >> (list (cons (system-name) n2))))) >> (loop for (x1 . y1) in rem-n1 >> for (x2 . y2) in rem-n2 >> thereis (and (equal x1 x2) >> (equal y1 y2))))) > > Nope. User name and method also matter. > > "/ftp:host:/file" <> "/ssh:@host:/file" > > "/ftp:user1@host:/file" <> "/ftp:user1@host:/file" I see. > You shouldn't mess with remote files, really :-) Indeed yes! > That's what file name handlers are good for. > > Best regards, Michael. I post here the last version of the patch I wrote today, waiting something better to compare files. it works and fix this bug in most use cases. =20 =2D-=20 Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997=20 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=Singlepatch-r118414ToTip.patch Content-Transfer-Encoding: quoted-printable ##Merge of all patches applied from revision 118413 ## patch-r118414: Fix error when trying to copy directory on itself (bug#10= 489). ## patch-r118415: * lisp/dired-aux.el (dired-copy-file-recursive): Handle a= lso remote file/dir. ## patch-r118416: Handle only remote files with sudo method when copying di= rectories. ## patch-r118417: * lisp/dired-aux.el (dired-copy-file-recursive): Use file= -truename. ##=20 diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el =2D-- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1264,24 +1264,34 @@ =20 (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) =2D (let ((attrs (file-attributes from))) + (let* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename from))) + (destname (file-name-as-directory (file-truename to))) + (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method)) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname 'method)) + (file-remote-p destname 'localname))) + (attrs (file-attributes from))) + (when (equal (or rem-dirname fromname) + (or rem-newname destname)) + (error "Can't copy directory `%s' on itself" from)) (if (and recursive =2D (eq t (car attrs)) =2D (or (eq recursive 'always) =2D (yes-or-no-p (format "Recursive copies of %s? " from)))) =2D ;; This is a directory. =2D (copy-directory from to preserve-time) + (eq t (car attrs)) + (or (eq recursive 'always) + (yes-or-no-p (format "Recursive copies of %s? " from)))) + ;; This is a directory. + (copy-directory from to preserve-time) ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err =2D (if (stringp (car attrs)) =2D ;; It is a symlink =2D (make-symbolic-link (car attrs) to ok-flag) =2D (copy-file from to ok-flag preserve-time)) =2D (file-date-error =2D (push (dired-make-relative from) =2D dired-create-files-failures) =2D (dired-log "Can't set date on %s:\n%s\n" from err)))))) + (if (stringp (car attrs)) + ;; It is a symlink + (make-symbolic-link (car attrs) to ok-flag) + (copy-file from to ok-flag preserve-time)) + (file-date-error + (push (dired-make-relative from) + dired-create-files-failures) + (dired-log "Can't set date on %s:\n%s\n" from err)))))) =20 ;;;###autoload (defun dired-rename-file (file newname ok-if-already-exists) @@ -1402,7 +1412,7 @@ newfile's entry, or t to use the current marker character if the old file was marked." (let (dired-create-files-failures failures =2D skipped (success-count 0) (total (length fn-list))) + skipped (success-count 0) (total (leng= th fn-list))) (let (to overwrite-query overwrite-backup-query) ; for dired-handle-overwrite (dolist (from fn-list) @@ -1430,10 +1440,40 @@ (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) =2D (when (and (file-directory-p from) =2D (file-directory-p to) =2D (eq file-creator 'dired-copy-file)) =2D (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" =3D> "~/test" or "~/foo" =3D>"~/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* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename fr= om))) + (destname (file-name-as-directory (file-name-direct= ory + (file-truename t= o)))) + (rem-fromname (and (equal "sudo" (file-remote-p fromname + 'method= )) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname + 'method= )) + (file-remote-p destname 'localname))= )) + (when (and (file-directory-p from) + (or (equal (or + ;; Maybe a remote file with sudo meth= od + ;; converted to its localname. + rem-fromname + ;; Otherwise compare with local name. + fromname) + (or rem-newname destname)) + (file-directory-p to)) + (eq file-creator 'dired-copy-file)) + (setq to (file-name-directory to)))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) @@ -1456,21 +1496,21 @@ (setq failures (nconc failures dired-create-files-failures)) (dired-log-summary (format "%s failed for %d file%s in %d requests" =2D operation (length failures) =2D (dired-plural-s (length failures)) =2D total) + operation (length failures) + (dired-plural-s (length failures)) + total) failures)) (failures (dired-log-summary (format "%s failed for %d of %d file%s" =2D operation (length failures) =2D total (dired-plural-s total)) + operation (length failures) + total (dired-plural-s total)) failures)) (skipped (dired-log-summary (format "%s: %d of %d file%s skipped" =2D operation (length skipped) total =2D (dired-plural-s total)) + operation (length skipped) total + (dired-plural-s total)) skipped)) (t (message "%s: %s file%s" diff --git a/lisp/files.el b/lisp/files.el =2D-- a/lisp/files.el +++ b/lisp/files.el @@ -4928,10 +4928,20 @@ (format "Copy directory %s to: " dir) default-directory default-directory nil nil) current-prefix-arg t nil))) =2D ;; If default-directory is a remote directory, make sure we find its =2D ;; copy-directory handler. =2D (let ((handler (or (find-file-name-handler directory 'copy-directory) =2D (find-file-name-handler newname 'copy-directory)))) + (let* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename directory))) + (destname (file-name-as-directory (file-truename newname))) + (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method)) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname 'method)) + (file-remote-p destname 'localname))) + ;; If default-directory is a remote directory, make sure we find = its + ;; copy-directory handler. + (handler (or (find-file-name-handler directory 'copy-directory) + (find-file-name-handler newname 'copy-directory)))) + (when (equal (or rem-dirname fromname) + (or rem-newname destname)) + (error "Can't copy directory `%s' on itself" directory)) (if handler (funcall handler 'copy-directory directory newname keep-time parents) =20 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.11 (GNU/Linux) iEYEARECAAYFAk8Qg1gACgkQKNF/U1nymZf6ZwCgkn18f1RlmFBq0GysQmGBXJBS KfUAoLqtmZ/zvAh4IMsKqQ3TFkWC6qr6 =X4m/ -----END PGP SIGNATURE----- --==-=-=--