From: Marco Centurion <mcenturion@fing.edu.uy>
To: 10897@debbugs.gnu.org
Subject: bug#10897: copy-directory create new directory when copying a symlink
Date: Thu, 19 Aug 2021 18:47:33 -0300 [thread overview]
Message-ID: <87y28xrtsa.fsf@fing.edu.uy> (raw)
In-Reply-To: <874nuchddl.fsf@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 157 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bug#10897.patch --]
[-- Type: text/x-patch, Size: 3845 bytes --]
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)))))))
\f
;; At time of writing, only info uses this.
[-- Attachment #3: Type: text/plain, Size: 92 bytes --]
--
Marco Centurion
Unidad de Recursos Informáticos
Facultad de Ingeniería - UdelaR
next prev parent reply other threads:[~2021-08-19 21:47 UTC|newest]
Thread overview: 35+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-02-27 8:47 bug#10897: copy-directory create new directory when copying a symlink Thierry Volpiatto
2012-02-27 9:11 ` Lars Magne Ingebrigtsen
2012-02-27 9:30 ` Thierry Volpiatto
2012-02-27 10:32 ` Lars Magne Ingebrigtsen
2012-02-27 15:22 ` Thierry Volpiatto
2012-03-09 23:07 ` Lars Magne Ingebrigtsen
2012-03-10 6:08 ` Thierry Volpiatto
2012-03-03 8:42 ` bug#10897: sending mail via report-emacs-bug Thierry Volpiatto
2012-03-03 8:49 ` Eli Zaretskii
2012-03-03 9:29 ` Thierry Volpiatto
2012-03-03 10:04 ` Thierry Volpiatto
2012-03-03 14:29 ` Lars Magne Ingebrigtsen
2012-03-03 14:59 ` Thierry Volpiatto
2012-03-03 15:05 ` Lars Magne Ingebrigtsen
2012-03-03 17:08 ` Thierry Volpiatto
2012-03-03 17:20 ` Thierry Volpiatto
2012-03-04 15:02 ` Lars Magne Ingebrigtsen
2012-03-05 13:58 ` Thierry Volpiatto
2012-03-03 14:33 ` Lars Magne Ingebrigtsen
2020-08-25 12:47 ` bug#10897: copy-directory create new directory when copying a symlink Lars Ingebrigtsen
2020-10-13 2:33 ` Lars Ingebrigtsen
2020-10-13 3:15 ` Glenn Morris
2020-10-13 3:19 ` Lars Ingebrigtsen
2021-08-19 21:47 ` Marco Centurion [this message]
2021-08-20 1:08 ` Marco Centurion
2021-08-20 5:51 ` Eli Zaretskii
2021-08-22 13:34 ` Michael Albinus
2021-08-22 13:46 ` Eli Zaretskii
2021-08-22 14:58 ` Michael Albinus
2021-08-22 16:47 ` Eli Zaretskii
2021-08-22 17:13 ` Michael Albinus
2021-08-22 18:48 ` Michael Albinus
2021-08-20 13:44 ` Lars Ingebrigtsen
2021-08-20 14:29 ` Marco Centurion - URI
2021-08-20 14:38 ` Lars Ingebrigtsen
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87y28xrtsa.fsf@fing.edu.uy \
--to=mcenturion@fing.edu.uy \
--cc=10897@debbugs.gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.