bug#46397: 27.1; Cannot delete buffer pointing to a file in a path that includes a file

[Matt Armstrong]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Matt Armstrong <matt@rfc20.org>
>> Cc: 46397@debbugs.gnu.org, eggert@cs.ucla.edu, craven@gmx.net
>> Date: Wed, 24 Feb 2021 09:37:49 -0800
>> 
>> I still like my original idea of calling display-warning for all unlock
>> errors, essentially turning "unlock" into a best effort function at the
>> API level.  I think display-warning is intrusive enough that users are
>> unlikely to simply not notice the problem, and there are worse things
>> than leaving lock files around.
>
> OK, you've convinced me: let's try the warning approach.  Can you
> present a patch for that, please?

Thanks Eli, will do.  I have made progress with that idea, but I'd
rather get the test in first.  See patch attached below.


> As for the tests you posted: too many of them rely on Posix file
> modes, and thus will probably either fail or be unable to provide
> meaningful testing on MS-Windows.  Can we please augment that by tests
> that create unlocking problems by, e.g., running a shell command to
> remove or rename or otherwise sabotage the lock file, so that the new
> functionality could be meaningfully tested on Windows as well?

I have not been able to come up with a way to achieve what you ask for.

I have no access to an MS-Windows system to test with, though I have
been testing with small FAT and NTFS file systems in a ramdisk under
GNU/Linux.  It may be possible to take some approach that works on
MS-Windows systems, but I'm not in a good position to write that code.

Another issue is that the lock file is typicaly a symbolink link, and
operating systems typically ignore file modes on symbolic links, so it
is hard to put the lock file itself into an "invalid" state --
i.e. where simply attempting to access or delete it generates a file
system level error.  This is why I resorted to modifying file modes on
the containing directory -- attemps to remove or access files in such a
directory do reliably generate errors (on POSIX systems).

What I've done is make the tests skip themselves when `set-file-mode' on
the test's temporary directory appears to not work.  When I test this on
an ext2 file system the tests complete.  When I test this on a FAT and
NTFS file system (set up as a ramdisk on GNU/Linux), the tests skip
themselves.

