From: Noam Postavsky <npostavs@users.sourceforge.net>
To: Philipp Stephani <p.stephani2@gmail.com>
Cc: 30243@debbugs.gnu.org, phst@a.muc.corp.google.com
Subject: bug#30243: 26.0.91; Infinite recursion in `make-auto-save-file-name' for quoted filenames
Date: Thu, 25 Jan 2018 00:57:46 -0500 [thread overview]
Message-ID: <87po5ymqed.fsf@users.sourceforge.net> (raw)
In-Reply-To: <CAArVCkSupB9ytOfPP=uBy9T4G3JuZ6no+aXWGUryB9YfxBOLHw@mail.gmail.com> (Philipp Stephani's message of "Wed, 24 Jan 2018 23:25:34 +0000")
[-- Attachment #1: Type: text/plain, Size: 1209 bytes --]
Philipp Stephani <p.stephani2@gmail.com> writes:
> Noam Postavsky <npostavs@users.sourceforge.net> schrieb am Do., 25.
> Jan. 2018 um 00:04 Uhr:
> + (buffer-file-name
> + (if (and (memq operation '(make-auto-save-file-name))
> + (string-match "\\`/:" buffer-file-name))
> + (substring buffer-file-name (match-end 0))
> + buffer-file-name))
> Thanks, when you commit this, could you please also add a regression
> test so we don't reintroduce the bug later?
Yeah, we need to test more than just that operation though. I've added
a test for all the operations listed in `(elisp) Magic File Names'. I
discovered several other similar problems. With
`file-name-all-completions' I even got Emacs to crash (I presume due to
stack corruption during the recursion). Also note that the above patch
breaks find-file for /: quoted files, buffer-file-name needs to be bound
more selectively (as in the new patch, attached below).
`file-notify-rm-watch' and `file-notify-valid-p' are still broken, I
can't immediately see how to fix them and it's getting past my bedtime.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 13580 bytes --]
From 5adeec4f3367ac5406e14c3b9c376a2cabc6d5ea Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 25 Jan 2018 00:37:50 -0500
Subject: [PATCH v2] Test and fix "/:" quoted file name handlers (Bug#30243)
* lisp/files.el (file-name-non-special): Strip the "/:" from
`default-directory' for `temporary-file-directory' operation; both
arguments to `file-name-completion', `file-name-all-completion', and
`file-equal-p' operations; `buffer-file-name' for
`make-auto-save-file-name' and 'set-visited-file-modtime' operations.
Don't touch any operands of `file-notify-rm-watch' and
`file-notify-valid-p' as they receive descriptors; not file
names (this is not sufficient to fix these operations for "/:" quoted
file names though).
* test/lisp/files-tests.el (files-tests--with-temp-dir): New macro.
(files-file-name-non-special-notify-handlers)
(files-file-name-non-special-handlers): New tests.
---
lisp/files.el | 21 +++++-
test/lisp/files-tests.el | 186 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 203 insertions(+), 4 deletions(-)
diff --git a/lisp/files.el b/lisp/files.el
index 66420e7259..576640393f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6999,7 +6999,7 @@ file-name-non-special
;; Bug#25949.
(if (memq operation
'(insert-directory process-file start-file-process
- shell-command))
+ shell-command temporary-file-directory))
(directory-file-name
(expand-file-name
(unhandled-file-name-directory default-directory)))
@@ -7023,15 +7023,22 @@ file-name-non-special
;; temporarily to unquoted filename.
(verify-visited-file-modtime unquote-then-quote)
;; List the arguments which are filenames.
- (file-name-completion 1)
- (file-name-all-completions 1)
+ (file-name-completion 0 1)
+ (file-name-all-completions 0 1)
+ (file-equal-p 0 1)
(write-region 2 5)
(rename-file 0 1)
(copy-file 0 1)
(copy-directory 0 1)
(file-in-directory-p 0 1)
(make-symbolic-link 0 1)
- (add-name-to-file 0 1))))
+ (add-name-to-file 0 1)
+ (make-auto-save-file-name buffer-file-name)
+ (set-visited-file-modtime buffer-file-name)
+ ;; These file-notify-* operations take a
+ ;; descriptor.
+ (file-notify-rm-watch . nil)
+ (file-notify-valid-p . nil))))
;; For all other operations, treat the first argument only
;; as the file name.
'(nil 0))))
@@ -7054,6 +7061,12 @@ file-name-non-special
(pcase method
(`identity (car arguments))
(`add (file-name-quote (apply operation arguments)))
+ (`buffer-file-name
+ (let ((buffer-file-name
+ (if (string-match "\\`/:" buffer-file-name)
+ (substring buffer-file-name (match-end 0))
+ buffer-file-name)))
+ (apply operation arguments)))
(`insert-file-contents
(let ((visit (nth 1 arguments)))
(unwind-protect
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 8dbfc2965c..4738a50b43 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -21,6 +21,9 @@
(require 'ert)
(require 'nadvice)
+(require 'bytecomp) ; `byte-compiler-base-file-name'.
+(require 'dired) ; `dired-uncache'.
+(require 'filenotify) ; `file-notify-add-watch'.
;; Set to t if the local variable was set, `query' if the query was
;; triggered.
@@ -286,6 +289,14 @@ files-tests--with-temp-file
(progn ,@body)
(delete-file ,name))))
+(defmacro files-tests--with-temp-dir (name &rest body)
+ (declare (indent 1))
+ (cl-check-type name symbol)
+ `(let ((,name (make-temp-file "emacs" t)))
+ (unwind-protect
+ (progn ,@body)
+ (delete-directory ,name t))))
+
(ert-deftest files-tests--file-name-non-special--buffers ()
"Check that Bug#25951 is fixed.
We call `verify-visited-file-modtime' on a buffer visiting a file
@@ -327,6 +338,181 @@ files-tests--with-temp-file
`((verify-visited-file-modtime ,buffer-visiting-file)
(verify-visited-file-modtime nil))))))))
+(ert-deftest files-file-name-non-special-notify-handlers ()
+ :expected-result :failed
+ (files-tests--with-temp-file tmpfile
+ (let* ((nospecial (concat "/:" tmpfile))
+ (watch (file-notify-add-watch nospecial '(change) #'ignore)))
+ (should (file-notify-valid-p watch))
+ (file-notify-rm-watch watch))))
+
+
+(ert-deftest files-file-name-non-special-handlers ()
+ (files-tests--with-temp-file tmpfile
+ (files-tests--with-temp-dir tmpdir
+ (let ((nospecial (concat "/:" tmpfile))
+ (nospecial-dir (concat "/:" tmpdir)))
+ (should (null (access-file nospecial "test")))
+ (let ((newname (concat nospecial "add-name")))
+ (add-name-to-file nospecial newname)
+ (should (file-exists-p newname)))
+ (should (equal (byte-compiler-base-file-name nospecial)
+ (byte-compiler-base-file-name tmpfile)))
+ (let ((newname (concat (directory-file-name nospecial-dir)
+ "copy-dir")))
+ (copy-directory nospecial-dir newname)
+ (should (file-directory-p newname))
+ (delete-directory newname)
+ (should-not (file-directory-p newname)))
+ (let ((newname (concat (directory-file-name nospecial)
+ "copy-file")))
+ (copy-file nospecial newname)
+ (should (file-exists-p newname))
+ (delete-file newname)
+ (should-not (file-exists-p newname)))
+ (should (equal (diff-latest-backup-file nospecial)
+ (diff-latest-backup-file tmpfile)))
+ (should (equal (directory-file-name nospecial-dir)
+ (concat "/:" (directory-file-name tmpdir))))
+ (should (equal (directory-files nospecial-dir)
+ (directory-files tmpdir)))
+ (should (equal (directory-files-and-attributes nospecial-dir)
+ (directory-files-and-attributes tmpdir)))
+ (dired-compress-file (dired-compress-file nospecial))
+ (dired-uncache nospecial-dir)
+ (should (equal (expand-file-name nospecial)
+ nospecial))
+ (should (file-accessible-directory-p nospecial-dir))
+ (should (equal (file-acl nospecial)
+ (file-acl tmpfile)))
+ (should (equal (file-attributes nospecial)
+ (file-attributes tmpfile)))
+ (should (equal (file-directory-p nospecial-dir)
+ (file-directory-p tmpdir)))
+ (should (file-equal-p nospecial tmpfile))
+ (should (file-equal-p tmpfile nospecial))
+ (should-not (file-executable-p nospecial))
+ (should (file-exists-p nospecial))
+ (should (file-in-directory-p nospecial temporary-file-directory))
+ (should-not (file-in-directory-p nospecial nospecial-dir))
+ (should-not (file-in-directory-p tmpfile nospecial-dir))
+ (should-not (file-local-copy nospecial)) ; Already local.
+ (should (equal (file-modes nospecial)
+ (file-modes tmpfile)))
+ (should (equal (file-name-all-completions nospecial nospecial-dir)
+ (file-name-all-completions tmpfile tmpdir)))
+ (file-name-as-directory nospecial)
+ (should (equal (file-name-case-insensitive-p nospecial)
+ (file-name-case-insensitive-p tmpfile)))
+ (should (equal (file-name-completion nospecial nospecial-dir)
+ (file-name-completion tmpfile tmpdir)))
+ (should (equal (file-name-directory nospecial)
+ (concat "/:" temporary-file-directory)))
+ (should (equal (file-name-nondirectory nospecial)
+ (file-name-nondirectory tmpfile)))
+ (should (equal (file-name-sans-versions nospecial)
+ nospecial))
+ (should-not (file-newer-than-file-p nospecial tmpfile))
+ (should (equal (file-ownership-preserved-p nospecial)
+ (file-ownership-preserved-p tmpfile)))
+ (should (file-readable-p nospecial))
+ (should (file-regular-p nospecial))
+ (should-not (file-remote-p nospecial))
+ (should (equal (file-selinux-context nospecial)
+ (file-selinux-context tmpfile)))
+ (should-not (file-symlink-p nospecial))
+ (file-truename nospecial)
+ (should (file-writable-p nospecial))
+ (should (equal (find-backup-file-name nospecial)
+ (mapcar (lambda (f) (concat "/:" f))
+ (find-backup-file-name tmpfile))))
+ (should-not (get-file-buffer nospecial))
+ (should (equal (with-temp-buffer
+ (insert-directory nospecial-dir nil)
+ (buffer-string))
+ (with-temp-buffer
+ (insert-directory tmpdir nil)
+ (buffer-string))))
+ (with-temp-buffer
+ (insert-file-contents nospecial)
+ (should (zerop (buffer-size))))
+ (should (load nospecial))
+ (save-current-buffer
+ (should (equal (prog2 (set-buffer (find-file-noselect nospecial))
+ (make-auto-save-file-name)
+ (kill-buffer))
+ (prog2 (set-buffer (find-file-noselect tmpfile))
+ (make-auto-save-file-name)
+ (kill-buffer)))))
+ (let ((default-directory nospecial-dir))
+ (make-directory "dir")
+ (should (file-directory-p "dir"))
+ (delete-directory "dir")
+ (make-directory-internal "dir")
+ (should (file-directory-p "dir"))
+ (delete-directory "dir")
+ (let ((near-tmpfile (make-nearby-temp-file "file")))
+ (should (file-exists-p near-tmpfile))
+ (delete-file near-tmpfile)))
+ (let* ((linkname (expand-file-name "link" tmpdir))
+ (may-symlink (ignore-errors (make-symbolic-link tmpfile linkname)
+ t)))
+ (when may-symlink
+ (should (file-symlink-p linkname))
+ (delete-file linkname)
+ (let ((linkname (expand-file-name "link" nospecial-dir)))
+ (make-symbolic-link tmpfile linkname)
+ (should (file-symlink-p linkname))
+ (delete-file linkname))))
+ ;; `files-tests--file-name-non-special--subprocess' already
+ ;; tests `process-file'.
+ (rename-file nospecial (concat nospecial "x"))
+ (rename-file (concat nospecial "x") nospecial)
+ (rename-file tmpfile (concat nospecial "x"))
+ (rename-file (concat nospecial "x") nospecial)
+ (rename-file nospecial (concat tmpfile "x"))
+ (rename-file (concat nospecial "x") nospecial)
+ (set-file-acl nospecial (file-acl nospecial))
+ (set-file-modes nospecial (file-modes nospecial))
+ (set-file-selinux-context nospecial (file-selinux-context nospecial))
+ (set-file-times nospecial)
+ ;; `files-tests--file-name-non-special--buffers' already tests
+ ;; `verify-visited-file-modtime'.
+ (with-temp-buffer
+ (write-region nil nil nospecial nil :visit))
+ (save-current-buffer
+ (set-buffer (find-file-noselect nospecial))
+ (set-visited-file-modtime)
+ (kill-buffer))
+ (with-temp-buffer
+ (let ((default-directory nospecial-dir))
+ (shell-command (concat (shell-quote-argument
+ (concat invocation-directory invocation-name))
+ " --version")
+ (current-buffer))
+ (goto-char (point-min))
+ (should (search-forward emacs-version nil t))))
+ (with-temp-buffer
+ (let ((default-directory nospecial-dir))
+ (let ((proc (start-file-process
+ "emacs" (current-buffer)
+ (concat invocation-directory invocation-name)
+ "--version")))
+ (accept-process-output proc)
+ (goto-char (point-min))
+ (should (search-forward emacs-version nil t))
+ (kill-process proc)
+ (accept-process-output proc ))))
+ (let ((process-environment (cons "FOO=foo" process-environment)))
+ ;; The "/:" prevents substitution.
+ (equal (substitute-in-file-name nospecial) nospecial))
+ (let ((default-directory nospecial-dir))
+ (equal (temporary-file-directory) temporary-file-directory))
+ (equal (unhandled-file-name-directory nospecial-dir)
+ (file-name-as-directory tmpdir))
+ (should (equal (vc-registered nospecial)
+ (vc-registered tmpfile)))))))
+
(ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
(let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
(cons "/home/user/.txt" nil)
--
2.11.0
next prev parent reply other threads:[~2018-01-25 5:57 UTC|newest]
Thread overview: 33+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-01-24 22:12 bug#30243: 26.0.91; Infinite recursion in `make-auto-save-file-name' for quoted filenames phst
2018-01-24 22:43 ` Philipp Stephani
2018-01-24 23:04 ` Noam Postavsky
2018-01-24 23:25 ` Philipp Stephani
2018-01-25 5:57 ` Noam Postavsky [this message]
2018-01-25 9:49 ` Michael Albinus
2018-01-25 14:07 ` Noam Postavsky
2018-01-25 16:36 ` Michael Albinus
2018-01-25 16:46 ` Noam Postavsky
2018-01-26 1:46 ` Noam Postavsky
2018-01-26 11:01 ` Michael Albinus
2018-01-26 22:11 ` Noam Postavsky
2018-01-28 10:28 ` Michael Albinus
2018-01-28 14:58 ` Noam Postavsky
2018-01-28 19:17 ` Michael Albinus
2018-01-30 13:46 ` Eli Zaretskii
2018-01-30 16:02 ` Michael Albinus
2018-01-30 19:22 ` Philipp Stephani
2018-01-31 0:01 ` Noam Postavsky
2018-01-31 16:02 ` Eli Zaretskii
2018-01-31 18:07 ` Michael Albinus
2018-01-31 18:16 ` Noam Postavsky
2018-01-31 18:21 ` Michael Albinus
2018-02-01 14:01 ` Michael Albinus
2018-02-01 16:40 ` Philipp Stephani
2018-02-01 18:52 ` Michael Albinus
2018-02-02 1:16 ` Noam Postavsky
2018-02-02 17:56 ` Michael Albinus
2018-02-03 20:34 ` Noam Postavsky
2018-01-31 15:38 ` Eli Zaretskii
2018-02-16 3:38 ` bug#30481: 26.0.91; infinite recursion + edebug = memory corruption Noam Postavsky
2018-02-16 8:39 ` Eli Zaretskii
2018-02-17 3:30 ` Noam Postavsky
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=87po5ymqed.fsf@users.sourceforge.net \
--to=npostavs@users.sourceforge.net \
--cc=30243@debbugs.gnu.org \
--cc=p.stephani2@gmail.com \
--cc=phst@a.muc.corp.google.com \
/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.