bug#28156: Emacs quietly munges symlink contents

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

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

Eli Zaretskii wrote:
> Why remove this part?  You also did not mentioned that in NEWS.

The symlink target is a string not a file name, so giving it to file name 
handler can cause the make-symbolic-link call to be misinterpreted. Revised NEWS 
in attached patch, with an example.

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

From 6c8d19b8ab7db320db844c14b034923cf43a194c 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                     | 21 +++++++++++++++++++++
 src/fileio.c                 | 21 +++------------------
 test/lisp/net/tramp-tests.el |  9 ++++++---
 test/src/fileio-tests.el     | 21 ++++++++++-----------
 6 files changed, 46 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..39c34fa 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1215,6 +1215,27 @@ 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, 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