From 40311efcba1378e66987c1acceb035bf482c177c Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Sat, 31 Mar 2012 00:49:29 +0800 Subject: [PATCH] Fix copying of symlinks. * dired-aux.el (dired-copy-file-recursive, dired-create-files): Check if file is a symlink (Bug#10489). * files.el (copy-directory): Likewise. --- lisp/ChangeLog | 7 +++++++ lisp/dired-aux.el | 15 +++++++++------ lisp/dired.el | 2 +- lisp/files.el | 15 ++++++++------- 4 files changed, 25 insertions(+), 14 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bb45d1d7112..2def7e4c934 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-03-30 Thierry Volpiatto + + * dired-aux.el (dired-copy-file-recursive, dired-create-files): + Check if file is a symlink (Bug#10489). + + * files.el (copy-directory): Likewise. + 2012-03-30 Chong Yidong * image.el (imagemagick-types-inhibit) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d6a4a7816d6..8ddc71ba431 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1264,7 +1264,8 @@ Special value `always' suppresses confirmation." (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) - (when (file-subdir-of-p to from) + (when (and (eq t (car (file-attributes from))) + (file-subdir-of-p to from)) (error "Cannot copy `%s' into its subdirectory `%s'" from to)) (let ((attrs (file-attributes from))) (if (and recursive @@ -1451,11 +1452,13 @@ ESC or `q' to not overwrite any of the remaining files, (file-directory-p to) (eq file-creator 'dired-copy-file)) (setq to destname)) - ;; If DESTNAME and FROM are the same directory or - ;; If DESTNAME is a subdirectory of FROM, return error. - (and (file-subdir-of-p destname from) - (error "Cannot copy `%s' into its subdirectory `%s'" - from to))) + ;; If DESTNAME is a subdirectory of FROM, not a symlink, + ;; and the method in use is copying, signal an error. + (and (eq t (car (file-attributes destname))) + (eq file-creator 'dired-copy-file) + (file-subdir-of-p destname from) + (error "Here:Cannot copy `%s' into its subdirectory `%s'" + from to))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) diff --git a/lisp/dired.el b/lisp/dired.el index d26e7004cc3..e333fe7cd50 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3736,7 +3736,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "cab9b84177ac3555c24cf8e870a64095") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "aefbe886cce7b5436fd41a7c55c86f84") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ diff --git a/lisp/files.el b/lisp/files.el index b3fc0766ac5..cc1386b1bbb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5102,13 +5102,14 @@ directly into NEWNAME instead." ;; We do not want to copy "." and "..". (directory-files directory 'full directory-files-no-dot-files-regexp)) - (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))))) + (let ((target (expand-file-name (file-name-nondirectory file) newname)) + (filetype (car (file-attributes file)))) + (cond + ((eq filetype t) ; Directory but not a symlink. + (copy-directory file newname keep-time parents)) + ((stringp filetype) ; Symbolic link + (make-symbolic-link filetype target t)) + ((copy-file file target t keep-time))))) ;; Set directory attributes. (let ((modes (file-modes directory)) -- 2.11.4.GIT