GNU bug report logs - #10489
24.0.92; dired-do-copy may create infinite directory hierarchy

Previous Next

Package: emacs;

Reported by: michael_heerdegen <at> web.de

Date: Thu, 12 Jan 2012 19:36:01 UTC

Severity: important

Tags: patch

Merged with 11130

Found in version 24.0.92

Done: Chong Yidong <cyd <at> gnu.org>

Bug is archived. No further changes may be made.

Full log


Message #261 received at 10489 <at> debbugs.gnu.org (full text, mbox):

From: Thierry Volpiatto <thierry.volpiatto <at> gmail.com>
To: Stefan Monnier <monnier <at> iro.umontreal.ca>
Cc: 10489 <at> debbugs.gnu.org, Michael Albinus <michael.albinus <at> gmx.de>
Subject: Re: bug#10489: 24.0.92;
	dired-do-copy may create infinite directory hierarchy
Date: Fri, 24 Feb 2012 06:37:26 +0100
[Message part 1 (text/plain, inline)]
Stefan Monnier <monnier <at> 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?

[patch-r118916.patch (text/x-diff, inline)]
# HG changeset patch
# User Thierry Volpiatto <thierry.volpiatto <at> 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))
 
 (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
[Message part 3 (text/plain, inline)]
-- 
  Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

This bug report was last modified 13 years and 58 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.