[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3e4d4f472d: Rework `abbreviate-file-name' in Tramp
|
From: |
Michael Albinus |
|
Subject: |
master 3e4d4f472d: Rework `abbreviate-file-name' in Tramp |
|
Date: |
Mon, 7 Mar 2022 07:42:43 -0500 (EST) |
branch: master
commit 3e4d4f472d3960a7d18dad76b8d54a66bc5d9f6c
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Rework `abbreviate-file-name' in Tramp
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist):
Add 'tramp-get-home-directory'.
* lisp/net/tramp-compat.el (tramp-file-name-handler): Declare.
(tramp-compat-exec-path): Use it.
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
Add 'tramp-get-home-directory'.
(tramp-gvfs-handle-expand-file-name): Rewrite tilde handling.
(tramp-gvfs-handle-get-home-directory): New defun.
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
Add 'tramp-get-home-directory'.
(tramp-sh-handle-get-home-directory): New defun.
(tramp-sh-handle-expand-file-name): Rewrite tilde handling.
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
Add 'tramp-get-home-directory'.
(tramp-smb-handle-expand-file-name): Rewrite tilde handling.
(tramp-smb-handle-get-home-directory): New defun.
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add 'tramp-get-home-directory'.
(tramp-sudoedit-handle-expand-file-name): Rewrite tilde handling.
(tramp-sudoedit-handle-get-home-directory): New defun.
* lisp/net/tramp.el (tramp-file-name-for-operation):
Add `tramp-get-home-directory'.
(tramp-get-home-directory): New defun.
(tramp-handle-abbreviate-file-name): Use it.
(tramp-set-file-uid-gid, tramp-get-remote-uid)
(tramp-get-remote-gid): Use `tramp-file-name-handler'.
(tramp-get-remote-null-device): Do not check for null VEC, it
doesn't happen anymore.
* test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-relative):
Reorder checks.
(tramp-test07-abbreviate-file-name):
(tramp--test-ange-ftp-p): Adapt tests.
---
lisp/net/tramp-adb.el | 1 +
lisp/net/tramp-archive.el | 1 +
lisp/net/tramp-compat.el | 5 ++--
lisp/net/tramp-crypt.el | 1 +
lisp/net/tramp-gvfs.el | 32 ++++++++++++++++----------
lisp/net/tramp-integration.el | 2 +-
lisp/net/tramp-rclone.el | 1 +
lisp/net/tramp-sh.el | 47 +++++++++++++++++++++++---------------
lisp/net/tramp-smb.el | 41 ++++++++++++++++++++++-----------
lisp/net/tramp-sshfs.el | 1 +
lisp/net/tramp-sudoedit.el | 32 ++++++++++++++++++--------
lisp/net/tramp.el | 53 +++++++++++++++++++++++--------------------
test/lisp/net/tramp-tests.el | 19 +++++++++-------
13 files changed, 148 insertions(+), 88 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index a61179958c..ce90943d9a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -179,6 +179,7 @@ It is used for TCP/IP devices."
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index c6523003b8..788e457367 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -287,6 +287,7 @@ It must be supported by libarchive(3).")
(start-file-process . tramp-archive-handle-not-implemented)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index db7e7d67c4..bd6d53afcb 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -37,6 +37,7 @@
(require 'subr-x)
(declare-function tramp-error "tramp")
+(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
@@ -133,8 +134,8 @@ NAME is unquoted."
#'exec-path
(lambda ()
"List of directories to search programs to run in remote subprocesses."
- (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
- (funcall handler 'exec-path)
+ (if (tramp-tramp-file-p default-directory)
+ (tramp-file-name-handler 'exec-path)
exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 47c707451e..fb3ba08bb1 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -229,6 +229,7 @@ If NAME doesn't belong to a crypted remote directory, retun
nil."
(start-file-process . ignore)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-home-directory' performed by default-handler.
;; `tramp-get-remote-gid' performed by default handler.
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 23290de685..acded25292 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -816,6 +816,7 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory)
(tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
@@ -1139,18 +1140,14 @@ file names."
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
;; If there is a default location, expand tilde.
- (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
- (save-match-data
- (tramp-gvfs-maybe-open-connection
- (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port :localname "/" :hop hop)))
- (unless (string-empty-p
- (tramp-get-connection-property v "default-location" ""))
- (setq localname
- (replace-match
- (tramp-get-connection-property v "default-location" "~")
- nil t localname 1))))
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
@@ -1601,6 +1598,17 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
nil
time)))))
+(defun tramp-gvfs-handle-get-home-directory (vec &optional _user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((localname
+ (tramp-get-connection-property vec "default-location" nil)))
+ (if (zerop (length localname))
+ (tramp-get-connection-property (tramp-get-process vec) "share" nil)
+ localname)))
+
(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 03a2c2457a..3b2e7c0f91 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -271,7 +271,7 @@ NAME must be equal to `tramp-current-connection'."
#'tramp-compile-disable-ssh-controlmaster-options)
(add-hook 'tramp-integration-unload-hook
(lambda ()
- (remove-hook 'compilation-start-hook
+ (remove-hook 'compilation-mode-hook
#'tramp-compile-disable-ssh-controlmaster-options))))
;;; Default connection-local variables for Tramp.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 32ec19bf23..126b09fcbf 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -143,6 +143,7 @@
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5f72b5c032..c80190a67f 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1025,6 +1025,7 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sh-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sh-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
@@ -1449,6 +1450,20 @@ of."
(if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (when (tramp-send-command-and-check
+ vec (format
+ "echo %s"
+ (tramp-shell-quote-argument
+ (concat "~" (or user (tramp-file-name-user vec))))))
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))))
+
(defun tramp-sh-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
@@ -2741,27 +2756,21 @@ the result will be a local, non-Tramp, file name."
;; groks tilde expansion! The function `tramp-find-shell' is
;; supposed to find such a shell on the remote host. Please
;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
(let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
+ (fname (match-string 2 localname))
+ hname)
;; We cannot simply apply "~/", because under sudo "~/" is
;; expanded to the local user home directory but to the
;; root home directory. On the other hand, using always
;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
- (when (and (string-equal uname "~")
+ (when (and (zerop (length uname))
(string-match-p "\\`su\\(do\\)?\\'" method))
- (setq uname (concat uname user)))
- (setq uname
- (with-tramp-connection-property v uname
- (tramp-send-command
- v
- (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))))
- (setq localname (concat uname fname))))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
(while (string-match "//" localname)
@@ -2769,15 +2778,17 @@ the result will be a local, non-Tramp, file name."
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
;; `default-directory' is bound, because on Windows there
;; would be problems with UNC shares or Cygwin mounts.
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
- v (tramp-drop-volume-letter
- (tramp-run-real-handler
- #'expand-file-name (list localname)))))))))
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))))))
;;; Remote commands:
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f52fa0a93b..67c63e6ce7 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -294,6 +294,7 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-smb-handle-get-home-directory)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
@@ -745,25 +746,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-run-real-handler #'expand-file-name (list name nil))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We use the user name as share,
- ;; which is often the case in domains.
- (when (string-match "\\`/?~\\([^/]*\\)" localname)
- (setq localname
- (replace-match
- (if (zerop (length (match-string 1 localname)))
- user
- (match-string 1 localname))
- nil nil localname)))
- ;; Make the file name absolute.
+ ;; Tilde expansion if necessary.
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Tilde expansion is not possible.
+ (when (and (not tramp-tolerate-tilde)
+ (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do not keep "/..".
(when (string-match-p "^/\\.\\.?$" localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (tramp-run-real-handler #'expand-file-name (list localname))))))
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-run-real-handler #'expand-file-name (list localname)))))))
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
@@ -1589,6 +1595,15 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
(tramp-run-real-handler #'substitute-in-file-name (list filename))
(error filename))))
+(defun tramp-smb-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((user (or user (tramp-file-name-user vec))))
+ (unless (zerop (length user))
+ (concat "/" user))))
+
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 90b3c2ba2c..2f9d8a0681 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -145,6 +145,7 @@
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index a35f9391a1..242a6c7f58 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -137,6 +137,7 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
@@ -369,17 +370,23 @@ the result will be a local, non-Tramp, file name."
(setq localname "~"))
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname)
(let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- (when (string-equal uname "~")
- (setq uname (concat uname user)))
- (setq localname (concat uname fname))))
- ;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
- (setq localname "/"))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name v (expand-file-name localname))))
+ (tramp-make-tramp-file-name
+ v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
@@ -699,6 +706,13 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
+(defun tramp-sudoedit-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (expand-file-name (concat "~" (or user (tramp-file-name-user vec)))))
+
(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 932dfb3691..5bf6a54020 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2603,7 +2603,9 @@ Must be handled by the callers."
(when (processp (nth 0 args))
(tramp-get-default-directory (process-buffer (nth 0 args)))))
;; VEC.
- ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ ((member operation
+ '(tramp-get-home-directory
+ tramp-get-remote-gid tramp-get-remote-uid))
(tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
@@ -3360,15 +3362,16 @@ Let-bind it when necessary.")
(tramp-tolerate-tilde t)
(home-dir
(if (let ((non-essential t)) (tramp-connectable-p vec))
- ;; If a connection has already been established, make
- ;; sure the "home-directory" connection property is
- ;; properly set.
- (with-tramp-connection-property vec "home-directory"
- (tramp-compat-funcall
- 'directory-abbrev-apply
- (expand-file-name (tramp-make-tramp-file-name vec "~"))))
+ ;; If a connection has already been established, get the
+ ;; home directory.
+ (tramp-get-home-directory vec)
;; Otherwise, just use the cached value.
- (tramp-get-connection-property vec "home-directory" nil))))
+ (tramp-get-connection-property vec "~" nil))))
+ (when home-dir
+ (setq home-dir
+ (tramp-compat-funcall
+ 'directory-abbrev-apply
+ (tramp-make-tramp-file-name vec home-dir))))
;; If any elt of `directory-abbrev-alist' matches this name,
;; abbreviate accordingly.
(setq filename (tramp-compat-funcall 'directory-abbrev-apply filename))
@@ -5366,8 +5369,8 @@ If FILENAME is remote, a file name handler is called."
(when (and modes (not (zerop (logand modes #o2000))))
(setq gid (file-attribute-group-id (file-attributes dir)))))
- (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ (if (tramp-tramp-file-p filename)
+ (tramp-file-name-handler #'tramp-set-file-uid-gid filename uid gid)
;; On W32 systems, "chown" does not work.
(unless (memq system-type '(ms-dos windows-nt))
(let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
@@ -5468,15 +5471,19 @@ be granted."
(equal remote-gid (file-attribute-group-id file-attr))
(equal unknown-id (file-attribute-group-id
file-attr))))))))))))
+(defun tramp-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (with-tramp-connection-property vec (concat "~" user)
+ (tramp-file-name-handler #'tramp-get-home-directory vec user)))
+
(defun tramp-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
(with-tramp-connection-property vec (format "uid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
- (funcall handler #'tramp-get-remote-uid vec id-format))
+ (or (tramp-file-name-handler #'tramp-get-remote-uid vec id-format)
;; Ensure there is a valid result.
(and (equal id-format 'integer) tramp-unknown-id-integer)
(and (equal id-format 'string) tramp-unknown-id-string))))
@@ -5485,11 +5492,7 @@ ID-FORMAT valid values are `string' and `integer'."
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
(with-tramp-connection-property vec (format "gid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid)))
- (funcall handler #'tramp-get-remote-gid vec id-format))
+ (or (tramp-file-name-handler #'tramp-get-remote-gid vec id-format)
;; Ensure there is a valid result.
(and (equal id-format 'integer) tramp-unknown-id-integer)
(and (equal id-format 'string) tramp-unknown-id-string))))
@@ -5755,8 +5758,8 @@ Consults the auth-source package."
;; adapt `default-directory'. (Bug#39389, Bug#39489)
(default-directory tramp-compat-temporary-file-directory)
(case-fold-search t)
- ;; In tramp-sh.el, we must use "password-vector" due to
- ;; multi-hop.
+ ;; In tramp-sh.el, we must use "password-vector" due to
+ ;; multi-hop.
(vec (tramp-get-connection-property
proc "password-vector" (process-get proc 'vector)))
(key (tramp-make-tramp-file-name vec 'noloc))
@@ -5941,8 +5944,8 @@ name of a process or buffer, or nil to default to the
current buffer."
(defun tramp-get-remote-null-device (vec)
"Return null device on the remote host identified by VEC.
-If VEC is nil or `tramp-null-hop', return local null device."
- (if (or (null vec) (equal vec tramp-null-hop))
+If VEC is `tramp-null-hop', return local null device."
+ (if (equal vec tramp-null-hop)
null-device
(with-tramp-connection-property vec "null-device"
(let ((default-directory (tramp-make-tramp-file-name vec)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index c468c3501b..22c7fc6b2f 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2122,10 +2122,10 @@ Also see `ignore'."
(ert-deftest tramp-test05-expand-file-name-relative ()
"Check `expand-file-name'."
(skip-unless (tramp--test-enabled))
- ;; The bugs are fixed in Emacs 28.1.
- (skip-unless (tramp--test-emacs28-p))
;; Methods with a share do not expand "/path/..".
(skip-unless (not (tramp--test-share-p)))
+ ;; The bugs are fixed in Emacs 28.1.
+ (skip-unless (tramp--test-emacs28-p))
(should
(string-equal
@@ -2226,9 +2226,12 @@ This checks also `file-name-as-directory',
`file-name-directory',
(ert-deftest tramp-test07-abbreviate-file-name ()
"Check that Tramp abbreviates file names correctly."
(skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-emacs29-p))
(skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; `abbreviate-file-name' is supported since Emacs 29.1.
+ (skip-unless (tramp--test-emacs29-p))
+ ;; We must refill the cache. `file-truename' does it.
+ (file-truename tramp-test-temporary-file-directory)
(let* ((remote-host (file-remote-p tramp-test-temporary-file-directory))
(remote-host-nohop
(tramp-make-tramp-file-name (tramp-dissect-file-name remote-host)))
@@ -2261,12 +2264,12 @@ This checks also `file-name-as-directory',
`file-name-directory',
(setq home-dir (concat remote-host "/")
home-dir-nohop
(tramp-make-tramp-file-name (tramp-dissect-file-name home-dir)))
- ;; The remote home directory is kept in the connection property
- ;; "home-directory". We fake this setting.
- (tramp-set-connection-property tramp-test-vec "home-directory" home-dir)
+ ;; The remote home directory is kept in the connection property "~".
+ ;; We fake this setting.
+ (tramp-set-connection-property tramp-test-vec "~" (file-local-name
home-dir))
(should (equal (abbreviate-file-name (concat home-dir "foo/bar"))
(concat home-dir-nohop "foo/bar")))
- (tramp-flush-connection-property tramp-test-vec "home-directory")))
+ (tramp-flush-connection-property tramp-test-vec "~")))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
@@ -6195,7 +6198,7 @@ This requires restrictions of file name syntax."
(defun tramp--test-ange-ftp-p ()
"Check, whether Ange-FTP is used."
(eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ (tramp-find-foreign-file-name-handler tramp-test-vec)
'tramp-ftp-file-name-handler))
(defun tramp--test-asynchronous-processes-p ()
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3e4d4f472d: Rework `abbreviate-file-name' in Tramp,
Michael Albinus <=