From b81516c7fb558c9b4bc44e6e69f6729a5f2f9894 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 3 Feb 2021 18:48:09 +0100 Subject: [PATCH] Tramp code cleanup * lisp/net/tramp.el (tramp-signal-hook-function) (tramp-handle-access-file, tramp-handle-copy-directory) (tramp-handle-directory-files, tramp-handle-file-local-copy) (tramp-handle-insert-file-contents, tramp-handle-load): * lisp/net/tramp-adb.el (tramp-adb-handle-directory-files-and-attributes) (tramp-adb-handle-make-directory) (tramp-adb-handle-file-local-copy, tramp-adb-handle-copy-file) (tramp-adb-handle-rename-file): * lisp/net/tramp-crypt.el (tramp-crypt-do-copy-or-rename-file) (tramp-crypt-handle-directory-files) (tramp-crypt-handle-make-directory): * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-error) (tramp-gvfs-do-copy-or-rename-file) (tramp-gvfs-handle-make-directory): * lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file) (tramp-rclone-handle-directory-files): * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-directory-files-and-attributes) (tramp-sh-handle-file-name-all-completions) (tramp-sh-handle-copy-directory, tramp-do-copy-or-rename-file) (tramp-sh-handle-make-directory) (tramp-sh-handle-file-local-copy) (tramp-sh-inotifywait-process-filter): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file, tramp-smb-handle-directory-files) (tramp-smb-handle-file-local-copy) (tramp-smb-handle-make-directory, tramp-smb-handle-rename-file): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): Unify error report. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler): Sync args with other `tramp-*-file-name-handler'. * lisp/net/tramp-compat.el (tramp-error): Declare. (tramp-compat-file-missing): New defsubst. * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): Handle volatile files. (tramp-gvfs-set-attribute): New defun. (tramp-gvfs-handle-set-file-modes) (tramp-gvfs-handle-set-file-times) (tramp-gvfs-handle-set-file-uid-gid): Use it. * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file): Use `msg-operation'. * lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory): Remove superfluous `format: (tramp-smb-maybe-open-connection): Simplify loop. * lisp/net/tramp.el (tramp-handle-file-truename): Drop volume letter from symlinked files. * test/lisp/net/tramp-tests.el (tramp--test-gdrive-p): New defun. (tramp--test-nextcloud-p): Remove. (tramp-test40-special-characters-with-ls): Do not skip on MS Windows. (tramp-test41-utf8): Skip if needed. --- lisp/net/tramp-adb.el | 26 ++--- lisp/net/tramp-compat.el | 7 ++ lisp/net/tramp-crypt.el | 12 +-- lisp/net/tramp-gvfs.el | 179 ++++++++++++++++++++--------------- lisp/net/tramp-rclone.el | 12 +-- lisp/net/tramp-sh.el | 35 +++---- lisp/net/tramp-smb.el | 43 +++------ lisp/net/tramp-sudoedit.el | 8 +- lisp/net/tramp.el | 33 +++---- test/lisp/net/tramp-tests.el | 14 ++- 10 files changed, 178 insertions(+), 191 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 73dffe1d64f..6ec4d1fed38 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -197,13 +197,13 @@ It is used for TCP/IP devices." tramp-adb-method))) ;;;###tramp-autoload -(defun tramp-adb-file-name-handler (operation &rest arguments) +(defun tramp-adb-file-name-handler (operation &rest args) "Invoke the ADB handler for OPERATION. First arg specifies the OPERATION, second arg is a list of -ARGUMENTS to pass to the OPERATION." +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist))) - (save-match-data (apply (cdr fn) arguments)) - (tramp-run-real-handler operation arguments))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (tramp--with-startup @@ -305,9 +305,7 @@ ARGUMENTS to pass to the OPERATION." (directory &optional full match nosort id-format count) "Like `directory-files-and-attributes' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil (copy-tree @@ -435,7 +433,7 @@ Emacs dired can't find files." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (when parents (let ((par (expand-file-name ".." dir))) (unless (file-directory-p par) @@ -498,9 +496,7 @@ Emacs dired can't find files." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) @@ -642,9 +638,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (jka-compr-inhibit t)) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Copying file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -726,9 +720,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (jka-compr-inhibit t)) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Renaming file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87e5378e807..27461e6917c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -41,6 +41,7 @@ (require 'shell) (require 'subr-x) +(declare-function tramp-error "tramp") ;; `temporary-file-directory' as function is introduced with Emacs 26.1. (declare-function tramp-handle-temporary-file-directory "tramp") (declare-function tramp-tramp-file-p "tramp") @@ -178,6 +179,12 @@ This is a string of ten letters or dashes as in ls -l." (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) "The error symbol for the `file-missing' error.") +(defsubst tramp-compat-file-missing (vec file) + "Emit the `file-missing' error." + (if (get 'file-missing 'error-conditions) + (tramp-error vec tramp-file-missing file) + (tramp-error vec tramp-file-missing "No such file or directory: %s" file))) + ;; `file-local-name', `file-name-quoted-p', `file-name-quote' and ;; `file-name-unquote' are introduced in Emacs 26.1. (defalias 'tramp-compat-file-local-name diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index dfe54623dbc..f8de7085e25 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -249,7 +249,7 @@ arguments to pass to the OPERATION." ;;;###tramp-autoload (defun tramp-crypt-file-name-handler (operation &rest args) "Invoke the crypted remote file related OPERATION. -First arg specifies the OPERATION, second arg ARGS is a list of +First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (if-let ((filename (apply #'tramp-crypt-file-name-for-operation operation args)) @@ -568,9 +568,7 @@ absolute file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -672,9 +670,7 @@ absolute file names." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let* (tramp-crypt-enabled @@ -781,7 +777,7 @@ WILDCARD is not supported." "Like `make-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name dir) nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (let (tramp-crypt-enabled) (make-directory (tramp-crypt-encrypt-file-name dir) parents)) ;; When PARENTS is non-nil, DIR could be a chain of non-existent diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f882636a8fc..e946d73e66c 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -841,8 +841,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (unless tramp-gvfs-enabled (tramp-user-error nil "Package `tramp-gvfs' not supported")) (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) @@ -945,7 +945,7 @@ is no information where to trace the message.") "Called when a D-Bus error message arrives, see `dbus-event-error-functions'." (when tramp-gvfs-dbus-event-vector (tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event) - (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) + (tramp-error tramp-gvfs-dbus-event-vector 'file-error (cadr err)))) (add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error) (add-hook 'tramp-gvfs-unload-hook @@ -985,83 +985,97 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (equal-remote (tramp-equal-remote filename newname)) + (volatile + (and (eq op 'rename) (tramp-gvfs-file-name-p filename) + (equal + (cdr + (assoc + "standard::is-volatile" + (tramp-gvfs-get-file-attributes filename))) + "TRUE"))) ;; "gvfs-rename" is not trustworthy. (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move")) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) - (if (or (and equal-remote - (tramp-get-connection-property v "direct-copy-failed" nil)) - (and t1 (not (tramp-gvfs-file-name-p filename))) - (and t2 (not (tramp-gvfs-file-name-p newname)))) - - ;; We cannot copy or rename directly. - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (if (eq op 'copy) - (copy-file - filename tmpfile t keep-date preserve-uid-gid - preserve-extended-attributes) - (rename-file filename tmpfile t)) - (rename-file tmpfile newname ok-if-already-exists)) - - ;; Direct action. - (with-tramp-progress-reporter - v 0 (format "%s %s to %s" msg-operation filename newname) - (unless - (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 - (tramp-get-connection-property - v "direct-copy-failed" nil))) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error - "%s failed, see buffer `%s' for details." - msg-operation (buffer-name))) - - ;; Some WebDAV server, like the one from QNAP, do not - ;; support direct copy/move. Try a fallback. - (tramp-set-connection-property v "direct-copy-failed" t) - (tramp-gvfs-do-copy-or-rename-file - op filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes)))) - - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-properties v localname))) - - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-properties v localname)))))))) + (cond + ;; We cannot rename volatile files, as used by Google-drive. + ((and (not equal-remote) volatile) + (prog1 (copy-file + filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + (delete-file filename))) + + ;; We cannot copy or rename directly. + ((or (and equal-remote + (tramp-get-connection-property v "direct-copy-failed" nil)) + (and t1 (not (tramp-gvfs-file-name-p filename))) + (and t2 (not (tramp-gvfs-file-name-p newname)))) + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (if (eq op 'copy) + (copy-file + filename tmpfile t keep-date preserve-uid-gid + preserve-extended-attributes) + (rename-file filename tmpfile t)) + (rename-file tmpfile newname ok-if-already-exists))) + + ;; Direct action. + (t (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) + (unless + (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 + (tramp-get-connection-property + v "direct-copy-failed" nil))) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error + "%s failed, see buffer `%s' for details." + msg-operation (buffer-name))) + + ;; Some WebDAV server, like the one from QNAP, do + ;; not support direct copy/move. Try a fallback. + (tramp-set-connection-property v "direct-copy-failed" t) + (tramp-gvfs-do-copy-or-rename-file + op filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) + + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-properties v localname))) + + (when t2 + (with-parsed-tramp-file-name newname nil + (tramp-flush-file-properties v localname))))))))) (defun tramp-gvfs-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -1545,7 +1559,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq dir (directory-file-name (expand-file-name dir))) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (tramp-flush-directory-properties v localname) (save-match-data (let ((ldir (file-name-directory dir))) @@ -1575,20 +1589,31 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-run-real-handler #'rename-file (list filename newname ok-if-already-exists)))) +(defun tramp-gvfs-set-attribute (vec &rest args) + "Call \"gio set ...\" if possible." + (let ((key (concat "gvfs-set-attribute-" (nth 3 args)))) + (when (tramp-get-connection-property vec key t) + (or (apply #'tramp-gvfs-send-command vec "gvfs-set-attribute" args) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (when (looking-at-p "gio: Operation not supported") + (tramp-set-connection-property vec key nil))) + nil)))) + (defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-gvfs-send-command - v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32" + (tramp-gvfs-set-attribute + v (if (eq flag 'nofollow) "-nt" "-t") "uint32" (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode)))) (defun tramp-gvfs-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-gvfs-send-command - v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64" + (tramp-gvfs-set-attribute + v (if (eq flag 'nofollow) "-nt" "-t") "uint64" (tramp-gvfs-url-file-name filename) "time::modified" (format-time-string "%s" (if (or (null time) @@ -1622,12 +1647,12 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) (when (natnump uid) - (tramp-gvfs-send-command - v "gvfs-set-attribute" "-t" "uint32" + (tramp-gvfs-set-attribute + v "-t" "uint32" (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid))) (when (natnump gid) - (tramp-gvfs-send-command - v "gvfs-set-attribute" "-t" "uint32" + (tramp-gvfs-set-attribute + v "-t" "uint32" (tramp-gvfs-url-file-name filename) "unix::gid" (number-to-string gid))))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 8638bb477f8..96f7d9a89b9 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -157,8 +157,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;;;###tramp-autoload (defun tramp-rclone-file-name-handler (operation &rest args) "Invoke the rclone handler for OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -215,9 +215,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -304,9 +302,7 @@ file names." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (with-parsed-tramp-file-name directory nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2274efdf8b5..bcdc014daba 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1094,7 +1094,8 @@ component is used as the target of the symlink." (unless ln (tramp-error v 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) + (concat "Making a symbolic link. " + "ln(1) does not exist on the remote host."))) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -1724,9 +1725,8 @@ ID-FORMAT valid values are `string' and `integer'." "Like `directory-files-and-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing + (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (expand-file-name directory)) (let* ((temp @@ -1877,8 +1877,9 @@ ID-FORMAT valid values are `string' and `integer'." ;; side. (unless (looking-at-p "^ok$") (tramp-error - v 'file-error "\ -tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" + v 'file-error + (concat "tramp-sh-handle-file-name-all-completions: " + "internal error accessing `%s': `%s'") (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) @@ -1944,9 +1945,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (t2 (tramp-tramp-file-p newname))) (with-parsed-tramp-file-name (if t1 dirname newname) nil (unless (file-exists-p dirname) - (tramp-error - v tramp-file-missing - "Copying directory" "No such file or directory" dirname)) + (tramp-compat-file-missing v dirname)) (if (and (not copy-contents) (tramp-get-method-parameter v 'tramp-copy-recursive) ;; When DIRNAME and NEWNAME are remote, they must have @@ -2032,12 +2031,12 @@ file names." (length (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes - (apply #'file-extended-attributes (list filename))))) + (apply #'file-extended-attributes (list filename)))) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -2045,9 +2044,7 @@ file names." (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter - v 0 (format "%s %s to %s" - (if (eq op 'copy) "Copying" "Renaming") - filename newname) + v 0 (format "%s %s to %s" msg-operation filename newname) (cond ;; Both are Tramp files. @@ -2536,7 +2533,7 @@ The method used must be an out-of-band method." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) ;; When PARENTS is non-nil, DIR could be a chain of non-existent ;; directories a/b/c/... Instead of checking, we simply flush the ;; whole cache. @@ -3278,9 +3275,7 @@ alternative implementation will be used." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let* ((size (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) @@ -3969,7 +3964,7 @@ Fall back to normal file name handler if no Tramp handler exists." "[[:blank:]]+\\([^[:blank:]]+\\)" "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") line) - (tramp-error proc 'file-notify-error "%s" line)) + (tramp-error proc 'file-notify-error line)) (let ((object (list diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c5a74a5c653..26ec910ecc8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -342,8 +342,8 @@ This can be used to disable echo etc." ;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) "Invoke the SMB related OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -430,9 +430,7 @@ pass to the OPERATION." (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (unless (file-exists-p dirname) - (tramp-error - v tramp-file-missing - "Copying directory" "No such file or directory" dirname)) + (tramp-compat-file-missing v dirname)) (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-already-exists newname)) @@ -588,11 +586,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (copy-directory filename newname keep-date 'parents 'copy-contents) (unless (file-exists-p filename) - (tramp-error + (tramp-compat-file-missing (tramp-dissect-file-name (if (tramp-tramp-file-p filename) filename newname)) - tramp-file-missing - "Copying file" "No such file or directory" filename)) + filename)) (if-let ((tmpfile (file-local-copy filename))) ;; Remote filename. @@ -693,9 +690,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (let ((result (mapcar #'directory-file-name (file-name-all-completions "" directory)))) ;; Discriminate with regexp. @@ -962,9 +957,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name (file-truename filename) nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) @@ -1153,12 +1146,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; of `default-directory'. (let ((start (point))) (insert - (format - "%s" - (file-relative-name - (expand-file-name - (nth 0 x) (file-name-directory filename)) - (when full-directory-p (file-name-directory filename))))) + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename)) + (when full-directory-p (file-name-directory filename)))) (put-text-property start (point) 'dired-filename t)) ;; Insert symlink. @@ -1177,7 +1168,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq dir (expand-file-name dir default-directory))) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (let* ((ldir (file-name-directory dir))) ;; Make missing directory parts. (when (and parents @@ -1386,9 +1377,7 @@ component is used as the target of the symlink." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Renaming file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -2010,10 +1999,8 @@ If ARGUMENT is non-nil, use it as argument for (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) - (while options - (setq args - (append args `("--option" ,(format "%s" (car options)))) - options (cdr options))) + (dolist (option options) + (setq args (append args (list "--option" option)))) (when argument (setq args (append args (list argument)))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 5bb1546d08b..0a60b791822 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -153,8 +153,8 @@ See `tramp-actions-before-shell' for more info.") ;;;###tramp-autoload (defun tramp-sudoedit-file-name-handler (operation &rest args) "Invoke the SUDOEDIT handler for OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -243,9 +243,7 @@ absolute file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7b34a748822..690dd99ae55 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2001,7 +2001,7 @@ the resulting error message." (unless (eq error-symbol 'void-variable) (tramp-error (car tramp-current-connection) error-symbol - "%s" (mapconcat (lambda (x) (format "%s" x)) data " ")))) + (mapconcat (lambda (x) (format "%s" x)) data " ")))) (put #'tramp-signal-hook-function 'tramp-suppress-trace t) @@ -3058,9 +3058,9 @@ User is always nil." (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (unless (file-readable-p (file-truename filename)) - (tramp-error - (tramp-dissect-file-name filename) tramp-file-missing - "%s: No such file or directory %s" string filename))) + (tramp-compat-file-missing + (tramp-dissect-file-name filename) + (format "%s: %s" string filename)))) (defun tramp-handle-add-name-to-file (filename newname &optional ok-if-already-exists) @@ -3094,9 +3094,7 @@ User is always nil." ;; `copy-directory' creates NEWNAME before running this check. So ;; we do it ourselves. (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) ;; We must do it file-wise. (tramp-run-real-handler 'copy-directory @@ -3117,9 +3115,7 @@ User is always nil." (defun tramp-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) @@ -3216,9 +3212,7 @@ User is always nil." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) @@ -3428,8 +3422,10 @@ User is always nil." (if (stringp symlink-target) (if (file-remote-p symlink-target) (tramp-compat-file-name-quote symlink-target 'top) - (expand-file-name - symlink-target (file-name-directory v2-localname))) + (tramp-drop-volume-letter + (expand-file-name + symlink-target + (file-name-directory v2-localname)))) v2-localname) 'nohop))) (when (>= numchase numchase-limit) @@ -3511,9 +3507,7 @@ User is always nil." (with-parsed-tramp-file-name filename nil (unwind-protect (if (not (file-exists-p filename)) - (tramp-error - v tramp-file-missing - "File `%s' not found on remote host" filename) + (tramp-compat-file-missing v filename) (with-tramp-progress-reporter v 3 (format-message "Inserting `%s'" filename) @@ -3636,8 +3630,7 @@ User is always nil." v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) (unless (or noerror (file-exists-p file)) - (tramp-error - v tramp-file-missing "Cannot load nonexistent file `%s'" file)) + (tramp-compat-file-missing v file)) (if (not (file-exists-p file)) nil (let ((signal-hook-function (unless noerror signal-hook-function)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 19a40fdf06c..f4883923f6a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5739,6 +5739,11 @@ This does not support globbing characters in file names (yet)." (string-match-p "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-gdrive-p () + "Check, whether the gdrive method is used." + (string-equal + "gdrive" (file-remote-p tramp-test-temporary-file-directory 'method))) + (defun tramp--test-gvfs-p (&optional method) "Check, whether the remote host runs a GVFS based method. This requires restrictions of file name syntax. @@ -5769,11 +5774,6 @@ This does not support external Emacs calls." (string-equal "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) -(defun tramp--test-nextcloud-p () - "Check, whether the nextcloud method is used." - (string-equal - "nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method))) - (defun tramp--test-rclone-p () "Check, whether the remote host is offered by rclone. This requires restrictions of file name syntax." @@ -6144,7 +6144,6 @@ Use the `ls' command." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) - (skip-unless (not (tramp--test-windows-nt-and-batch-p))) (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p)))) @@ -6214,6 +6213,7 @@ Use the `ls' command." (skip-unless (not (tramp--test-windows-nt-and-batch-p))) (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) (skip-unless (not (tramp--test-ksh-p))) + (skip-unless (not (tramp--test-gdrive-p))) (skip-unless (not (tramp--test-crypt-p))) (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p)))) @@ -6747,8 +6747,6 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. -;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' -;; do not work properly for `nextcloud'. ;; * Implement `tramp-test31-interrupt-process' for `adb' and for ;; direct async processes. ;; * Fix `tramp-test44-threads'. -- 2.39.5