bug#28156: Emacs quietly munges symlink contents

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

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

>> Quoting does not work for these cases. If I try to rename a symlink to the
>> literal string '~eggert' on my machine, Emacs will misbehave as described and
>> there is no way to quote the string naming the symlink to fix this.
> 
> That is but one use case of many.  In other cases, quoting does work.

My point is that there is a bug in some cases. I agree that in other cases, 
make-symbolic-link does work.

> your proposed changes will disallow some of the
> users' capabilities to do what you want.

With the proposed changes a user can create a local symlink to an any string 
supported by the operating system. This change increases users' capabilities, 
compared to what they can do now. This change does not take away any capabilities.

> they seem to
> sacrifice a very common interactive use case on behalf of a much more
> rare and obscure one.  I'm talking about a user typing this:
> 
>    M-x make-symbolic-link RET ~/foo/bar RET /toto/quux RET

Good suggestion, also made by others. Revised patch attached.

[-- 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: 9029 bytes --]

From 868a212ba636a7cab27e1ee88495a7f7dcf71b0d Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Mon, 21 Aug 2017 09:46:34 -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.
* etc/NEWS: Document the change.
* src/fileio.c (Fmake_symbolic_link): Do not expand leading "~" in the
target unless interactive, and look for special constructs only in the
new link name, not the target.
(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         |  7 ++++---
 doc/lispref/files.texi       |  3 ++-
 etc/NEWS                     | 15 +++++++++++++++
 src/fileio.c                 | 21 +++------------------
 test/lisp/net/tramp-tests.el |  9 ++++++---
 test/src/fileio-tests.el     | 21 ++++++++++-----------
 6 files changed, 40 insertions(+), 36 deletions(-)

diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 9195bc4..56e3d2f 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1609,9 +1609,10 @@ Copying and Naming
 @var{new}, which points at @var{target}.  The effect is that future
 attempts to open file @var{new} will refer to whatever file is named
 @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
+the name @var{target} is nonexistent at that time.  This command
+expands the argument @var{target} only if it begins with @samp{~}, so
+that it allows you to specify most relative names as the target of the
+link.  On MS-Windows, this
 command works only on MS Windows Vista and later.  On remote systems,
 it works depending on the system type.
 
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5a52765..11e4b43 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1725,7 +1725,8 @@ Changing Files
 This command makes a symbolic link to @var{filename}, named
 @var{newname}.  This is like the shell command @samp{ln -s
 @var{filename} @var{newname}}.  The @var{filename} argument
-is treated only as a string; it need not name an existing file.
+need not name an existing file, and is expanded only if it begins with @samp{~}
+and @var{ok-if-already-exists} is an integer, indicating interactive use.
 If @var{filename} 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 0939033..97462ec 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1215,6 +1215,21 @@ 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.
+Two changes are involved.  First, '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".  Second, '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, with
+(make-symbolic-link "~y" "x") the link target is now the string "~y";
+to get the old behavior, use (make-symbolic-link (expand-file-name
+"~y") "x").
+
++++
 ** 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 f954ac1..ad2aab8 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 TARGET if it begins with "~".
 This happens for interactive use with M-x.  */)
   (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
 {
@@ -2423,21 +2424,10 @@ 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) == '~')
+  if (INTEGERP (ok_if_already_exists) && SREF (target, 0) == '~')
     target = Fexpand_file_name (target, 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 +2625,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 129bc1d..8c0c8c8 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2538,13 +2538,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