From a72db8ab8bfe417d40707be6e791c084509f4abf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Nov 2020 12:31:43 +0100 Subject: Make file copying in tramp-gvfs more robust * test/lisp/net/tramp-tests.el (tramp-test11-copy-file) (tramp-test12-rename-file): Do not skip for tramp-gvfs.el. * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): Add sanity checks. --- lisp/net/tramp-gvfs.el | 25 +++++++++++++++++-------- test/lisp/net/tramp-tests.el | 25 ++++++++++--------------- 2 files changed, 27 insertions(+), 23 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e369061664a..b457f54fd50 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -800,14 +800,23 @@ file names." (with-tramp-progress-reporter v 0 (format "%s %s to %s" msg-operation filename newname) (unless - (apply - #'tramp-gvfs-send-command v gvfs-operation - (append - (and (eq op 'copy) (or keep-date preserve-uid-gid) - '("--preserve")) - (list - (tramp-gvfs-url-file-name filename) - (tramp-gvfs-url-file-name newname)))) + (and (apply + #'tramp-gvfs-send-command v gvfs-operation + (append + (and (eq op 'copy) (or keep-date preserve-uid-gid) + '("--preserve")) + (list + (tramp-gvfs-url-file-name filename) + (tramp-gvfs-url-file-name newname)))) + ;; Some backends do not return a proper error + ;; code in case of direct copy/move. Apply sanity checks. + (or (not equal-remote) + (tramp-gvfs-send-command + v "gvfs-info" (tramp-gvfs-url-file-name newname)) + (eq op 'copy) + (not (tramp-gvfs-send-command + v "gvfs-info" + (tramp-gvfs-url-file-name filename))))) (if (or (not equal-remote) (and equal-remote diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e42765ba088..26889c9a25b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2494,9 +2494,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy file to directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (write-region "foo" nil source) (should (file-exists-p source)) (make-directory target) @@ -2520,9 +2519,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory to existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2543,9 +2541,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory/file to non-existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2638,9 +2635,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory to existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2662,9 +2658,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory/file to non-existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) -- cgit v1.2.3