unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 10489@debbugs.gnu.org, Michael Albinus <michael.albinus@gmx.de>
Subject: bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy
Date: Fri, 24 Feb 2012 06:37:26 +0100	[thread overview]
Message-ID: <87zkc8x04p.fsf@gmail.com> (raw)
In-Reply-To: <jwv39a1sc8e.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Thu, 23 Feb 2012 12:18:51 -0500")

[-- Attachment #1: Type: text/plain, Size: 619 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> 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?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: dired-create-files modif --]
[-- Type: text/x-diff, Size: 26063 bytes --]

# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto@gmail.com>
# Date 1330061336 -3600
# Node ID b41b1ec2b6dbe7fa96efa4b1a0dcb3be8133a46c
# Parent  c136fe29a3a316a56bae9c9d8dec2d8add468d48
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,24 +1264,26 @@
 
 (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))
-	     (or (eq recursive 'always)
-		 (yes-or-no-p (format "Recursive copies of %s? " from))))
-	;; This is a directory.
-	(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
-	  (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))))))
+          (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))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1378,7 +1380,7 @@
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
+                                        &optional marker-char)
   "Create one or more new files from a list of existing files FN-LIST.
 This function also handles querying the user, updating Dired
 buffers, and displaying a success or failure message.
@@ -1401,10 +1403,14 @@
 Optional MARKER-CHAR is a character with which to mark every
 newfile's entry, or t to use the current marker character if the
 old file was marked."
