unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: npostavs@users.sourceforge.net
To: Eli Zaretskii <eliz@gnu.org>
Cc: 16984@debbugs.gnu.org, jidanni@jidanni.org
Subject: bug#16984: dired-do-rename susceptible to .../~/... hijack
Date: Fri, 28 Oct 2016 22:27:13 -0400	[thread overview]
Message-ID: <87pomjrita.fsf@users.sourceforge.net> (raw)
In-Reply-To: <837f8zpnih.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 23 Oct 2016 09:50:30 +0300")

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


  reply	other threads:[~2016-10-29  2:27 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2014-03-10 18:10 bug#16984: dired-do-rename susceptible to .../~/... hijack 積丹尼 Dan Jacobson
2016-10-23  2:21 ` npostavs
2016-10-23  6:50   ` Eli Zaretskii
2016-10-29  2:27     ` npostavs [this message]
2016-10-29  7:01       ` Eli Zaretskii
2016-10-29 13:23         ` Michael Albinus
2016-10-29 15:54           ` npostavs
2016-10-29 16:22             ` Michael Albinus
2016-11-01  0:42               ` npostavs
2016-12-04 19:06                 ` Michael Albinus
2016-12-08  1:47                   ` npostavs
2016-12-08  8:23                     ` Michael Albinus
2016-12-08 14:39                       ` npostavs
2016-12-08 14:58                         ` Michael Albinus
2016-12-08 17:03                           ` Michael Albinus
2016-12-08 16:00                         ` Eli Zaretskii
2016-12-09  4:56                           ` npostavs
2016-12-09  8:05                             ` Michael Albinus
2016-12-12  2:57                               ` npostavs
2016-12-09  8:19                             ` Eli Zaretskii
2016-12-08 15:58                       ` Eli Zaretskii
2016-12-08 16:25                         ` Michael Albinus
2016-12-08 17:23                           ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87pomjrita.fsf@users.sourceforge.net \
    --to=npostavs@users.sourceforge.net \
    --cc=16984@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    --cc=jidanni@jidanni.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).