bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#10897: copy-directory create new directory when copying a symlink


From: Marco Centurion
Subject: bug#10897: copy-directory create new directory when copying a symlink
Date: Thu, 19 Aug 2021 18:47:33 -0300
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

This patch seems to fix this issue. Turns out that the code didn't take
into consideration the case when the directory we want to copy is itself
a symlink.

diff --git a/lisp/files.el b/lisp/files.el
index 875ac55316..424cf1bea0 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6193,42 +6193,48 @@ copy-directory
       (setq directory (directory-file-name (expand-file-name directory))
            newname (expand-file-name newname))
 
-      (cond ((not (directory-name-p newname))
-            ;; If NEWNAME is not a directory name, create it;
-            ;; that is where we will copy the files of DIRECTORY.
-            (make-directory newname parents))
-           ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
-           ;; create NEWNAME if it is not already a directory;
-           ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
-           ((if copy-contents
-                (or parents (not (file-directory-p newname)))
-              (setq newname (concat newname
-                                    (file-name-nondirectory directory))))
-            (make-directory (directory-file-name newname) parents))
-           (t (setq follow t)))
-
-      ;; Copy recursively.
-      (dolist (file
-              ;; We do not want to copy "." and "..".
-              (directory-files directory 'full
-                               directory-files-no-dot-files-regexp))
-       (let ((target (concat (file-name-as-directory newname)
-                             (file-name-nondirectory file)))
-             (filetype (car (file-attributes file))))
-         (cond
-          ((eq filetype t)       ; Directory but not a symlink.
-           (copy-directory file target keep-time parents t))
-          ((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))
-           (times (and keep-time (file-attribute-modification-time
-                                  (file-attributes directory))))
-           (follow-flag (unless follow 'nofollow)))
-       (if modes (set-file-modes newname modes follow-flag))
-       (if times (set-file-times newname times follow-flag))))))
+      ;; If DIRECTORY is a symlink, create a NEWNAME symlink
+      ;; with the same target.
+      (if (file-symlink-p directory)
+         (let ((target  (car (file-attributes directory))))
+           (make-symbolic-link target newname t))
+        ;; Else proceed to copy as a regular directory
+        (cond ((not (directory-name-p newname))
+              ;; If NEWNAME is not a directory name, create it;
+              ;; that is where we will copy the files of DIRECTORY.
+              (make-directory newname parents))
+             ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
+             ;; create NEWNAME if it is not already a directory;
+             ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+             ((if copy-contents
+                  (or parents (not (file-directory-p newname)))
+                (setq newname (concat newname
+                                      (file-name-nondirectory directory))))
+              (make-directory (directory-file-name newname) parents))
+             (t (setq follow t)))
+
+        ;; Copy recursively.
+        (dolist (file
+                ;; We do not want to copy "." and "..".
+                (directory-files directory 'full
+                                 directory-files-no-dot-files-regexp))
+         (let ((target (concat (file-name-as-directory newname)
+                               (file-name-nondirectory file)))
+               (filetype (car (file-attributes file))))
+           (cond
+            ((eq filetype t)       ; Directory but not a symlink.
+             (copy-directory file target keep-time parents t))
+            ((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))
+             (times (and keep-time (file-attribute-modification-time
+                                    (file-attributes directory))))
+             (follow-flag (unless follow 'nofollow)))
+         (if modes (set-file-modes newname modes follow-flag))
+         (if times (set-file-times newname times follow-flag)))))))
 
 
 ;; At time of writing, only info uses this.
-- 
Marco Centurion
Unidad de Recursos Informáticos
Facultad de Ingeniería - UdelaR

reply via email to

[Prev in Thread] Current Thread [Next in Thread]