bug#16984: dired-do-rename susceptible to .../~/... hijack

[npostavs@users.sourceforge.net]

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

Michael Albinus <michael.albinus@gmx.de> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: npostavs@users.sourceforge.net
>>> Cc: 16984@debbugs.gnu.org,  jidanni@jidanni.org
>>> Date: Fri, 28 Oct 2016 22:27:13 -0400
>>> 
>>> > What about the "/:" quoting?  It works for me, when I type "/:" before
>>> > the name of the file which has a '~' character embedded in it.
>>> 
>>> Ah, yes it works, as documented in `(emacs) Quoted File Names'.  I think
>>> it would be nicer if Emacs' file prompts defaulted to insert this as
>>> needed, here's a patch to do that:
>>
>> This is good for master, but please wait for a few days in case
>> someone would like to comment or object.
>
> Prefixing with "/:" would also deactivate all file name handlers. The
> file name "/ssh:user@host:/path/~/file" would be handled literally,
> which is wrong.

Ah, good point.  How about checking (find-file-name-handler filename
'substitute-in-file-name):


[-- Attachment #2: patch v2 --]
[-- Type: text/plain, Size: 5586 bytes --]

From f5a6fbca230f79745be979df4d73550a201fcc53 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 27 Oct 2016 22:17:11 -0400
Subject: [PATCH v2] Quote filenames containing '~' in prompts

When in a directory named '~', the default value given by
`read-file-name' should be quoted by prepending '/:', in order to
prevent it from being interpreted as referring to the $HOME
directory (Bug #16984).

* lisp/minibuffer.el (minibuffer-maybe-quote-filename): New function.
(completion--sifn-requote, read-file-name-default): Use it instead of
`minibuffer--double-dollars'.
* test/lisp/files-tests.el (files-test-read-file-in-~): Test it.
---
 lisp/minibuffer.el       | 27 ++++++++++++++++++++-------
 test/lisp/files-tests.el | 23 +++++++++++++++++++++++
 2 files changed, 43 insertions(+), 7 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..217bcac 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,6 +2251,19 @@ minibuffer--double-dollars
   (replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar))
                             str))
 
+(defun minibuffer-maybe-quote-filename (filename)
+  "Protect FILENAME from `substitute-in-file-name', as needed.
+Useful to give the user default values that won't be substituted."
+  (if (and (not (string-prefix-p "/:" filename))
+           (file-name-absolute-p filename)
+           (string-match-p "/~" filename)
+           (not (let ((handler (find-file-name-handler
+                                filename 'substitute-in-file-name)))
+                  (and handler
+                       (funcall handler 'substitute-in-file-name filename)))))
+      (concat "/:" filename)
+    (minibuffer--double-dollars filename)))
+
 (defun completion--make-envvar-table ()
   (mapcar (lambda (enventry)
             (substring enventry 0 (string-match-p "=" enventry)))
@@ -2420,7 +2433,7 @@ completion--sifn-requote
                                    (substitute-in-file-name
                                     (substring qstr 0 (1- qpos)))))
         (setq qpos (1- qpos)))
-      (cons qpos #'minibuffer--double-dollars))))
+      (cons qpos #'minibuffer-maybe-quote-filename))))
 
 (defalias 'completion--file-name-table
   (completion-table-with-quoting #'completion-file-name-table
@@ -2596,10 +2609,10 @@ read-file-name-default
   (let ((insdef (cond
                  ((and insert-default-directory (stringp dir))
                   (if initial
-                      (cons (minibuffer--double-dollars (concat dir initial))
-                            (length (minibuffer--double-dollars dir)))
-                    (minibuffer--double-dollars dir)))
-                 (initial (cons (minibuffer--double-dollars initial) 0)))))
+                      (cons (minibuffer-maybe-quote-filename (concat dir initial))
+                            (length (minibuffer-maybe-quote-filename dir)))
+                    (minibuffer-maybe-quote-filename dir)))
+                 (initial (cons (minibuffer-maybe-quote-filename initial) 0)))))
 
     (let ((completion-ignore-case read-file-name-completion-ignore-case)
           (minibuffer-completing-file-name t)
@@ -2693,7 +2706,7 @@ read-file-name-default
             ;; with what we will actually return.  As an exception,
             ;; if that's the same as the second item in
             ;; file-name-history, it's really a repeat (Bug#4657).
-            (let ((val1 (minibuffer--double-dollars val)))
+            (let ((val1 (minibuffer-maybe-quote-filename val)))
               (if history-delete-duplicates
                   (setcdr file-name-history
                           (delete val1 (cdr file-name-history))))
@@ -2703,7 +2716,7 @@ read-file-name-default
           (if add-to-history
               ;; Add the value to the history--but not if it matches
               ;; the last value already there.
-              (let ((val1 (minibuffer--double-dollars val)))
+              (let ((val1 (minibuffer-maybe-quote-filename val)))
                 (unless (and (consp file-name-history)
                              (equal (car file-name-history) val1))
                   (setq file-name-history
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 80d5e5b..f4ccd5c 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -220,5 +220,28 @@ files-test-bug-18141-file
     (should-not yes-or-no-p-prompts)
     (should (equal kill-emacs-args '(nil)))))
 
+(ert-deftest files-test-read-file-in-~ ()
+  "Test file prompting in directory named '~'.
+If we are in a directory named '~', the default value should not
+be $HOME."
+  (cl-letf (((symbol-function 'completing-read)
+             (lambda (_prompt _coll &optional _pred _req init _hist def _)
+               (or def init)))
+            (dir (make-temp-file "read-file-name-test" t)))
+    (unwind-protect
+        (let ((subdir (expand-file-name "./~/")))
+          (make-directory subdir t)
+          (with-temp-buffer
+            (setq default-directory subdir)
+            (should-not (equal
+                         (expand-file-name (read-file-name "File: "))
+                         (expand-file-name "~/")))
+            ;; Don't overquote either!
+            (setq default-directory (concat "/:" subdir))
+            (should-not (equal
+                         (expand-file-name (read-file-name "File: "))
+                         (concat "/:/:" subdir)))))
+      (delete-directory dir 'recursive))))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here
-- 
2.9.3