(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)
(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)
(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)
#'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.
(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)
(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)
;; 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))
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'."
#'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.
(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)
(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)
(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'."
;; 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)
;; 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:
(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)
(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."
(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."
(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)
(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)
(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."
(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'."
(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))))
(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))
(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)))
(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))))
"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))))
;; 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))
(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)))
(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
(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)))
(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'."
(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 ()
projects / emacs.git / commitdiff