From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Matt Armstrong Newsgroups: gmane.emacs.bugs Subject: bug#46397: 27.1; Cannot delete buffer pointing to a file in a path that includes a file Date: Sun, 07 Mar 2021 18:18:46 -0800 Message-ID: <87wnuio0ah.fsf@mdeb> References: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39451"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 46397@debbugs.gnu.org, craven@gmx.net To: Paul Eggert , Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Mar 08 03:20:13 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lJ5VE-000A7b-BL for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 08 Mar 2021 03:20:12 +0100 Original-Received: from localhost ([::1]:52586 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lJ5VD-00064P-EL for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 07 Mar 2021 21:20:11 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45272) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lJ5V5-000635-2a for bug-gnu-emacs@gnu.org; Sun, 07 Mar 2021 21:20:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58502) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lJ5V4-0002us-Py for bug-gnu-emacs@gnu.org; Sun, 07 Mar 2021 21:20:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lJ5V4-0007zv-GL for bug-gnu-emacs@gnu.org; Sun, 07 Mar 2021 21:20:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Matt Armstrong Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 08 Mar 2021 02:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 46397 X-GNU-PR-Package: emacs Original-Received: via spool by 46397-submit@debbugs.gnu.org id=B46397.161516994430672 (code B ref 46397); Mon, 08 Mar 2021 02:20:02 +0000 Original-Received: (at 46397) by debbugs.gnu.org; 8 Mar 2021 02:19:04 +0000 Original-Received: from localhost ([127.0.0.1]:41815 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lJ5U7-0007yb-T5 for submit@debbugs.gnu.org; Sun, 07 Mar 2021 21:19:04 -0500 Original-Received: from relay1-d.mail.gandi.net ([217.70.183.193]:11847) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lJ5U2-0007y6-HP for 46397@debbugs.gnu.org; Sun, 07 Mar 2021 21:19:01 -0500 X-Originating-IP: 24.113.169.116 Original-Received: from mdeb (24-113-169-116.wavecable.com [24.113.169.116]) (Authenticated sender: matt@rfc20.org) by relay1-d.mail.gandi.net (Postfix) with ESMTPSA id 85E2B240006; Mon, 8 Mar 2021 02:18:49 +0000 (UTC) In-Reply-To: X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:201795 Archived-At: --=-=-= Content-Type: text/plain Paul Eggert writes: > On 2/19/21 11:10 AM, Matt Armstrong wrote: >> (a) Modify `kill-buffer' to call `unlock-buffer' sooner, closer to the >> point where it is already running hooks prompting the user. Handle >> unlock errors there by prompting. > > How would unlock-buffer's API change, so that kill-buffer and > unlock-buffer's other callers can do the right thing? Would it signal an > error, and if so which one (or a new kind of error)? It turns out that naming a directory the same as the would-be lock file suffices to induce errors in a portable way. I've updated the (substantially simplified) test in patch 0001, incorporating Eli's feedback. Patch 0002 implements the handling of unlock errors as warnings by way of a userlock.el function. I figure that function would be a handy hook for people to use with `debug-on-entry', if they want. Both ready for review now. Things I noticed: a) if a buffer becomes unmodified by way of `undo' it is unlocked twice, causing two warnings. b) the file errors generated contain the original file name, not the lock file name. I am treating both of of those things as not worth fixing, at least for now. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Add-test-coverage-for-src-filelock.c-Bug-46397.patch >From f2969e568b579e49dbe2f73cbf9961d5f32503aa Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Mon, 15 Feb 2021 12:59:08 -0800 Subject: [PATCH 1/2] Add test coverage for src/filelock.c (Bug#46397) * test/src/filelock-tests.el: New file. --- test/src/filelock-tests.el | 173 +++++++++++++++++++++++++++++++++++++ 1 file changed, 173 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..c6f55efd49 --- /dev/null +++ b/test/src/filelock-tests.el @@ -0,0 +1,173 @@ +;;; 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 . + +;;; Commentary: + +;; This file tests code in src/filelock.c and, to some extent, the +;; related code in src/fileio.c. +;; +;; See also (info "(emacs)Interlocking") and (info "(elisp)File Locks") + +;;; Code: + +(require 'cl-macs) +(require 'ert) +(require 'seq) + +(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, then call +TEST-FUNCTION. Finally, delete the buffer and the test +directory." + (let* ((temp-dir (make-temp-file "filelock-tests" t)) + (name (concat (file-name-as-directory temp-dir) + "userfile")) + (create-lockfiles t)) + (unwind-protect + (with-temp-buffer + (setq buffer-file-name name + buffer-file-truename name) + (unwind-protect + (save-current-buffer + (funcall test-function)) + ;; Set `buffer-file-truename' nil to prevent unlocking, + ;; which might prompt the user and/or signal errors. + (setq buffer-file-name nil + buffer-file-truename nil))) + (delete-directory temp-dir t nil)))) + +(defun filelock-tests--make-lock-name (file-name) + "Return the lock file name for FILE-NAME. +Equivalent logic in Emacs proper is implemented in C and +unavailable to Lisp." + (concat (file-name-directory (expand-file-name file-name)) + ".#" + (file-name-nondirectory file-name))) + +(defun filelock-tests--spoil-lock-file (file-name) + "Spoil the lock file for FILE-NAME. +Cause Emacs to report errors for various file locking operations +on FILE-NAME going forward. Create a file that is incompatible +with Emacs' file locking protocol, but uses the same name as +FILE-NAME's lock file. A directory file is used, which is +portable in practice." + (make-directory (filelock-tests--make-lock-name file-name))) + +(defun filelock-tests--unspoil-lock-file (file-name) + "Remove the lock file spoiler for FILE-NAME. +See `filelock-tests--spoil-lock-file'." + (delete-directory (filelock-tests--make-lock-name file-name) t)) + +(defun filelock-tests--should-be-locked () + "Abort the current test if the current buffer is not locked. +Exception: on systems without lock file support, aborts the +current test if the current file is locked (which should never +the case)." + (if (eq system-type 'ms-dos) + (should-not (file-locked-p buffer-file-truename)) + (should (file-locked-p buffer-file-truename)))) + +(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))) + + ;; inserting text should lock the buffer's file. + (insert "this locks the buffer's file") + (filelock-tests--should-be-locked) + (unlock-buffer) + (set-buffer-modified-p nil) + (should-not (file-locked-p (buffer-file-name))) + + ;; `set-buffer-modified-p' should lock the buffer's file. + (set-buffer-modified-p t) + (filelock-tests--should-be-locked) + (unlock-buffer) + (should-not (file-locked-p (buffer-file-name))) + + (should-not (file-locked-p (buffer-file-name)))))) + +(ert-deftest filelock-tests-lock-spoiled () + "Check `lock-buffer' ." + (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support + (filelock-tests--fixture + (lambda () + (filelock-tests--spoil-lock-file buffer-file-truename) + ;; FIXME: errors when locking a file are ignored; should they be? + (set-buffer-modified-p t) + (filelock-tests--unspoil-lock-file buffer-file-truename) + (should-not (file-locked-p buffer-file-truename))))) + +(ert-deftest filelock-tests-file-locked-p-spoiled () + "Check that `file-locked-p' fails if the lockfile is \"spoiled\"." + (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support + (filelock-tests--fixture + (lambda () + (filelock-tests--spoil-lock-file buffer-file-truename) + (let ((err (should-error (file-locked-p (buffer-file-name))))) + (should (equal (seq-subseq err 0 2) + '(file-error "Testing file lock"))))))) + +(ert-deftest filelock-tests-unlock-spoiled () + "Check that `unlock-buffer' fails if the lockfile is \"spoiled\"." + (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support + (filelock-tests--fixture + (lambda () + ;; Set the buffer modified with file locking temporarily + ;; disabled. + (let ((create-lockfiles nil)) + (set-buffer-modified-p t)) + (should-not (file-locked-p buffer-file-truename)) + (filelock-tests--spoil-lock-file buffer-file-truename) + + ;; 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"))))))) + +(ert-deftest filelock-tests-kill-buffer-spoiled () + "Check that `kill-buffer' fails if a lockfile is \"spoiled\"." + (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support + (filelock-tests--fixture + (lambda () + ;; Set the buffer modified with file locking temporarily + ;; disabled. + (let ((create-lockfiles nil)) + (set-buffer-modified-p t)) + (should-not (file-locked-p buffer-file-truename)) + (filelock-tests--spoil-lock-file buffer-file-truename) + + ;; Kill the current buffer. Because the buffer is modified Emacs + ;; will attempt to unlock it. Temporarily bind `yes-or-no-p' to + ;; a function that fakes a "yes" answer for the "Buffer modified; + ;; kill anyway?" prompt. + ;; + ;; FIXME: Killing buffers should not signal errors related to + ;; their lock files (bug#46397). + (let* ((err (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (&rest _) t))) + (should-error (kill-buffer))))) + (should (equal (seq-subseq err 0 2) + '(file-error "Unlocking file"))))))) + +(provide 'filelock-tests) +;;; filelock-tests.el ends here -- 2.30.1 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-File-unlock-errors-now-issue-warnings-Bug-46397.patch >From 7b272d53d603d9f3cfd2421d31e5891723fc2ca1 Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Fri, 19 Feb 2021 15:39:15 -0800 Subject: [PATCH 2/2] File unlock errors now issue warnings (Bug#46397) * lisp/userlock.el (userlock--handle-unlock-error): New function, call `display-error'. * src/filelock.c (unlock_file_body): New function, do what unlock_file() used to. (unlock_file_handle_error): New function, call `userlock--handle-unlock-error' with the captured error. (unlock_file): Use condition case to glue together the above. * test/src/filelock-tests.el (filelock-tests-kill-buffer-spoiled): (filelock-tests-unlock-spoiled): Modify to test new behavior. --- lisp/userlock.el | 9 +++++++++ src/filelock.c | 21 +++++++++++++++++++-- test/src/filelock-tests.el | 34 ++++++++++++++++++++++------------ 3 files changed, 50 insertions(+), 14 deletions(-) diff --git a/lisp/userlock.el b/lisp/userlock.el index a340ff85b2..d33089b11a 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -193,4 +193,13 @@ ask-user-about-supersession-help (with-current-buffer standard-output (help-mode)))) +;;;###autoload +(defun userlock--handle-unlock-error (err) + "Report an error ERR that occurred while unlocking a file." + (display-warning + '(unlock-file) + (message "Error unlocking file, proceeding as if unlocked: %s" + (error-message-string err)) + :warning)) + ;;; userlock.el ends here diff --git a/src/filelock.c b/src/filelock.c index 373fc00a42..1f5bba4447 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -719,8 +719,8 @@ lock_file (Lisp_Object fn) } } -void -unlock_file (Lisp_Object fn) +static Lisp_Object +unlock_file_body (Lisp_Object fn) { char *lfname; USE_SAFE_ALLOCA; @@ -737,6 +737,23 @@ unlock_file (Lisp_Object fn) report_file_errno ("Unlocking file", filename, err); SAFE_FREE (); + return Qnil; +} + +static Lisp_Object +unlock_file_handle_error (Lisp_Object err) +{ + call1 (intern ("userlock--handle-unlock-error"), err); + return Qnil; +} + +void +unlock_file (Lisp_Object fn) +{ + internal_condition_case_1 (unlock_file_body, + fn, + list1(Qfile_error), + unlock_file_handle_error); } #else /* MSDOS */ diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index c6f55efd49..a96d6d6728 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -138,11 +138,16 @@ filelock-tests-unlock-spoiled (should-not (file-locked-p buffer-file-truename)) (filelock-tests--spoil-lock-file buffer-file-truename) - ;; 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"))))))) + ;; Errors from `unlock-buffer' should call + ;; `userlock--handle-unlock-error' (bug#46397). + (let (errors) + (cl-letf (((symbol-function 'userlock--handle-unlock-error) + (lambda (err) (push err errors)))) + (unlock-buffer)) + (should (consp errors)) + (should (equal '(file-error "Unlocking file") + (seq-subseq (car errors) 0 2))) + (should (equal (length errors) 1)))))) (ert-deftest filelock-tests-kill-buffer-spoiled () "Check that `kill-buffer' fails if a lockfile is \"spoiled\"." @@ -161,13 +166,18 @@ filelock-tests-kill-buffer-spoiled ;; a function that fakes a "yes" answer for the "Buffer modified; ;; kill anyway?" prompt. ;; - ;; FIXME: Killing buffers should not signal errors related to - ;; their lock files (bug#46397). - (let* ((err (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (&rest _) t))) - (should-error (kill-buffer))))) - (should (equal (seq-subseq err 0 2) - '(file-error "Unlocking file"))))))) + ;; File errors from unlocking files should call + ;; `userlock--handle-unlock-error' (bug#46397). + (let (errors) + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (&rest _) t)) + ((symbol-function 'userlock--handle-unlock-error) + (lambda (err) (push err errors)))) + (kill-buffer)) + (should (consp errors)) + (should (equal '(file-error "Unlocking file") + (seq-subseq (car errors) 0 2))) + (should (equal (length errors) 1)))))) (provide 'filelock-tests) ;;; filelock-tests.el ends here -- 2.30.1 --=-=-=--