-  (let (dired-create-files-failures failures
-	skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
+  (let (dired-create-files-failures
+        failures
+        skipped
+        (success-count 0)
+        (total (length fn-list)))
+    (let (to
+          overwrite-query
+          overwrite-backup-query)	; for dired-handle-overwrite
       (dolist (from fn-list)
         (setq to (funcall name-constructor from))
         (if (equal to from)
@@ -1430,10 +1436,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)
@@ -1456,25 +1478,25 @@
       (setq failures (nconc failures dired-create-files-failures))
       (dired-log-summary
        (format "%s failed for %d file%s in %d requests"
-		operation (length failures)
-		(dired-plural-s (length failures))
-		total)
+               operation (length failures)
+               (dired-plural-s (length failures))
+               total)
        failures))
      (failures
       (dired-log-summary
        (format "%s failed for %d of %d file%s"
-		operation (length failures)
-		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"
-		operation (length skipped) total
-		(dired-plural-s total))
+               operation (length skipped) total
+               (dired-plural-s total))
        skipped))
      (t
       (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
+               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
 \f
 (defun dired-do-create-files (op-symbol file-creator operation arg
diff --git a/lisp/files.el b/lisp/files.el
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -510,36 +510,14 @@
 		 (other :tag "Query" other))
   :group 'find-file)
 
-;; This is an odd variable IMO.
-;; You might wonder why it is needed, when we could just do:
-;; (set (make-local-variable 'enable-local-variables) nil)
-;; These two are not precisely the same.
-;; Setting this variable does not cause -*- mode settings to be
-;; ignored, whereas setting enable-local-variables does.
-;; Only three places in Emacs use this variable: tar and arc modes,
-;; and rmail.  The first two don't need it.  They already use
-;; inhibit-local-variables-regexps, which is probably enough, and
-;; could also just set enable-local-variables locally to nil.
-;; Them setting it has the side-effect that dir-locals cannot apply to
-;; eg tar files (?).  FIXME Is this appropriate?
-;; AFAICS, rmail is the only thing that needs this, and the only
-;; reason it uses it is for BABYL files (which are obsolete).
-;; These contain "-*- rmail -*-" in the first line, which rmail wants
-;; to respect, so that find-file on a BABYL file will switch to
-;; rmail-mode automatically (this is nice, but hardly essential,
-;; since most people are used to explicitly running a command to
-;; access their mail; M-x gnus etc).  Rmail files may happen to
-;; contain Local Variables sections in messages, which Rmail wants to
-;; ignore.  So AFAICS the only reason this variable exists is for a
-;; minor convenience feature for handling of an obsolete Rmail file format.
 (defvar local-enable-local-variables t
   "Like `enable-local-variables' but meant for buffer-local bindings.
 The meaningful values are nil and non-nil.  The default is non-nil.
 If a major mode sets this to nil, buffer-locally, then any local
-variables list in a file visited in that mode will be ignored.
-
-This variable does not affect the use of major modes specified
-in a -*- line.")
+variables list in the file will be ignored.
+
+This variable does not affect the use of major modes
+specified in a -*- line.")
 
 (defcustom enable-local-eval 'maybe
   "Control processing of the \"variable\" `eval' in a file's local variables.
@@ -981,18 +959,20 @@
 
 (defcustom remote-file-name-inhibit-cache 10
   "Whether to use the remote file-name cache for read access.
-When `nil', never expire cached values (caution)
-When `t', never use the cache (safe, but may be slow)
-A number means use cached values for that amount of seconds since caching.
-
-The attributes of remote files are cached for better performance.
-If they are changed outside of Emacs's control, the cached values
-become invalid, and must be reread.  If you are sure that nothing
-other than Emacs changes the files, you can set this variable to `nil'.
-
-If a remote file is checked regularly, it might be a good idea to
-let-bind this variable to a value less than the interval between
-consecutive checks.  For example:
+
+When `nil', always use the cached values.
+When `t', never use them.
+A number means use them for that amount of seconds since they were
+cached.
+
+File attributes of remote files are cached for better performance.
+If they are changed out of Emacs' control, the cached values
+become invalid, and must be invalidated.
+
+In case a remote file is checked regularly, it might be
+reasonable to let-bind this variable to a value less then the
+time period between two checks.
+Example:
 
   (defun display-time-file-nonempty-p (file)
     (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
@@ -2425,6 +2405,9 @@
 calling FUNCTION (if it's not nil), we delete the suffix that matched
 REGEXP and search the list again for another match.
 
+If the file name matches `inhibit-first-line-modes-regexps',
+then `auto-mode-alist' is not processed.
+
 The extensions whose FUNCTION is `archive-mode' should also
 appear in `auto-coding-alist' with `no-conversion' coding system.
 
@@ -2495,55 +2478,16 @@
 
 See also `auto-mode-alist'.")
 
-(define-obsolete-variable-alias 'inhibit-first-line-modes-regexps
-  'inhibit-file-local-variables-regexps "24.1")
-
-;; TODO really this should be a list of modes (eg tar-mode), not regexps,
-;; because we are duplicating info from auto-mode-alist.
-;; TODO many elements of this list are also in auto-coding-alist.
-(defvar inhibit-local-variables-regexps
-  (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'"
-		      "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'"
-		      "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'"
-		      "\\.7z\\'"
-		      "\\.sx[dmicw]\\'" "\\.odt\\'"
-		      "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
-  "List of regexps matching file names in which to ignore local variables.
-This includes `-*-' lines as well as trailing \"Local Variables\" sections.
-Files matching this list are typically binary file formats.
-They may happen to contain sequences that look like local variable
-specifications, but are not really, or they may be containers for
-member files with their own local variable sections, which are
-not appropriate for the containing file.
-See also `inhibit-local-variables-suffixes'.")
-
-(define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes
-  'inhibit-local-variables-suffixes "24.1")
-
-(defvar inhibit-local-variables-suffixes nil
-  "List of regexps matching suffixes to remove from file names.
-When checking `inhibit-local-variables-regexps', we first discard
+(defvar inhibit-first-line-modes-regexps
+  (mapcar 'purecopy '("\\.tar\\'" "\\.tgz\\'" "\\.tiff?\\'"
+		      "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'"))
+  "List of regexps; if one matches a file name, don't look for `-*-'.")
+
+(defvar inhibit-first-line-modes-suffixes nil
+  "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
+When checking `inhibit-first-line-modes-regexps', we first discard
 from the end of the file name anything that matches one of these regexps.")
 
-;; TODO explicitly add case-fold-search t?
-(defun inhibit-local-variables-p ()
-  "Return non-nil if file local variables should be ignored.
-This checks the file (or buffer) name against `inhibit-local-variables-regexps'
-and `inhibit-local-variables-suffixes'."
-  (let ((temp inhibit-local-variables-regexps)
-	(name (if buffer-file-name
-		  (file-name-sans-versions buffer-file-name)
-		(buffer-name))))
-    (while (let ((sufs inhibit-local-variables-suffixes))
-	     (while (and sufs (not (string-match (car sufs) name)))
-	       (setq sufs (cdr sufs)))
-	     sufs)
-      (setq name (substring name 0 (match-beginning 0))))
-    (while (and temp
-		(not (string-match (car temp) name)))
-      (setq temp (cdr temp)))
-    temp))
-
 (defvar auto-mode-interpreter-regexp
   (purecopy "#![ \t]?\\([^ \t\n]*\
 /bin/env[ \t]\\)?\\([^ \t\n]+\\)")
@@ -2606,24 +2550,21 @@
 (defun set-auto-mode (&optional keep-mode-if-same)
   "Select major mode appropriate for current buffer.
 
-To find the right major mode, this function checks for a -*- mode tag
+To find the right major mode, this function checks for a -*- mode tag,
 checks for a `mode:' entry in the Local Variables section of the file,
 checks if it uses an interpreter listed in `interpreter-mode-alist',
 matches the buffer beginning against `magic-mode-alist',
 compares the filename against the entries in `auto-mode-alist',
 then matches the buffer beginning against `magic-fallback-mode-alist'.
 
-If `enable-local-variables' is nil, or if the file name matches
-`inhibit-local-variables-regexps', this function does not check
-for any mode: tag anywhere in the file.  If `local-enable-local-variables'
-is nil, then the only mode: tag that can be relevant is a -*- one.
+If `enable-local-variables' is nil, this function does not check for
+any mode: tag anywhere in the file.
 
 If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
 set the major mode only if that would change it.  In other words
 we don't actually set it to the same mode the buffer already has."
   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
-  (let ((try-locals (not (inhibit-local-variables-p)))
-	end done mode modes)
+  (let (end done mode modes)
     ;; Once we drop the deprecated feature where mode: is also allowed to
     ;; specify minor-modes (ie, there can be more than one "mode:"), we can
     ;; remove this section and just let (hack-local-variables t) handle it.
@@ -2631,9 +2572,7 @@
     (save-excursion
       (goto-char (point-min))
       (skip-chars-forward " \t\n")
-      ;; Note by design local-enable-local-variables does not matter here.
       (and enable-local-variables
-	   try-locals
 	   (setq end (set-auto-mode-1))
 	   (if (save-excursion (search-forward ":" end t))
 	       ;; Find all specifications for the `mode:' variable
@@ -2664,12 +2603,8 @@
 	      (or (set-auto-mode-0 mode keep-mode-if-same)
 		  ;; continuing would call minor modes again, toggling them off
 		  (throw 'nop nil))))))
-    ;; hack-local-variables checks local-enable-local-variables etc, but
-    ;; we might as well be explicit here for the sake of clarity.
     (and (not done)
 	 enable-local-variables
-	 local-enable-local-variables
-	 try-locals
 	 (setq mode (hack-local-variables t))
 	 (not (memq mode modes))	; already tried and failed
 	 (if (not (functionp mode))
@@ -2779,24 +2714,38 @@
 (defun set-auto-mode-1 ()
   "Find the -*- spec in the buffer.
 Call with point at the place to start searching from.
-If one is found, set point to the beginning and return the position
-of the end.  Otherwise, return nil; may change point.
-The variable `inhibit-local-variables-regexps' can cause a -*- spec to
-be ignored; but `enable-local-variables' and `local-enable-local-variables'
-have no effect."
+If one is found, set point to the beginning
+and return the position of the end.
+Otherwise, return nil; point may be changed."
   (let (beg end)
     (and
      ;; Don't look for -*- if this file name matches any
-     ;; of the regexps in inhibit-local-variables-regexps.
-     (not (inhibit-local-variables-p))
+     ;; of the regexps in inhibit-first-line-modes-regexps.
+     (let ((temp inhibit-first-line-modes-regexps)
+	   (name (if buffer-file-name
+		     (file-name-sans-versions buffer-file-name)
+		   (buffer-name))))
+       (while (let ((sufs inhibit-first-line-modes-suffixes))
+		(while (and sufs (not (string-match (car sufs) name)))
+		  (setq sufs (cdr sufs)))
+		sufs)
+	 (setq name (substring name 0 (match-beginning 0))))
+       (while (and temp
+		   (not (string-match (car temp) name)))
+	 (setq temp (cdr temp)))
+       (not temp))
+
      (search-forward "-*-" (line-end-position
-                            ;; If the file begins with "#!"  (exec
-                            ;; interpreter magic), look for mode frobs
-                            ;; in the first two lines.  You cannot
-                            ;; necessarily put them in the first line
-                            ;; of such a file without screwing up the
-                            ;; interpreter invocation.  The same holds
-                            ;; for '\" in man pages (preprocessor
+                            ;; If the file begins with "#!"
+                            ;; (exec interpreter magic), look
+                            ;; for mode frobs in the first two
+                            ;; lines.  You cannot necessarily
+                            ;; put them in the first line of
+                            ;; such a file without screwing up
+                            ;; the interpreter invocation.
+                            ;; The same holds for
+                            ;;   '\"
+                            ;; in man pages (preprocessor
                             ;; magic for the `man' program).
                             (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
      (progn
@@ -3141,41 +3090,19 @@
 If MODE-ONLY is non-nil, all we do is check whether a \"mode:\"
 is specified, and return the corresponding mode symbol, or nil.
 In this case, we try to ignore minor-modes, and only return a
-major-mode.
-
-If `enable-local-variables' or `local-enable-local-variables' is nil,
-this function does nothing.  If `inhibit-local-variables-regexps'
-applies to the file in question, the file is not scanned for
-local variables, but directory-local variables may still be applied."
-  ;; We don't let inhibit-local-variables-p influence the value of
-  ;; enable-local-variables, because then it would affect dir-local
-  ;; variables.  We don't want to search eg tar files for file local
-  ;; variable sections, but there is no reason dir-locals cannot apply
-  ;; to them.  The real meaning of inhibit-local-variables-p is "do
-  ;; not scan this file for local variables".
+major-mode."
   (let ((enable-local-variables
 	 (and local-enable-local-variables enable-local-variables))
 	result)
     (unless mode-only
       (setq file-local-variables-alist nil)
       (report-errors "Directory-local variables error: %s"
-	;; Note this is a no-op if enable-local-variables is nil.
 	(hack-dir-local-variables)))
-    ;; This entire function is basically a no-op if enable-local-variables
-    ;; is nil.  All it does is set file-local-variables-alist to nil.
-    (when enable-local-variables
-      ;; This part used to ignore enable-local-variables when mode-only
-      ;; was non-nil.  That was inappropriate, eg consider the
-      ;; (artificial) example of:
-      ;; (setq local-enable-local-variables nil)
-      ;; Open a file foo.txt that contains "mode: sh".
-      ;; It correctly opens in text-mode.
-      ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
-      (unless (or (inhibit-local-variables-p)
-		  ;; If MODE-ONLY is non-nil, and the prop line specifies a
-		  ;; mode, then we're done, and have no need to scan further.
-		  (and (setq result (hack-local-variables-prop-line mode-only))
-		       mode-only))
+    (when (or mode-only enable-local-variables)
+      ;; If MODE-ONLY is non-nil, and the prop line specifies a mode,
+      ;; then we're done, and have no need to scan further.
+      (unless (and (setq result (hack-local-variables-prop-line mode-only))
+		   mode-only)
 	;; Look for "Local variables:" line in last page.
 	(save-excursion
 	  (goto-char (point-max))
@@ -3265,13 +3192,14 @@
 					    (indirect-variable var))
 					  val) result)
 			    (error nil)))))
-		    (forward-line 1))))))))
-      ;; Now we've read all the local variables.
-      ;; If MODE-ONLY is non-nil, return whether the mode was specified.
-      (if mode-only result
-	;; Otherwise, set the variables.
-	(hack-local-variables-filter result nil)
-	(hack-local-variables-apply)))))
+		    (forward-line 1)))))))))
+    ;; Now we've read all the local variables.
+    ;; If MODE-ONLY is non-nil, return whether the mode was specified.
+    (cond (mode-only result)
+	  ;; Otherwise, set the variables.
+	  (enable-local-variables
+	   (hack-local-variables-filter result nil)
+	   (hack-local-variables-apply)))))
 
 (defun hack-local-variables-apply ()
   "Apply the elements of `file-local-variables-alist'.
@@ -3683,7 +3611,7 @@
   (interactive "FSet visited file name: ")
   (if (buffer-base-buffer)
       (error "An indirect buffer cannot visit a file"))
-  (let (truename old-try-locals)
+  (let (truename)
     (if filename
 	(setq filename
 	      (if (string-equal filename "")
@@ -3708,8 +3636,7 @@
 	(progn
 	  (and filename (lock-buffer filename))
 	  (unlock-buffer)))
-    (setq old-try-locals (not (inhibit-local-variables-p))
-	  buffer-file-name filename)
+    (setq buffer-file-name filename)
     (if filename			; make buffer name reflect filename.
 	(let ((new-name (file-name-nondirectory buffer-file-name)))
 	  (setq default-directory (file-name-directory buffer-file-name))
@@ -4861,13 +4788,7 @@
 (defun rename-uniquely ()
   "Rename current buffer to a similar name not already taken.
 This function is useful for creating multiple shell process buffers
-or multiple mail buffers, etc.
-
-Note that some commands, in particular those based on `compilation-mode'
-\(`compile', `grep', etc.) will reuse the current buffer if it has the
-appropriate mode even if it has been renamed.  So as well as renaming
-the buffer, you also need to switch buffers before running another
-instance of such commands."
+or multiple mail buffers, etc."
   (interactive)
   (save-match-data
     (let ((base-name (buffer-name)))
@@ -4985,6 +4906,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,10 +4961,12 @@
 	    (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)
-		     (find-file-name-handler newname 'copy-directory))))
+                     (find-file-name-handler newname 'copy-directory))))
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 
@@ -5048,7 +5000,7 @@
 	    (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
+	    (if (stringp (car attrs))   ; Symbolic link
 		(make-symbolic-link (car attrs) target t)
 	      (copy-file file target t keep-time)))))
 
@@ -5135,8 +5087,6 @@
 Optional third argument PRESERVE-MODES non-nil means don't alter
 the files modes.  Normally we reinitialize them using `normal-mode'.
 
-This function binds `revert-buffer-in-progress-p' non-nil while it operates.
-
 If the value of `revert-buffer-function' is non-nil, it is called to
 do all the work for this command.  Otherwise, the hooks
 `before-revert-hook' and `after-revert-hook' are run at the beginning

[-- Attachment #3: Type: text/plain, Size: 83 bytes --]


-- 
  Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

  parent reply	other threads:[~2012-02-24  5:37 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 [this message]
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
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=87zkc8x04p.fsf@gmail.com \
    --to=thierry.volpiatto@gmail.com \
    --cc=10489@debbugs.gnu.org \
    --cc=michael.albinus@gmx.de \
    --cc=monnier@iro.umontreal.ca \
    /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).