all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: npostavs@users.sourceforge.net
To: Michael Albinus <michael.albinus@gmx.de>
Cc: 16984@debbugs.gnu.org, jidanni@jidanni.org
Subject: bug#16984: dired-do-rename susceptible to .../~/... hijack
Date: Sat, 29 Oct 2016 11:54:56 -0400	[thread overview]
Message-ID: <87h97vqhf3.fsf@users.sourceforge.net> (raw)
In-Reply-To: <87eg2zb860.fsf@gmx.de> (Michael Albinus's message of "Sat, 29 Oct 2016 15:23:51 +0200")

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


  reply	other threads:[~2016-10-29 15:54 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
2016-10-29  7:01       ` Eli Zaretskii
2016-10-29 13:23         ` Michael Albinus
2016-10-29 15:54           ` npostavs [this message]
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

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

  git send-email \
    --in-reply-to=87h97vqhf3.fsf@users.sourceforge.net \
    --to=npostavs@users.sourceforge.net \
    --cc=16984@debbugs.gnu.org \
    --cc=jidanni@jidanni.org \
    --cc=michael.albinus@gmx.de \
    /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 external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.