From: Michael Albinus Date: Sat, 10 Sep 2022 11:10:47 +0000 (+0200) Subject: Ensure, that Tramp cache works over absolute file names X-Git-Tag: emacs-29.0.90~1856^2~613 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b2956a3f094abba519ec5baaaa5e3c2236c61832;p=emacs.git Ensure, that Tramp cache works over absolute file names * lisp/net/tramp.el (tramp-skeleton-directory-files) (tramp-skeleton-directory-files-and-attributes) (tramp-skeleton-set-file-modes-times-uid-gid) (tramp-handle-add-name-to-file, tramp-handle-file-exists-p) (tramp-handle-file-readable-p, tramp-handle-file-writable-p): * lisp/net/tramp-adb.el (tramp-adb-handle-file-executable-p) (tramp-adb-handle-file-exists-p) (tramp-adb-handle-file-readable-p) (tramp-adb-handle-file-writable-p) * lisp/net/tramp-gvfs.el (tramp-gvfs-info, tramp-gvfs-handle-delete-file) (tramp-gvfs-get-directory-attributes) (tramp-gvfs-get-root-attributes) (tramp-gvfs-handle-file-executable-p): * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-file-exists-p) (tramp-sh-handle-set-visited-file-modtime) (tramp-sh-handle-file-selinux-context) (tramp-sh-handle-set-file-selinux-context) (tramp-sh-handle-file-acl, tramp-sh-handle-file-executable-p) (tramp-sh-handle-file-readable-p) (tramp-sh-handle-file-directory-p) (tramp-sh-handle-file-writable-p) (tramp-sh-handle-file-ownership-preserved-p) (tramp-sh-handle-add-name-to-file) (tramp-sh-handle-copy-directory, tramp-sh-handle-delete-file) (tramp-sh-handle-dired-compress-file): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-add-name-to-file) (tramp-sudoedit-handle-delete-file) (tramp-sudoedit-handle-file-acl) (tramp-sudoedit-handle-file-executable-p) (tramp-sudoedit-handle-file-exists-p) (tramp-sudoedit-handle-file-readable-p) (tramp-sudoedit-handle-file-selinux-context) (tramp-sudoedit-handle-file-writable-p) (tramp-sudoedit-handle-make-symbolic-link) (tramp-sudoedit-handle-set-file-selinux-context): Use `expand-file-name'. (Bug#57572) * lisp/net/tramp-cache.el (tramp-flush-file-function): Expand `buffer-file-name'. (Bug#57676) * lisp/net/tramp.el (tramp-file-name-unify): Extend error message. * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link): Do not check remoteness of TARGET anymore. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 9084e9d27a0..49cbf526ec3 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -491,7 +491,7 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-executable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -507,7 +507,7 @@ Emacs dired can't find files." ;; We don't want to run it when `non-essential' is t, or there is ;; no connection process yet. (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-exists-p" (if (tramp-file-property-p v localname "file-attributes") (not (null (tramp-get-file-property v localname "file-attributes"))) @@ -516,7 +516,7 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-readable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -527,7 +527,7 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) (if (tramp-file-property-p v localname "file-attributes") diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b9abcd38424..93bcdf4b973 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -285,7 +285,8 @@ This is suppressed for temporary buffers." (tramp-verbose 0)) (when (tramp-tramp-file-p bfn) (tramp-flush-file-properties - (tramp-dissect-file-name bfn) (tramp-file-local-name bfn))))))) + (tramp-dissect-file-name bfn) + (tramp-file-local-name (expand-file-name bfn)))))))) (add-hook 'before-revert-hook #'tramp-flush-file-function) (add-hook 'eshell-pre-command-hook #'tramp-flush-file-function) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 86055ea78f7..d556c876066 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -584,6 +584,7 @@ This function is invoked by `tramp-crypt-handle-copy-file' and `tramp-crypt-handle-rename-file'. It is an error if OP is neither of `copy' and `rename'. FILENAME and NEWNAME must be absolute file names." + ;; FILENAME and NEWNAME are already expanded. (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 24a7cb2e36b..cf23676b0c2 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -971,7 +971,7 @@ The global value will always be nil; it is bound where needed.") (defun tramp-gvfs-info (filename &optional arg) "Check FILENAME via `gvfs-info'. Set file property \"file-exists-p\" with the result." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-set-file-property v localname "file-exists-p" (tramp-gvfs-send-command @@ -994,6 +994,7 @@ This function is invoked by `tramp-gvfs-handle-copy-file' and `tramp-gvfs-handle-rename-file'. It is an error if OP is neither of `copy' and `rename'. FILENAME and NEWNAME must be absolute file names." + ;; FILENAME and NEWNAME are already expanded. (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) @@ -1137,7 +1138,7 @@ file names." (defun tramp-gvfs-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-flush-file-properties v localname) (if (and delete-by-moving-to-trash trash) (move-file-to-trash filename) @@ -1207,7 +1208,7 @@ file names." ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) result) - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "directory-attributes" (tramp-message v 5 "directory gvfs attributes: %s" localname) ;; Send command. @@ -1253,7 +1254,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) result) - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname (if file-system "file-system-attributes" "file-attributes") @@ -1412,7 +1413,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-executable-p" (or (tramp-check-cached-permissions v ?x) (tramp-check-cached-permissions v ?s))))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index b40755bc0ec..9e379da8c1e 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -211,6 +211,7 @@ This function is invoked by `tramp-rclone-handle-copy-file' and `tramp-rclone-handle-rename-file'. It is an error if OP is neither of `copy' and `rename'. FILENAME and NEWNAME must be absolute file names." + ;; FILENAME and NEWNAME are already expanded. (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f8d6c0e3638..1c26e25e57e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1136,66 +1136,63 @@ Operations not mentioned here will be handled by the normal Emacs functions.") If TARGET is a non-Tramp file, it is used verbatim as the target of the symlink. If TARGET is a Tramp file, only the localname component is used as the target of the symlink." - (if (not (tramp-tramp-file-p (expand-file-name linkname))) - (tramp-run-real-handler - #'make-symbolic-link (list target linkname ok-if-already-exists)) - - (with-parsed-tramp-file-name linkname nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target)))) - ;; There could be a cyclic link. - (tramp-flush-file-properties - v (expand-file-name target (tramp-file-local-name default-directory)))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - (let ((ln (tramp-get-remote-ln v)) - (cwd (tramp-run-real-handler - #'file-name-directory (list localname)))) - (unless ln - (tramp-error - v 'file-error - (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) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - - ;; Right, they are on the same host, regardless of user, - ;; method, etc. We now make the link on the remote - ;; machine. This will occur as the user that TARGET belongs to. - (and (tramp-send-command-and-check - v (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - v (format - "%s -sf %s %s" ln - (tramp-shell-quote-argument target) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file - ;; names could start with "-". - ;; `tramp-shell-quote-argument' does not handle - ;; this, we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory localname))))))))))) + (with-parsed-tramp-file-name (expand-file-name linkname) nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p v (tramp-dissect-file-name target))) + (setq target (tramp-file-local-name (expand-file-name target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name target (tramp-file-local-name default-directory)))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p target) + (make-symbolic-link + (tramp-compat-file-name-quote target 'top) + linkname ok-if-already-exists) + + (let ((ln (tramp-get-remote-ln v)) + (cwd (tramp-run-real-handler + #'file-name-directory (list localname)))) + (unless ln + (tramp-error + v 'file-error + (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) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not + (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (tramp-flush-file-properties v localname) + + ;; Right, they are on the same host, regardless of user, + ;; method, etc. We now make the link on the remote machine. + ;; This will occur as the user that TARGET belongs to. + (and (tramp-send-command-and-check + v (format "cd %s" (tramp-shell-quote-argument cwd))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" ln + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use + ;; relative file names. However, relative file names + ;; could start with "-". + ;; `tramp-shell-quote-argument' does not handle this, + ;; we must do it ourselves. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname)))))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." @@ -1259,7 +1256,7 @@ component is used as the target of the symlink." ;; We don't want to run it when `non-essential' is t, or there is ;; no connection process yet. (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-exists-p" (if (tramp-file-property-p v localname "file-attributes") (not (null (tramp-get-file-property v localname "file-attributes"))) @@ -1434,7 +1431,7 @@ component is used as the target of the symlink." (buffer-name))) (if time-list (tramp-run-real-handler #'set-visited-file-modtime (list time-list)) - (let ((f (buffer-file-name)) + (let ((f (expand-file-name (buffer-file-name))) coding-system-used) (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) @@ -1632,7 +1629,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-selinux-context (filename) "Like `file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) (regexp (tramp-compat-rx @@ -1656,7 +1653,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-set-file-selinux-context (filename context) "Like `set-file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (when (and (consp context) (tramp-remote-selinux-p v)) (let ((user (and (stringp (nth 0 context)) (nth 0 context))) @@ -1683,7 +1680,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-acl (filename) "Like `file-acl' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-acl" (when (and (tramp-remote-acl-p v) (tramp-send-command-and-check @@ -1720,7 +1717,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-executable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -1731,7 +1728,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-readable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -1743,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil ;; `file-directory-p' is used as predicate for file name completion. ;; Sometimes, when a connection is not established yet, it is ;; desirable to return t immediately for "/method:foo:". It can @@ -1762,7 +1759,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) (if (tramp-file-property-p v localname "file-attributes") @@ -1777,7 +1774,7 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group) "Like `file-ownership-preserved-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname (format "file-ownership-preserved-p%s" (if group "-group" "")) @@ -1914,8 +1911,8 @@ ID-FORMAT valid values are `string' and `integer'." v 'file-error "add-name-to-file: %s" "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 + (with-parsed-tramp-file-name (expand-file-name filename) v1 + (with-parsed-tramp-file-name (expand-file-name newname) v2 (let ((ln (when v1 (tramp-get-remote-ln v1)))) ;; Do the 'confirm if exists' thing. @@ -2011,7 +2008,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; When newname did exist, we have wrong cached values. (when t2 - (with-parsed-tramp-file-name newname nil + (with-parsed-tramp-file-name (expand-file-name newname) nil (tramp-flush-file-properties v localname))))))) (defun tramp-sh-handle-rename-file @@ -2047,6 +2044,7 @@ This function is invoked by `tramp-sh-handle-copy-file' and `tramp-sh-handle-rename-file'. It is an error if OP is neither of `copy' and `rename'. FILENAME and NEWNAME must be absolute file names." + ;; FILENAME and NEWNAME are already expanded. (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) @@ -2159,6 +2157,7 @@ file names." First arg OP is either `copy' or `rename' and indicates the operation. FILENAME is the source file, NEWNAME the target file. KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." + ;; FILENAME and NEWNAME are already expanded. ;; Check, whether file is too large. Emacs checks in `insert-file-1' ;; and `find-file-noselect', but that's not called here. (abort-if-file-too-large @@ -2201,6 +2200,7 @@ the file (for rename). Both files must reside on the same host. KEEP-DATE means to make sure that NEWNAME has the same timestamp as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid from FILENAME." + ;; FILENAME and NEWNAME are already expanded. (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (file-times (file-attribute-modification-time @@ -2349,6 +2349,7 @@ the uid and gid from FILENAME." (op filename newname ok-if-already-exists keep-date) "Invoke `scp' program to copy. The method used must be an out-of-band method." + ;; FILENAME and NEWNAME are already expanded. (let* ((v1 (and (tramp-tramp-file-p filename) (tramp-dissect-file-name filename))) (v2 (and (tramp-tramp-file-p newname) @@ -2584,7 +2585,7 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (setq filename (expand-file-name filename)) + (setq filename (expand-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (if (and delete-by-moving-to-trash trash) (move-file-to-trash filename) @@ -2602,7 +2603,7 @@ The method used must be an out-of-band method." (if (>= emacs-major-version 29) (tramp-run-real-handler #'dired-compress-file (list file)) ;; Code stolen mainly from dired-aux.el. - (with-parsed-tramp-file-name file nil + (with-parsed-tramp-file-name (expand-file-name file) nil (tramp-flush-file-properties v localname) (let ((suffixes dired-compress-file-suffixes) suffix) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5cdb8a9473b..11b3689df60 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1213,50 +1213,47 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." If TARGET is a non-Tramp file, it is used verbatim as the target of the symlink. If TARGET is a Tramp file, only the localname component is used as the target of the symlink." - (if (not (tramp-tramp-file-p (expand-file-name linkname))) - (tramp-run-real-handler - #'make-symbolic-link (list target linkname ok-if-already-exists)) - - (with-parsed-tramp-file-name linkname nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (unless (tramp-smb-get-cifs-capabilities v) - (tramp-error v 'file-error "make-symbolic-link not supported")) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) + (with-parsed-tramp-file-name linkname nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p v (tramp-dissect-file-name target))) + (setq target (tramp-file-local-name (expand-file-name target))))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p target) + (make-symbolic-link + (tramp-compat-file-name-quote target 'top) + linkname ok-if-already-exists) - (unless (tramp-smb-send-command - v (format "symlink %s %s" - (tramp-smb-shell-quote-argument target) - (tramp-smb-shell-quote-localname v))) - (tramp-error - v 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (tramp-get-connection-buffer v))))))) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported")) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + (unless (tramp-smb-send-command + v (format "symlink %s %s" + (tramp-smb-shell-quote-argument target) + (tramp-smb-shell-quote-localname v))) + (tramp-error + v 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (tramp-get-connection-buffer v)))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index cece7a664d2..f8b602e34ce 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -194,8 +194,8 @@ arguments to pass to the OPERATION." v 'file-error "add-name-to-file: %s" "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name newname v2 + (with-parsed-tramp-file-name (expand-file-name filename) v1 + (with-parsed-tramp-file-name (expand-file-name newname) v2 ;; Do the 'confirm if exists' thing. (when (file-exists-p newname) ;; What to do? @@ -235,6 +235,7 @@ This function is invoked by `tramp-sudoedit-handle-copy-file' and `tramp-sudoedit-handle-rename-file'. It is an error if OP is neither of `copy' and `rename'. FILENAME and NEWNAME must be absolute file names." + ;; FILENAME and NEWNAME are already expanded. (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) @@ -345,7 +346,7 @@ absolute file names." (defun tramp-sudoedit-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-flush-file-properties v localname) (if (and delete-by-moving-to-trash trash) (move-file-to-trash filename) @@ -403,7 +404,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-acl (filename) "Like `file-acl' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-acl" (let ((result (and (tramp-sudoedit-remote-acl-p v) (tramp-sudoedit-send-command-string @@ -440,7 +441,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-executable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -456,7 +457,7 @@ the result will be a local, non-Tramp, file name." ;; We don't want to run it when `non-essential' is t, or there is ;; no connection process yet. (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-exists-p" (if (tramp-file-property-p v localname "file-attributes") (not (null (tramp-get-file-property v localname "file-attributes"))) @@ -488,7 +489,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-readable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -515,7 +516,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-selinux-context (filename) "Like `file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) (regexp (tramp-compat-rx @@ -605,7 +606,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) (if (tramp-file-property-p v localname "file-attributes") @@ -642,41 +643,38 @@ the result will be a local, non-Tramp, file name." If TARGET is a non-Tramp file, it is used verbatim as the target of the symlink. If TARGET is a Tramp file, only the localname component is used as the target of the symlink." - (if (not (tramp-tramp-file-p (expand-file-name linkname))) - (tramp-run-real-handler - #'make-symbolic-link (list target linkname ok-if-already-exists)) - - (with-parsed-tramp-file-name linkname nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - (tramp-sudoedit-send-command - v "ln" "-sf" - (tramp-compat-file-name-unquote target) - (tramp-compat-file-name-unquote localname)))))) + (with-parsed-tramp-file-name (expand-file-name linkname) nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p v (tramp-dissect-file-name target))) + (setq target (tramp-file-local-name (expand-file-name target))))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p target) + (make-symbolic-link + (tramp-compat-file-name-quote target 'top) + linkname ok-if-already-exists) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not + (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (tramp-flush-file-properties v localname) + (tramp-sudoedit-send-command + v "ln" "-sf" + (tramp-compat-file-name-unquote target) + (tramp-compat-file-name-unquote localname))))) (defun tramp-sudoedit-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -706,7 +704,7 @@ component is used as the target of the symlink." (defun tramp-sudoedit-handle-set-file-selinux-context (filename context) "Like `set-file-selinux-context' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (when (and (consp context) (tramp-sudoedit-remote-selinux-p v)) (let ((user (and (stringp (nth 0 context)) (nth 0 context))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 652fafb67eb..15380ed94dd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1515,7 +1515,9 @@ same connection. Make a copy in order to avoid side effects." ;; doesn't happen for a while, it can be removed. (or (file-name-absolute-p localname) (tramp-error - vec 'file-error "File `%s' must be absolute" localname)) + vec 'file-error + "File `%s' must be absolute, please report a bug!" + localname)) (tramp-compat-file-name-unquote (directory-file-name localname))) (tramp-file-name-hop vec) nil)) vec) @@ -3434,7 +3436,7 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 5) (debug t)) `(or - (with-parsed-tramp-file-name ,directory nil + (with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory (when (file-directory-p ,directory) (setq ,directory @@ -3465,7 +3467,7 @@ BODY is the backend specific code." BODY is the backend specific code." (declare (indent 6) (debug t)) `(or - (with-parsed-tramp-file-name ,directory nil + (with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory (when (file-directory-p ,directory) (let ((temp @@ -3527,7 +3529,7 @@ BODY is the backend specific code." "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. BODY is the backend specific code." (declare (indent 1) (debug t)) - `(with-parsed-tramp-file-name ,filename nil + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil (when (not (file-exists-p ,filename)) (tramp-error v 'file-missing ,filename)) (with-tramp-saved-file-properties @@ -3708,7 +3710,7 @@ Let-bind it when necessary.") (filename newname &optional ok-if-already-exists) "Like `add-name-to-file' for Tramp files." (with-parsed-tramp-file-name - (if (tramp-tramp-file-p newname) newname filename) nil + (expand-file-name (if (tramp-tramp-file-p newname) newname filename)) nil (unless (tramp-equal-remote filename newname) (tramp-error v 'file-error @@ -3845,7 +3847,7 @@ Let-bind it when necessary.") ;; We don't want to run it when `non-essential' is t, or there is ;; no connection process yet. (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-exists-p" (not (null (file-attributes filename))))))) @@ -3993,7 +3995,7 @@ Let-bind it when necessary.") (defun tramp-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-readable-p" (or (tramp-check-cached-permissions v ?r) ;; `tramp-check-cached-permissions' doesn't handle symbolic @@ -4092,7 +4094,7 @@ Let-bind it when necessary.") (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) (tramp-check-cached-permissions v ?w)