bug#28156: Emacs quietly munges symlink contents

[Paul Eggert <eggert@cs.ucla.edu>]

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

Michael Albinus wrote:

> it is Tramp's (almost undocumented) make-symbolic-link
> implementation to handle TARGET as well, and to strip the remote part of
> this. I wouldn't be surprised if existing packages will be broken if we
> change this.

That should not be a problem with the proposed patch, as it does not affect how 
Tramp handles TARGET when making a remote symlink.

> --8<---------------cut here---------------start------------->8---
> M-x make-symbolic-link RET /:~eggert RET /tmp/foo RET
> 
> # ls -l /tmp/foo
> lrwxrwxrwx 1 albinus albinus 21 Aug 24 13:19 /tmp/foo -> /home/albinus/~eggert
> --8<---------------cut here---------------end--------------->8---
> 
> It is questionable whether "/:~eggert" shall be expanded to
> "/home/albinus/~eggert". I agree with you, that it shouldn't, the target
> shall be just  "~eggert".

Yes, adding support for /: for interactive use sounds reasonable. I updated the 
patch to do that; please see attached.

> For a TARGET which looks like a remote file name, I propose to keep the
> current behaviour (stripping the remote part).

That's fine if LINKNAME is also remote, since symlinks act locally. That is, if 
TARGET and LINKNAME are both remote to the same filesystem, Tramp can continue 
to munge TARGET so that it works on that filesystem. However, Tramp should not 
be in the business of specifying symlink behavior for local symbolic links. It 
should let the OS do that. If LINKNAME is local, TARGET should just act as 
itself without Tramp getting in the way.

> it is just proper file name quoting

The target of a local symbolic link is a string. It need not name a file, and 
often does not name a file. Trying to apply some file name rules to it, and not 
others, is confusing and leads to broken code. For backward compatibility we 
appear to need to handle leading ~ in interactive use and to provide an escape 
for leading ~, but let's not try to inflict these complex rules on code. For 
code, make-symbolic-link should just treat a local target as a string, the way 
the OS does.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Do-not-munge-contents-of-local-symbolic-links.patch --]
[-- Type: text/x-patch; name="0001-Do-not-munge-contents-of-local-symbolic-links.patch", Size: 10153 bytes --]

From 743ab11913b9caa979f9dca8ab2578d9e3de9022 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 24 Aug 2017 16:22:12 -0700
Subject: [PATCH] Do not munge contents of local symbolic links

This lets Emacs deal with arbitrary local symlinks without
mishandling their contents.  For example,
(progn (shell-command "ln -fs '~' 'x'") (rename-file "x" "/tmp/x"))
now consistently creates a symbolic link from '/tmp/x' to '~'.
Formerly, it did that only if the working directory was on the
same filesystem as /tmp; otherwise, it expanded the '~' to
the user's home directory.
* src/fileio.c (Fmake_symbolic_link): Do not expand leading "~" in the
target unless interactive.  Strip leading "/:" if interactive.
(emacs_readlinkat): Do not preprend "/:" to the link target if
it starts with "/" and contains ":" before NUL.
* test/lisp/net/tramp-tests.el (tramp-test21-file-links):
Adjust to new behavior.
* test/src/fileio-tests.el (try-link): Rename from try-char,
and accept a string instead of a char.  All uses changed.
(fileio-tests--symlink-failure): Also test leading ~, and "/:",
to test the new behavior.
---
 doc/emacs/files.texi         |  8 ++++++--
 doc/lispref/files.texi       | 11 +++++++----
 etc/NEWS                     | 24 ++++++++++++++++++++++++
 src/fileio.c                 | 28 +++++++++-------------------
 test/lisp/net/tramp-tests.el |  9 ++++++---
 test/src/fileio-tests.el     | 21 ++++++++++-----------
 6 files changed, 62 insertions(+), 39 deletions(-)

diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 9195bc4..fa1f9e5 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1611,8 +1611,12 @@ Copying and Naming
 @var{target} at the time the opening is done, or will get an error if
 the name @var{target} is nonexistent at that time.  This command does
 not expand the argument @var{target}, so that it allows you to specify
-a relative name as the target of the link.  On MS-Windows, this
-command works only on MS Windows Vista and later.  On remote systems,
+a relative name as the target of the link.  However, this command
+does expand leading @samp{~} in @var{target} so that you can easily
+specify home directories, and strips leading @samp{/:} so that you can
+specify relative names beginning with literal @samp{~} or @samp{/:}.
+@xref{Quoted File Names}.  On MS-Windows, this command works only on
+MS Windows Vista and later.  When @var{new} is remote,
 it works depending on the system type.
 
 @node Misc File Ops
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5a52765..054036d 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1719,14 +1719,17 @@ Changing Files
 SELinux context are not copied over in either case.
 @end deffn
 
-@deffn Command make-symbolic-link filename newname &optional ok-if-already-exists
+@deffn Command make-symbolic-link target newname &optional ok-if-already-exists
 @pindex ln
 @kindex file-already-exists
-This command makes a symbolic link to @var{filename}, named
+This command makes a symbolic link to @var{target}, named
 @var{newname}.  This is like the shell command @samp{ln -s
-@var{filename} @var{newname}}.  The @var{filename} argument
+@var{target} @var{newname}}.  The @var{target} argument
 is treated only as a string; it need not name an existing file.
-If @var{filename} is a relative file name, the resulting symbolic link
+If @var{ok-if-already-exists} is an integer, indicating interactive
+use, then leading @samp{~} is expanded and leading @samp{/:} is
+stripped in the @var{target} string.
+If @var{target} is a relative file name, the resulting symbolic link
 is interpreted relative to the directory containing the symbolic link.
 @xref{Relative File Names}.
 