>From e05d400c177333cff0f558aff1948bcd55130c17 Mon Sep 17 00:00:00 2001
From: Matt Armstrong <matt@rfc20.org>
Date: Mon, 15 Feb 2021 12:59:08 -0800
Subject: [PATCH 1/2] Add some test coverage for src/filelock.c (Bug#46397).

* test/src/filelock-tests.el: new file
---
 test/src/filelock-tests.el | 183 +++++++++++++++++++++++++++++++++++++
 1 file changed, 183 insertions(+)
 create mode 100644 test/src/filelock-tests.el

diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
new file mode 100644
index 0000000000..e568050c42
--- /dev/null
+++ b/test/src/filelock-tests.el
@@ -0,0 +1,183 @@
+;;; filelock-tests.el --- test file locking -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file tests code in src/filelock.c and, to some extent, the
+;; related code in src/fileio.c.
+
+;; Note: many of these tests set file modes to unusual values, with
+;; the aim of exercising Emacs' error handling code.  These tests
+;; require POSIX file system semantics, which are not available on all
+;; file systems (e.g. FAT, NTFS).  The tests skip themselves when the
+;; file system does not support the given file modes.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+(defvar filelock-tests-temporary-file-directory nil
+  "The directory for writing temporary files in filelock tests.
+This is used by the function
+`filelock-tests--make-temp-directory' to override the value of
+the variable `temporary-file-directory'.")
+
+(defun filelock-tests--make-temp-directory ()
+  "Create and return the name of a temporary directory.
+The caller should delete the directory."
+  (let ((temporary-file-directory (or filelock-tests-temporary-file-directory
+                                      temporary-file-directory)))
+    (make-temp-file "test" t)))
+
+(defun filelock-tests--fixture (test-function)
+  "Call TEST-FUNCTION under a test fixture.
+Create a test directory and a buffer whose `buffer-file-name' and
+`buffer-file-truename' are a file within it.  Call TEST-FUNCTION,
+passing it directory name.  Finally, delete the buffer and the
+test directory.
+
+This function attempts to delete the test directory even if the
+test leaves the buffer locked or the test directory with strange
+permissions."
+  (let* ((temp-dir (filelock-tests--make-temp-directory))
+         (name (concat (file-name-as-directory temp-dir)
+                       "file"))
+         (create-lockfiles t))
+    (unwind-protect
+        (with-temp-buffer
+          (setq buffer-file-name name)
+          (setq buffer-file-truename name)
+          (unwind-protect
+              (save-current-buffer
+                (funcall test-function temp-dir))
+
+            ;; Here begins somewhat delicate cleanup logic.  It must
+            ;; be performed in this order.
+            ;;
+            ;; First, give Emacs permission to modify the test
+            ;; directory.  The test may have left the diretory's modes
+            ;; in an unusual state.
+            ;;
+            ;; Second, mark the buffer unmodified.  This prevents
+            ;; prompts from `kill-buffer' about saving unmodified
+            ;; buffers (when this test is run interactively).
+            ;;
+            ;; Third, delete the temp buffer (by way of
+            ;; `with-temp-buffer' above).  Emacs may also delete the
+            ;; lock file from the test directory at this point.
+            ;;
+            ;; Fourth, delete the test directory itself.
+
+            (set-file-modes temp-dir (logior #o700 (file-modes temp-dir)))
+            (set-buffer-modified-p nil)))
+      (delete-directory temp-dir t nil))))
+
+(defun filelock-tests--make-file-inaccessible (filename)
+  "Make file named FILENAME inaccessible.
+Returns non-nil if the operation succeeds, otherwise nil.  Note:
+not all file systems support this operation."
+  (set-file-modes filename #o000)
+  (equal #o000 (file-modes filename)))
+
+(ert-deftest filelock-tests-lock-unlock-no-errors ()
+  "Check that locking and unlocking works without error."
+  (filelock-tests--fixture
+   (lambda (_)
+     (should (not (file-locked-p (buffer-file-name))))
+     (insert "this locks the buffer's file")
+     (should (file-locked-p (buffer-file-name)))
+     (unlock-buffer)
+     (should (not (file-locked-p (buffer-file-name)))))))
+
+(ert-deftest filelock-tests-lock-buffer-permission-denied ()
+  "Check that locking a buffer in a directory with no write
+permissions does not work."
+  (filelock-tests--fixture
+   (lambda (temp-dir)
+     (should (not (file-locked-p (buffer-file-name))))
+
+     (let ((original-modes (file-modes temp-dir)))
+       (skip-unless (filelock-tests--make-file-inaccessible temp-dir))
+       ;; FIXME: file system errors when locking a file are ignored;
+       ;; should they be?
+       (insert "this locks the current buffer's file")
+       (set-file-modes temp-dir original-modes))
+
+     (should (not (file-locked-p (buffer-file-name)))))))
+
+(ert-deftest filelock-tests-file-locked-p-permission-denied ()
+  "Check that `file-locked-p' fails if the directory is inaccesible."
+  (filelock-tests--fixture
+   (lambda (temp-dir)
+     (skip-unless (filelock-tests--make-file-inaccessible temp-dir))
+
+     (let ((err (should-error (file-locked-p (buffer-file-name)))))
+       (should (equal (cl-subseq err 0 2)
+                      '(file-error "Testing file lock")))))))
+
+(ert-deftest filelock-tests-unlock-permission-denied ()
+  "Check that `unlock-buffer' fails in directories that cannot be
+modified."
+  (filelock-tests--fixture
+   (lambda (temp-dir)
+     (insert "this locks the current buffer's file")
+     (should (file-locked-p (buffer-file-name)))
+
+     (skip-unless (filelock-tests--make-file-inaccessible temp-dir))
+
+     ;; FIXME: Unlocking buffers should not signal errors related to
+     ;; their lock files (bug#46397).
+     (let ((err (should-error (unlock-buffer))))
+       (should (equal (cl-subseq err 0 2)
+                      '(file-error "Unlocking file")))))))
+
+(defun filelock-tests--yes (&rest _)
+  "Return t."
+  t)
+
+(ert-deftest filelock-tests-kill-buffer-permission-denied ()
+  "Check that `unlock-buffer' fails in directories that cannot be
+modified."
+  (filelock-tests--fixture
+   (lambda (temp-dir)
+     (insert "this should lock the buffer")
+     (should (file-locked-p (buffer-file-name)))
+
+     (skip-unless (filelock-tests--make-file-inaccessible temp-dir))
+
+     ;; Kill the current buffer even if it is modified.  Use advice to
+     ;; fake a "yes" answer for the "Buffer modified; kill anyway?"
+     ;; prompt.  Leave the buffer modified so `kill-buffer' will
+     ;; attempt to unlock the buffer's file.
+     ;;
+     ;; FIXME: Killing buffers should not signal errors related to
+     ;; their lock files (bug#46397).
+     (let ((err (unwind-protect
+                    (progn
+                      (advice-add 'yes-or-no-p
+                                  :override
+                                  'filelock-tests--yes)
+                      (should-error (kill-buffer)))
+                  (advice-remove 'yes-or-no-p 'filelock-tests--yes))))
+       (should (equal (cl-subseq err 0 2)
+                      '(file-error "Unlocking file")))))))
+
+(provide 'filelock-tests)
+;;; filelock-tests.el ends here
-- 
2.30.1