all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename
@ 2018-07-20  1:44 Allen Li
  2018-07-20  9:14 ` Michael Albinus
  0 siblings, 1 reply; 4+ messages in thread
From: Allen Li @ 2018-07-20  1:44 UTC (permalink / raw)
  To: 32218

[-- Attachment #1: Type: text/plain, Size: 1871 bytes --]

1. emacs -q
2. M-: (setq find-file-visit-truename t) RET
3. C-x C-f /sudo::/ RET
4. M-: default-directory RET

Expected value: /sudo::/
Actual: /sudo:://

The actual usability problem that this causes is that running find-file
again in the Dired buffer starts with a bad default:

Typing C-x C-f tmp RET results in finding /sudo:://tmp which is /tmp
rather than /sudo::/tmp

The immediate offending code is these lines in find-file-noselect

(if find-file-visit-truename
    (abbreviate-file-name (file-truename filename))
  filename)))

Tracing the bug:

(file-truename "/sudo::/")
(tramp-file-name-handler 'file-truename "/sudo::/")
(tramp-sh-file-name-handler 'file-truename "/sudo::/")
(tramp-sh-handle-file-truename "/sudo::/")

tramp-sh-handle-file-truename is (format "%s%s" A B), where A does most
of the work and B just adds an extra final slash conditionally:

   (if (string-equal (file-name-nondirectory filename) "") "/" "")))

I think this could be fixed by making it:

(let ((result A))
  (format "%s%s" result
                 (if (and (string-equal (file-name-nondirectory filename) "")
                          (not (string-equal (file-name-nondirectory
result) ""))) "/" "")))

I have attached a patch implementing this, made against emacs-26 since
this is a straightforward bug fix.

In GNU Emacs 26.1 (build 1, x86_64-pc-linux-gnu, GTK+ Version
3.22.24), modified by Debian
Windowing system distributor 'The X.Org Foundation', version 11.0.11906000
System Description: Debian GNU/Linux rodete (upgraded from: Ubuntu 14.04 LTS)

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS GSETTINGS NOTIFY
LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF XFT ZLIB
TOOLKIT_SCROLL_BARS GTK3 X11 MODULES THREADS JSON LCMS2

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Dired by name

[-- Attachment #2: 0001-Avoid-extra-slash-on-TRAMP-root-path-truenames.patch --]
[-- Type: text/x-patch, Size: 9291 bytes --]

From 88329d4dcc152718419c3d8f86634664a741ccea Mon Sep 17 00:00:00 2001
From: Allen Li <ayatane@google.com>
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


^ permalink raw reply related	[flat|nested] 4+ messages in thread

* bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename
  2018-07-20  1:44 bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename Allen Li
@ 2018-07-20  9:14 ` Michael Albinus
  2018-07-21  2:42   ` Allen Li
  0 siblings, 1 reply; 4+ messages in thread
From: Michael Albinus @ 2018-07-20  9:14 UTC (permalink / raw)
  To: Allen Li; +Cc: 32218

Allen Li <darkfeline@felesatra.moe> writes:

Hi Allen,

> 1. emacs -q
> 2. M-: (setq find-file-visit-truename t) RET
> 3. C-x C-f /sudo::/ RET
> 4. M-: default-directory RET
>
> Expected value: /sudo::/
> Actual: /sudo:://

Thanks for reporting this.

> I have attached a patch implementing this, made against emacs-26 since
> this is a straightforward bug fix.

Thanks for this. However, also `tramp-handle-file-truename' and
`tramp-adb-handle-file-truename' suffer from this bug. It was fixed
already in the master branch some months ago.

I have cherry-picked that fix back to the emacs-26 branch, could you pls
recheck that it works for you?

Best regards, Michael.





^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename
  2018-07-20  9:14 ` Michael Albinus
@ 2018-07-21  2:42   ` Allen Li
  2018-07-21  6:57     ` Michael Albinus
  0 siblings, 1 reply; 4+ messages in thread
From: Allen Li @ 2018-07-21  2:42 UTC (permalink / raw)
  To: Michael Albinus; +Cc: 32218

Yes, it's fixed, thanks
On Fri, Jul 20, 2018 at 2:14 AM Michael Albinus <michael.albinus@gmx.de> wrote:
>
> Allen Li <darkfeline@felesatra.moe> writes:
>
> Hi Allen,
>
> > 1. emacs -q
> > 2. M-: (setq find-file-visit-truename t) RET
> > 3. C-x C-f /sudo::/ RET
> > 4. M-: default-directory RET
> >
> > Expected value: /sudo::/
> > Actual: /sudo:://
>
> Thanks for reporting this.
>
> > I have attached a patch implementing this, made against emacs-26 since
> > this is a straightforward bug fix.
>
> Thanks for this. However, also `tramp-handle-file-truename' and
> `tramp-adb-handle-file-truename' suffer from this bug. It was fixed
> already in the master branch some months ago.
>
> I have cherry-picked that fix back to the emacs-26 branch, could you pls
> recheck that it works for you?
>
> Best regards, Michael.





^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename
  2018-07-21  2:42   ` Allen Li
@ 2018-07-21  6:57     ` Michael Albinus
  0 siblings, 0 replies; 4+ messages in thread
From: Michael Albinus @ 2018-07-21  6:57 UTC (permalink / raw)
  To: Allen Li; +Cc: 32218-done

Version: 26.2

Allen Li <darkfeline@felesatra.moe> writes:

Hi Allen,

> Yes, it's fixed, thanks

Thanks for the feedback, I'm closing the bug.

Best regards, Michael.





^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2018-07-21  6:57 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-07-20  1:44 bug#32218: 26.1; default-directory in TRAMP root has two slashes when using find-file-visit-truename Allen Li
2018-07-20  9:14 ` Michael Albinus
2018-07-21  2:42   ` Allen Li
2018-07-21  6:57     ` Michael Albinus

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.