From 88329d4dcc152718419c3d8f86634664a741ccea Mon Sep 17 00:00:00 2001 From: Allen Li Date: Thu, 19 Jul 2018 18:42:09 -0700 Subject: [PATCH] Avoid extra slash on TRAMP root path truenames * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename): Also elide extra slash if result path is a root path. --- lisp/net/tramp-sh.el | 219 ++++++++++++++++++++++--------------------- 1 file changed, 111 insertions(+), 108 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 212be4f36a..f711fcf1b9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1118,115 +1118,118 @@ tramp-sh-handle-make-symbolic-link (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (format - "%s%s" - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-make-tramp-file-name - method user domain host port - (with-tramp-file-property v localname "file-truename" - (let ((result nil) ; result steps in reverse order - (quoted (tramp-compat-file-name-quoted-p localname)) - (localname (tramp-compat-file-name-unquote localname))) - (tramp-message v 4 "Finding true name for `%s'" filename) - (cond - ;; Use GNU readlink --canonicalize-missing where available. - ((tramp-get-remote-readlink v) - (tramp-send-command-and-check - v - (format "%s --canonicalize-missing %s" - (tramp-get-remote-readlink v) - (tramp-shell-quote-argument localname))) - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (setq result (buffer-substring (point-min) (point-at-eol))))) - - ;; Use Perl implementation. - ((and (tramp-get-remote-perl v) - (tramp-get-connection-property v "perl-file-spec" nil) - (tramp-get-connection-property v "perl-cwd-realpath" nil)) - (tramp-maybe-send-script - v tramp-perl-file-truename "tramp_perl_file_truename") - (setq result - (tramp-send-command-and-read - v - (format "tramp_perl_file_truename %s" - (tramp-shell-quote-argument localname))))) - - ;; Do it yourself. - (t (let ((steps (split-string localname "/" 'omit)) - (thisstep nil) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in a - ;; timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) - (while (and steps (< numchase numchase-limit)) - (setq thisstep (pop steps)) - (tramp-message - v 5 "Check %s" - (mapconcat 'identity - (append '("") (reverse result) (list thisstep)) + (let ((result + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-make-tramp-file-name + method user domain host port + (with-tramp-file-property v localname "file-truename" + (let ((result nil) ; result steps in reverse order + (quoted (tramp-compat-file-name-quoted-p localname)) + (localname (tramp-compat-file-name-unquote localname))) + (tramp-message v 4 "Finding true name for `%s'" filename) + (cond + ;; Use GNU readlink --canonicalize-missing where available. + ((tramp-get-remote-readlink v) + (tramp-send-command-and-check + v + (format "%s --canonicalize-missing %s" + (tramp-get-remote-readlink v) + (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (setq result (buffer-substring (point-min) (point-at-eol))))) + + ;; Use Perl implementation. + ((and (tramp-get-remote-perl v) + (tramp-get-connection-property v "perl-file-spec" nil) + (tramp-get-connection-property v "perl-cwd-realpath" nil)) + (tramp-maybe-send-script + v tramp-perl-file-truename "tramp_perl_file_truename") + (setq result + (tramp-send-command-and-read + v + (format "tramp_perl_file_truename %s" + (tramp-shell-quote-argument localname))))) + + ;; Do it yourself. + (t (let ((steps (split-string localname "/" 'omit)) + (thisstep nil) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; + ;; otherwise they might think that Emacs is hung. + ;; Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) + (while (and steps (< numchase numchase-limit)) + (setq thisstep (pop steps)) + (tramp-message + v 5 "Check %s" + (mapconcat 'identity + (append '("") (reverse result) (list thisstep)) + "/")) + (setq symlink-target + (tramp-compat-file-attribute-type + (file-attributes + (tramp-make-tramp-file-name + method user domain host port + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) + (cond ((string= "." thisstep) + (tramp-message v 5 "Ignoring step `.'")) + ((string= ".." thisstep) + (tramp-message v 5 "Processing step `..'") + (pop result)) + ((stringp symlink-target) + ;; It's a symlink, follow it. + (tramp-message + v 5 "Follow symlink to %s" symlink-target) + (setq numchase (1+ numchase)) + (when (file-name-absolute-p symlink-target) + (setq result nil)) + (setq steps + (append + (split-string symlink-target "/" 'omit) steps))) + (t + ;; It's a file. + (setq result (cons thisstep result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit)) + (setq result (reverse result)) + ;; Combine list to form string. + (setq result + (if result + (mapconcat 'identity (cons "" result) "/") "/")) - (setq symlink-target - (tramp-compat-file-attribute-type - (file-attributes - (tramp-make-tramp-file-name - method user domain host port - (mapconcat 'identity - (append '("") - (reverse result) - (list thisstep)) - "/"))))) - (cond ((string= "." thisstep) - (tramp-message v 5 "Ignoring step `.'")) - ((string= ".." thisstep) - (tramp-message v 5 "Processing step `..'") - (pop result)) - ((stringp symlink-target) - ;; It's a symlink, follow it. - (tramp-message - v 5 "Follow symlink to %s" symlink-target) - (setq numchase (1+ numchase)) - (when (file-name-absolute-p symlink-target) - (setq result nil)) - (setq steps - (append - (split-string symlink-target "/" 'omit) steps))) - (t - ;; It's a file. - (setq result (cons thisstep result))))) - (when (>= numchase numchase-limit) - (tramp-error - v 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit)) - (setq result (reverse result)) - ;; Combine list to form string. - (setq result - (if result - (mapconcat 'identity (cons "" result) "/") - "/")) - (when (string= "" result) - (setq result "/"))))) - - ;; Detect cycle. - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename)) - ;; If the resulting localname looks remote, we must quote it - ;; for security reasons. - (when (or quoted (file-remote-p result)) - (let (file-name-handler-alist) - (setq result (tramp-compat-file-name-quote result)))) - (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result)))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + (when (string= "" result) + (setq result "/"))))) + + ;; Detect cycle. + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename)) + ;; If the resulting localname looks remote, we must quote it + ;; for security reasons. + (when (or quoted (file-remote-p result)) + (let (file-name-handler-alist) + (setq result (tramp-compat-file-name-quote result)))) + (tramp-message v 4 "True name of `%s' is `%s'" localname result) + result)))))) + (format + "%s%s" + result + + ;; Preserve trailing "/". + (if (and (string-equal (file-name-nondirectory filename) "") + (not (string-equal (file-name-nondirectory result) ""))) "/" "")))) ;; Basic functions. -- 2.18.0.233.g985f88cf7e-goog