From 7911ebc6101679fed116218e8b5c08f11c712f51 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 15 Sep 2017 18:29:00 +0200 Subject: [PATCH] Improve Tramp behaviour according to bug#27986 * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Check, that NEWNAME is a directory name when existing. Use `file-name-as-directory' where appropriate. --- lisp/net/tramp-adb.el | 3 ++- lisp/net/tramp-sh.el | 22 ++++++++++++---------- lisp/net/tramp-smb.el | 12 ++++++++---- 3 files changed, 22 insertions(+), 15 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 30e0c17acfc..c22869d2cc2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -739,7 +739,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal (car err) (cdr err)))) ;; Remote newname. - (when (file-directory-p newname) + (when (and (file-directory-p newname) + (directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 016a9205c94..7df5aa3b7b0 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1984,24 +1984,26 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-dissect-file-name newname))))) ;; scp or rsync DTRT. (progn + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) (setq dirname (directory-file-name (expand-file-name dirname)) newname (directory-file-name (expand-file-name newname))) - (if (and (file-directory-p newname) - (not (string-equal (file-name-nondirectory dirname) - (file-name-nondirectory newname)))) - (setq newname - (expand-file-name - (file-name-nondirectory dirname) newname))) - (if (not (file-directory-p (file-name-directory newname))) + (when (and (file-directory-p newname) + (not (string-equal (file-name-nondirectory dirname) + (file-name-nondirectory newname)))) + (setq newname + (expand-file-name + (file-name-nondirectory dirname) newname))) + (when (not (file-directory-p (file-name-directory newname))) (make-directory (file-name-directory newname) parents)) (tramp-do-copy-or-rename-file-out-of-band 'copy dirname newname keep-date)) + ;; We must do it file-wise. (tramp-run-real-handler 'copy-directory - (if copy-contents - (list dirname newname keep-date parents copy-contents) - (list dirname newname keep-date parents)))) + (list dirname newname keep-date parents copy-contents))) ;; When newname did exist, we have wrong cached values. (when t2 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index e7646e68c21..49695666707 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -414,6 +414,9 @@ pass to the OPERATION." (with-parsed-tramp-file-name (if t1 dirname newname) nil (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) (cond ;; We must use a local temporary directory. ((and t1 t2) @@ -425,7 +428,8 @@ pass to the OPERATION." (unwind-protect (progn (make-directory tmpdir) - (copy-directory dirname tmpdir keep-date 'parents) + (copy-directory + dirname (file-name-as-directory tmpdir) keep-date 'parents) (copy-directory (expand-file-name (file-name-nondirectory dirname) tmpdir) newname keep-date parents)) @@ -569,8 +573,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." 0 (format "Copying %s to %s" filename newname) (if (file-directory-p filename) - (copy-directory - filename newname keep-date 'parents 'copy-contents) + (copy-directory filename newname keep-date 'parents 'copy-contents) (let ((tmpfile (file-local-copy filename))) (if tmpfile @@ -582,7 +585,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal (car err) (cdr err)))) ;; Remote newname. - (when (file-directory-p newname) + (when (and (file-directory-p newname) + (directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) -- 2.39.5