Commit 40311efc authored by Thierry Volpiatto's avatar Thierry Volpiatto Committed by Chong Yidong
Browse files

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.
parent 5319014e
2012-03-30 Thierry Volpiatto <thierry.volpiatto@gmail.com>
* 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 <cyd@gnu.org> 2012-03-30 Chong Yidong <cyd@gnu.org>
* image.el (imagemagick-types-inhibit) * image.el (imagemagick-types-inhibit)
......
...@@ -1264,7 +1264,8 @@ Special value `always' suppresses confirmation." ...@@ -1264,7 +1264,8 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file-recursive (from to ok-flag &optional (defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive) 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)) (error "Cannot copy `%s' into its subdirectory `%s'" from to))
(let ((attrs (file-attributes from))) (let ((attrs (file-attributes from)))
(if (and recursive (if (and recursive
...@@ -1451,11 +1452,13 @@ ESC or `q' to not overwrite any of the remaining files, ...@@ -1451,11 +1452,13 @@ ESC or `q' to not overwrite any of the remaining files,
(file-directory-p to) (file-directory-p to)
(eq file-creator 'dired-copy-file)) (eq file-creator 'dired-copy-file))
(setq to destname)) (setq to destname))
;; If DESTNAME and FROM are the same directory or ;; If DESTNAME is a subdirectory of FROM, not a symlink,
;; If DESTNAME is a subdirectory of FROM, return error. ;; and the method in use is copying, signal an error.
(and (file-subdir-of-p destname from) (and (eq t (car (file-attributes destname)))
(error "Cannot copy `%s' into its subdirectory `%s'" (eq file-creator 'dired-copy-file)
from to))) (file-subdir-of-p destname from)
(error "Here:Cannot copy `%s' into its subdirectory `%s'"
from to)))
(condition-case err (condition-case err
(progn (progn
(funcall file-creator from to dired-overwrite-confirmed) (funcall file-creator from to dired-overwrite-confirmed)
......
...@@ -3736,7 +3736,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ...@@ -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-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-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff ;;;;;; 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 ;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\ (autoload 'dired-diff "dired-aux" "\
......
...@@ -5102,13 +5102,14 @@ directly into NEWNAME instead." ...@@ -5102,13 +5102,14 @@ directly into NEWNAME instead."
;; We do not want to copy "." and "..". ;; We do not want to copy "." and "..".
(directory-files directory 'full (directory-files directory 'full
directory-files-no-dot-files-regexp)) directory-files-no-dot-files-regexp))
(if (file-directory-p file) (let ((target (expand-file-name (file-name-nondirectory file) newname))
(copy-directory file newname keep-time parents) (filetype (car (file-attributes file))))
(let ((target (expand-file-name (file-name-nondirectory file) newname)) (cond
(attrs (file-attributes file))) ((eq filetype t) ; Directory but not a symlink.
(if (stringp (car attrs)) ; Symbolic link (copy-directory file newname keep-time parents))
(make-symbolic-link (car attrs) target t) ((stringp filetype) ; Symbolic link
(copy-file file target t keep-time))))) (make-symbolic-link filetype target t))
((copy-file file target t keep-time)))))
;; Set directory attributes. ;; Set directory attributes.
(let ((modes (file-modes directory)) (let ((modes (file-modes directory))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment