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

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

[積丹尼 Dan Jacobson]

R runs the command dired-do-rename, which is an interactive autoloaded
compiled Lisp function in `dired-aux.el'.

Using it, I got this strange error:

Move `/home/jidanni/.cpanm/work/1327389327.6650' to `/tmp/1327389327.6650' failed:
(file-error Opening output file permission denied /home/jidanni/perl5/lib/perl5/i486-linux-gnu-thread-multi-64int/.meta/accessors-1.01/MYMETA.json)

Well it turns out emacs' file name simplifying rules are being applied
in inappropriate places like when encountering

  /home/jidanni/.cpanm/work/1327389327.6650/accessors-1.01/~/perl5/lib/perl5/i486-linux-gnu-thread-multi-64int/.meta/accessors-1.01:
  total 16
  drwxr-xr-x 2 jidanni 4096 2012-01-24  .
  drwxr-xr-x 3 jidanni 4096 2012-01-24  ..
  -r--r--r-- 1 jidanni 1374 2012-01-24  MYMETA.json
  -r--r--r-- 1 jidanni  456 2012-01-24  install.json

One must use /bin/mv and not dired-do-rename to get the job done right.

One can even think of ways the bad guys could exploit this to chip away
at arbitrary files.

$ apt-cache policy emacs-snapshot
emacs-snapshot:
  Installed: 2:20140101-1

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

[npostavs]

tags 16984 confirmed
found 16984 25.1
quit

積丹尼 Dan Jacobson <jidanni@jidanni.org> writes:

> R runs the command dired-do-rename, which is an interactive autoloaded
> compiled Lisp function in `dired-aux.el'.
>
> Using it, I got this strange error:
>
> Move `/home/jidanni/.cpanm/work/1327389327.6650' to `/tmp/1327389327.6650' failed:
> (file-error Opening output file permission denied
> /home/jidanni/perl5/lib/perl5/i486-linux-gnu-thread-multi-64int/.meta/accessors-1.01/MYMETA.json)
>
> Well it turns out emacs' file name simplifying rules are being applied
> in inappropriate places like when encountering
>
>   /home/jidanni/.cpanm/work/1327389327.6650/accessors-1.01/~/perl5/lib/perl5/i486-linux-gnu-thread-multi-64int/.meta/accessors-1.01:

The essential problem seems to be that there is no way to escape
filenames from substitute-in-file-name to protect a file named "~",
therefore read-file-name-default can never return a filename in a
directory with that name.

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

[Eli Zaretskii]

> From: npostavs@users.sourceforge.net
> Date: Sat, 22 Oct 2016 22:21:20 -0400
> Cc: 16984@debbugs.gnu.org
> 
> The essential problem seems to be that there is no way to escape
> filenames from substitute-in-file-name to protect a file named "~",
> therefore read-file-name-default can never return a filename in a
> directory with that name.

What about the "/:" quoting?  It works for me, when I type "/:" before
the name of the file which has a '~' character embedded in it.

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

[npostavs]

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

severity 16984 minor
tags 16984 patch
quit

Eli Zaretskii <eliz@gnu.org> writes:

>> From: npostavs@users.sourceforge.net
>> Date: Sat, 22 Oct 2016 22:21:20 -0400
>> Cc: 16984@debbugs.gnu.org
>> 
>> The essential problem seems to be that there is no way to escape
>> filenames from substitute-in-file-name to protect a file named "~",
>> therefore read-file-name-default can never return a filename in a
>> directory with that name.
>
> 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:


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

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..7999e7b 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,6 +2251,15 @@ 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))
+      (concat "/:" filename)
+    (minibuffer--double-dollars filename)))
+
 (defun completion--make-envvar-table ()
   (mapcar (lambda (enventry)
             (substring enventry 0 (string-match-p "=" enventry)))
@@ -2420,7 +2429,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 +2605,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 +2702,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 +2712,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

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

[Eli Zaretskii]

> 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.

Thanks.

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

[Michael Albinus]

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.

> Thanks.

Best regards, Michael.

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

[npostavs]

[-- 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

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

[Michael Albinus]

npostavs@users.sourceforge.net writes:

>> 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):
>  
> +           (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))

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.

Best regards, Michael.

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

[npostavs]

[-- 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.

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

[Michael Albinus]

npostavs@users.sourceforge.net writes:

Hi Noam,

>> 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.

I've added a patch to master which allows quoting the local part of the
file name. Maybe you could rewrite your patch, using this feature.

There are also three new functions tramp-quoted-name-p, tramp-quote-name
and tramp-unquote-name. Maybe it is worth to expose them more generally,
as file-name-quoted-p, file-name-quote and file-name-unquote.

Best regards, Michael.

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

[npostavs]

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

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

> npostavs@users.sourceforge.net writes:
>>>
>>> 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.
>
> I've added a patch to master which allows quoting the local part of the
> file name. Maybe you could rewrite your patch, using this feature.
>

Something like this?


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

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..8cc0687 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -87,7 +87,8 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-lib)
+                   (require 'tramp)) ;; For `tramp-quote-name'.
 
 ;;; Completion table manipulation
 
@@ -2251,6 +2252,17 @@ 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))
+      (if (file-remote-p filename)
+          (tramp-quote-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 +2432,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 +2608,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 +2705,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 +2715,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

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

[Michael Albinus]

npostavs@users.sourceforge.net writes:

Hi Noam,

>> I've added a patch to master which allows quoting the local part of the
>> file name. Maybe you could rewrite your patch, using this feature.
>
> Something like this?
> +      (if (file-remote-p filename)
> +          (tramp-quote-name filename)
> +        (concat "/:" filename))

`tramp-quote-name' works for both local and remote file names, so you
could remove the test `(file-remote-p filename)'.

As said in the other mail, it shall be made available as
`file-name-quote', therefore. Eli?

Best regards, Michael.

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

[npostavs]

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

> npostavs@users.sourceforge.net writes:
>
> `tramp-quote-name' works for both local and remote file names, so you
> could remove the test `(file-remote-p filename)'.

Oh, I somehow had it in my mind that `concat' doesn't work with nil, I
must have mixed it up with `insert'.  Also, I guess most of the filename
tests should actually be looking at only the localname, so it should go
more like this:

    (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."
      (let ((local (file-remote-p filename 'localname)))
        (if (and (not (string-prefix-p "/:" local))
                 (file-name-absolute-p filename)
                 (string-match-p "/~" local))
            (tramp-quote-name filename)
          (minibuffer--double-dollars filename))))


Regarding `tramp-quoted-name-p', you should use (string-match "\\`/:"
...) or (string-prefix-p "/:" ...), not (string-match "^/:" ...) as the
latter could get confused by newlines in filenames (of the first two, I
find the `string-prefix-p' version clearer).

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

[Michael Albinus]

npostavs@users.sourceforge.net writes:

Hi Noam,

>       (let ((local (file-remote-p filename 'localname)))

Well, this is (file-local-name filename) these days.

> Regarding `tramp-quoted-name-p', you should use (string-match "\\`/:"
> ...) or (string-prefix-p "/:" ...), not (string-match "^/:" ...) as the
> latter could get confused by newlines in filenames (of the first two, I
> find the `string-prefix-p' version clearer).

In general you are right. But we don't support newlines in file names;
at least Tramp doesn't, so it makes no difference using "^/:" or "\\`/:".

`string-prefix-p' is the best choice indeed, and I thought about, but
Tramp cannot apply it yet. It has been introduced in Emacs 24.1, and
Tramp still supports Emacs 23. Well, NEWS.24 says that it exists already
since Emacs 23.2, but there is still Emacs 23.1, which is supported by
Tramp.

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: 16984@debbugs.gnu.org,  Eli Zaretskii <eliz@gnu.org>,  jidanni@jidanni.org
> Date: Thu, 08 Dec 2016 09:23:01 +0100
> 
> As said in the other mail, it shall be made available as
> `file-name-quote', therefore. Eli?

Are you asking me about the function's name?  file-name-quote is OK
with me.

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

[Eli Zaretskii]

> From: npostavs@users.sourceforge.net
> Cc: 16984@debbugs.gnu.org,  Eli Zaretskii <eliz@gnu.org>,  jidanni@jidanni.org
> Date: Thu, 08 Dec 2016 09:39:35 -0500
> 
>     (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."
>       (let ((local (file-remote-p filename 'localname)))
>         (if (and (not (string-prefix-p "/:" local))
>                  (file-name-absolute-p filename)
>                  (string-match-p "/~" local))
>             (tramp-quote-name filename)
>           (minibuffer--double-dollars filename))))

Is the argument guaranteed to come from expand-file-name?  If not, it
should also accept file names matching "\~" on MS platforms.

Thanks.

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

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

>> As said in the other mail, it shall be made available as
>> `file-name-quote', therefore. Eli?
>
> Are you asking me about the function's name?  file-name-quote is OK
> with me.

The question was rather whether this function (and file-name-unquote,
file-name-quoted-p) shall be exposed in files.el. I understand your
answer that you agree :-)

Best regards, Michael.

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

[Michael Albinus]

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

Hi Noam,

>> Regarding `tramp-quoted-name-p', you should use (string-match "\\`/:"
>> ...) or (string-prefix-p "/:" ...), not (string-match "^/:" ...) as the
>> latter could get confused by newlines in filenames (of the first two, I
>> find the `string-prefix-p' version clearer).

I have committed now a patch to the master, providing
file-name-quoted-p, file-name-quote and file-name-unquote. You might use
them, instead of their tramp-* counterparts.

I will add later on the text for the elisp manual, and for NEWS.

Best regards, Michael.

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

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: npostavs@users.sourceforge.net,  16984@debbugs.gnu.org,  jidanni@jidanni.org
> Date: Thu, 08 Dec 2016 17:25:17 +0100
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> As said in the other mail, it shall be made available as
> >> `file-name-quote', therefore. Eli?
> >
> > Are you asking me about the function's name?  file-name-quote is OK
> > with me.
> 
> The question was rather whether this function (and file-name-unquote,
> file-name-quoted-p) shall be exposed in files.el. I understand your
> answer that you agree :-)

Yes, thanks.

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

[npostavs]

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

Eli Zaretskii <eliz@gnu.org> writes:

>> From: npostavs@users.sourceforge.net
>> Cc: 16984@debbugs.gnu.org,  Eli Zaretskii <eliz@gnu.org>,  jidanni@jidanni.org
>> Date: Thu, 08 Dec 2016 09:39:35 -0500
>> 
>>     (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."
>>       (let ((local (file-remote-p filename 'localname)))
>>         (if (and (not (string-prefix-p "/:" local))
>>                  (file-name-absolute-p filename)
>>                  (string-match-p "/~" local))
>>             (tramp-quote-name filename)
>>           (minibuffer--double-dollars filename))))
>
> Is the argument guaranteed to come from expand-file-name?  If not, it
> should also accept file names matching "\~" on MS platforms.

I think it does, but I'm not entirely sure.  Better safe than sorry?


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

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

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..576b804 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,6 +2251,17 @@ 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 (file-name-quoted-p filename))
+           (file-name-absolute-p filename)
+           (string-match-p (if (memq system-type '(windows-nt ms-dos))
+                               "[/\\\\]~" "/~")
+                           (file-local-name filename)))
+      (file-name-quote filename)
+    (minibuffer--double-dollars filename)))
+
 (defun completion--make-envvar-table ()
   (mapcar (lambda (enventry)
             (substring enventry 0 (string-match-p "=" enventry)))
@@ -2420,7 +2431,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 +2607,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 +2704,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 +2714,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

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

[Michael Albinus]

npostavs@users.sourceforge.net writes:

> Subject: [PATCH v5] Quote filenames containing '~' in prompts

LGTM.

Best regards, Michael.

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

[Eli Zaretskii]

> From: npostavs@users.sourceforge.net
> Cc: 16984@debbugs.gnu.org,  michael.albinus@gmx.de,  jidanni@jidanni.org
> Date: Thu, 08 Dec 2016 23:56:43 -0500
> 
> > Is the argument guaranteed to come from expand-file-name?  If not, it
> > should also accept file names matching "\~" on MS platforms.
> 
> I think it does, but I'm not entirely sure.  Better safe than sorry?

Definitely, thanks.

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

[npostavs]

tags 16984 fixed
close 16984 26.1
quit

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

> npostavs@users.sourceforge.net writes:
>
>> Subject: [PATCH v5] Quote filenames containing '~' in prompts
>
> LGTM.
>
> Best regards, Michael.

Pushed as a92a027d58cb.