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

[npostavs@users.sourceforge.net]

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

Michael Albinus <michael.albinus@gmx.de> writes:
>>  
>> +           (not (let ((handler (find-file-name-handler
>> +                                filename 'substitute-in-file-name)))
>> +                  (and handler
>> +                       (funcall handler 'substitute-in-file-name filename)))))
>
> I would rather use (not (file-remote-p file-name))

Okay.


[-- Attachment #2: patch v3 --]
[-- Type: text/plain, Size: 5389 bytes --]

From 93854ddb9a15d4809f1dcf80b11784ddd4a31ed4 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 27 Oct 2016 22:17:11 -0400
Subject: [PATCH v3] 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       | 24 +++++++++++++++++-------
 test/lisp/files-tests.el | 23 +++++++++++++++++++++++
 2 files changed, 40 insertions(+), 7 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..5cbe243 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,6 +2251,16 @@ 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 (file-remote-p filename)))
+      (concat "/:" filename)
+    (minibuffer--double-dollars filename)))
+
 (defun completion--make-envvar-table ()
   (mapcar (lambda (enventry)
             (substring enventry 0 (string-match-p "=" enventry)))
@@ -2420,7 +2430,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 +2606,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 +2703,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 +2713,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


[-- Attachment #3: Type: text/plain, Size: 421 bytes --]


>
> This fixes the problem for local file names, but not for remote
> ones. "/ssh:user@host:/path/~/file" would still be expanded to something
> like "/ssh:user@host:/home/user/file". Well, better than nothing.
>
> What do people think to use the "/:" prefix also for the local part of
> remote file names? Then one could use "/ssh:user@host:/:/path/~/file",
> making substitute-in-file-name a noop.

Makes sense to me.