diff --git a/etc/NEWS b/etc/NEWS
index bf59749..60ddf54 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1228,6 +1228,30 @@ instead of to utf-8.  Before this change, Emacs would sometimes
 mishandle file names containing these control characters.
 
 +++
+** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no
+longer quietly mutate the target of a local symbolic link, so that
+Emacs can access and copy them reliably regardless of their contents.
+The following changes are involved.
+
+*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to
+symbolic links whose targets begin with "/" and contain ":".  For
+example, if a symbolic link "x" has a target "/y:z", (file-symlink-p
+"x") now returns "/y:z" rather than "/:/y:z".
+
+*** 'make-symbolic-link' no longer looks for file name handlers when
+creating a local symbolic link.  For example, (make-symbolic-link
+"/y:z" "x") now creates a symlink to "/y:z" instead of failing.
+
+*** 'make-symbolic-link' now expands a link target with leading "~"
+only when the optional third arg is an integer, as when invoked
+interactively.  For example, (make-symbolic-link "~y" "x") now creates
+a link with target the literal string "~y"; to get the old behavior,
+use (make-symbolic-link (expand-file-name "~y") "x").  To avoid this
+expansion in interactive use, you can now prefix the link target with
+"/:".  For example, (make-symbolic-link "/:~y" "x" 1) now creates a
+link to literal "~y".
+
++++
 ** Module functions are now implemented slightly differently; in
 particular, the function 'internal--module-call' has been removed.
 Code that depends on undocumented internals of the module system might
diff --git a/src/fileio.c b/src/fileio.c
index ca1bc50..1e4ccd4 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2415,7 +2415,8 @@ DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
 Both args must be strings.
 Signal a `file-already-exists' error if a file LINKNAME already exists
 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
-An integer third arg means request confirmation if LINKNAME already exists.
+An integer third arg means request confirmation if LINKNAME already
+exists, and expand leading "~" or strip leading "/:" in TARGET.
 This happens for interactive use with M-x.  */)
   (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
 {
@@ -2423,21 +2424,15 @@ This happens for interactive use with M-x.  */)
   Lisp_Object encoded_target, encoded_linkname;
 
   CHECK_STRING (target);
-  /* If the link target has a ~, we must expand it to get
-     a truly valid file name.  Otherwise, do not expand;
-     we want to permit links to relative file names.  */
-  if (SREF (target, 0) == '~')
-    target = Fexpand_file_name (target, Qnil);
-
+  if (INTEGERP (ok_if_already_exists))
+    {
+      if (SREF (target, 0) == '~')
+	target = Fexpand_file_name (target, Qnil);
+      else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
+	target = Fsubstring_no_properties (target, make_number (2), Qnil);
+    }
   linkname = expand_cp_target (target, linkname);
 
-  /* If the file name has special constructs in it,
-     call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (target, Qmake_symbolic_link);
-  if (!NILP (handler))
-    return call4 (handler, Qmake_symbolic_link, target,
-		  linkname, ok_if_already_exists);
-
   /* If the new link name has special constructs in it,
      call the corresponding file handler.  */
   handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
@@ -2635,11 +2630,6 @@ emacs_readlinkat (int fd, char const *filename)
     return Qnil;
 
   val = build_unibyte_string (buf);
-  if (buf[0] == '/' && strchr (buf, ':'))
-    {
-      AUTO_STRING (slash_colon, "/:");
-      val = concat2 (slash_colon, val);
-    }
   if (buf != readlink_buf)
     xfree (buf);
   val = DECODE_FILE (val);
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 55f4b52..99a21f3 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2590,13 +2590,16 @@ tramp--test-backtrace
 	    (should-error (make-symbolic-link tmp-name1 tmp-name2))
 	    (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
 	    (should (file-symlink-p tmp-name2))
-	    ;; `tmp-name3' is a local file name.
-	    (should-error (make-symbolic-link tmp-name1 tmp-name3)))
+	    ;; `tmp-name3' is a local file name, so its target is not
+	    ;; interpreted.
+	    (make-symbolic-link tmp-name1 tmp-name3)
+	    (should (equal tmp-name1 (file-symlink-p tmp-name3))))
 
 	;; Cleanup.
 	(ignore-errors
 	  (delete-file tmp-name1)
-	  (delete-file tmp-name2)))
+	  (delete-file tmp-name2)
+	  (delete-file tmp-name3)))
 
       ;; Check `add-name-to-file'.
       (unwind-protect
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 2ef1b55..5103d2f 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -19,14 +19,13 @@
 
 (require 'ert)
 
-(defun try-char (char link)
-  (let ((target (string char)))
-    (make-symbolic-link target link)
-    (let* ((read-link (file-symlink-p link))
-           (failure (unless (string-equal target read-link)
-                      (list 'string-equal target read-link))))
-      (delete-file link)
-      failure)))
+(defun try-link (target link)
+  (make-symbolic-link target link)
+  (let* ((read-link (file-symlink-p link))
+         (failure (unless (string-equal target read-link)
+                    (list 'string-equal target read-link))))
+    (delete-file link)
+    failure))
 
 (defun fileio-tests--symlink-failure ()
   (let* ((dir (make-temp-file "fileio" t))
@@ -36,9 +35,9 @@ fileio-tests--symlink-failure
               (char 0))
           (while (and (not failure) (< char 127))
             (setq char (1+ char))
-            (unless (= char ?~)
-              (setq failure (try-char char link))))
-          failure)
+            (setq failure (try-link (string char) link)))
+          (or failure
+              (try-link "/:" link)))
       (delete-directory dir t))))
 
 (ert-deftest fileio-tests--odd-symlink-chars ()
-- 
2.7.4