Package: emacs;
Reported by: Mallchad Skeghyeph <ncaprisunfan <at> gmail.com>
Date: Mon, 28 Jun 2021 18:28:02 UTC
Severity: normal
Found in version 28.0.50
Fixed in version 28.1
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Lars Ingebrigtsen <larsi <at> gnus.org> To: Eli Zaretskii <eliz <at> gnu.org> Cc: Michael Albinus <michael.albinus <at> gmx.de>, ncaprisunfan <at> gmail.com, 49261 <at> debbugs.gnu.org Subject: bug#49261: 28.0.50; File Locking Breaks Presumptuous Toolchains Date: Wed, 07 Jul 2021 18:01:25 +0200
Lars Ingebrigtsen <larsi <at> gnus.org> writes:
> If not, I'll get to it early next week.
Is Wednesday still "early"?
Anyway, I've now implemented this. The biggest part of this is
refactoring out the `auto-save-file-name-transforms' handling so that it
can be used by the lock handling code, too.
I'd like to have more eyes on this before I commit. It seems to work
fine after some light testing, but I'm not completely confident about
the ENCODE_FILE/ALLOCA bits in the C code.
So if somebody could give that a look-over while I'm writing up the
documentation, that'd be great. :-)
diff --git a/lisp/files.el b/lisp/files.el
index 859c193db9..ba588842a2 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -412,6 +412,21 @@ auto-save-file-name-transforms
:initialize 'custom-initialize-delay
:version "21.1")
+(defcustom lock-file-name-transforms nil
+ "Transforms to apply to buffer file name before making a lock file name.
+This has the same syntax as
+`auto-save-file-name-transforms' (which see), but instead of
+applying to auto-save file names, it's applied to lock file names.
+
+By default, a lock file is put into the same directory as the
+file it's locking, and it has the same name, but with \".#\" prepended."
+ :group 'files
+ :type '(repeat (list (regexp :tag "Regexp")
+ (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
+ :initialize 'custom-initialize-delay
+ :version "28.1")
+
(defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
(defcustom auto-save-visited-interval 5
@@ -6668,63 +6683,11 @@ make-auto-save-file-name
'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
- (let ((list auto-save-file-name-transforms)
- (filename buffer-file-name)
- result uniq)
- ;; Apply user-specified translations
- ;; to the file name.
- (while (and list (not result))
- (if (string-match (car (car list)) filename)
- (setq result (replace-match (cadr (car list)) t nil
- filename)
- uniq (car (cddr (car list)))))
- (setq list (cdr list)))
- (if result
- (setq filename
- (cond
- ((memq uniq (secure-hash-algorithms))
- (concat
- (file-name-directory result)
- (secure-hash uniq filename)))
- (uniq
- (concat
- (file-name-directory result)
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string
- "!" "!!" filename))))
- (t result))))
- (setq result
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits
- ;; before doing anything else, because the regexp
- ;; passed to string-match below cannot handle
- ;; extensions longer than 3 characters, multiple
- ;; dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match
- "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
- fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
- ;; Make sure auto-save file names don't contain characters
- ;; invalid for the underlying filesystem.
- (if (and (memq system-type '(ms-dos windows-nt cygwin))
- ;; Don't modify remote filenames
- (not (file-remote-p result)))
- (convert-standard-filename result)
- result))))
-
+ (auto-save--transform-file-name buffer-file-name
+ auto-save-file-name-transforms
+ "#" "#")))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
-
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
@@ -6772,6 +6735,71 @@ make-auto-save-file-name
(file-error nil))
file-name)))
+(defun auto-save--transform-file-name (filename transforms
+ prefix suffix)
+ "Transform FILENAME according to TRANSFORMS.
+See `auto-save-file-name-transforms' for the format of
+TRANSFORMS. PREFIX is prepended to the non-directory portion of
+the resulting file name, and SUFFIX is appended."
+ (let (result uniq)
+ ;; Apply user-specified translations
+ ;; to the file name.
+ (while (and transforms (not result))
+ (if (string-match (car (car transforms)) filename)
+ (setq result (replace-match (cadr (car transforms)) t nil
+ filename)
+ uniq (car (cddr (car transforms)))))
+ (setq transforms (cdr transforms)))
+ (when result
+ (setq filename
+ (cond
+ ((memq uniq (secure-hash-algorithms))
+ (concat
+ (file-name-directory result)
+ (secure-hash uniq filename)))
+ (uniq
+ (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string
+ "!" "!!" filename))))
+ (t result))))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits
+ ;; before doing anything else, because the regexp
+ ;; passed to string-match below cannot handle
+ ;; extensions longer than 3 characters, multiple
+ ;; dots, and other atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ prefix (match-string 1 fn)
+ "." (match-string 3 fn) suffix))
+ (concat (file-name-directory filename)
+ prefix
+ (file-name-nondirectory filename)
+ suffix)))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ ;; Don't modify remote filenames
+ (not (file-remote-p result)))
+ (convert-standard-filename result)
+ result)))
+
+(defun make-lock-file-name (filename)
+ "Make a lock file name for FILENAME.
+By default, this just prepends \".*\" to the non-directory part
+of FILENAME, but the transforms in `lock-file-name-transforms'
+are done first."
+ (auto-save--transform-file-name filename lock-file-name-transforms ".#" ""))
+
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes.
diff --git a/src/filelock.c b/src/filelock.c
index 446a262a1c..3c6e6b4942 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -294,25 +294,6 @@ get_boot_time_1 (const char *filename, bool newest)
char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
} lock_info_type;
-/* Write the name of the lock file for FNAME into LOCKNAME. Length
- will be that of FNAME plus two more for the leading ".#", plus one
- for the null. */
-#define MAKE_LOCK_NAME(lockname, fname) \
- (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
- fill_in_lock_file_name (lockname, fname))
-
-static void
-fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
-{
- char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
- char *base = last_slash + 1;
- ptrdiff_t dirlen = base - SSDATA (fn);
- memcpy (lockfile, SSDATA (fn), dirlen);
- lockfile[dirlen] = '.';
- lockfile[dirlen + 1] = '#';
- strcpy (lockfile + dirlen + 2, base);
-}
-
/* For some reason Linux kernels return EPERM on file systems that do
not support hard or symbolic links. This symbol documents the quirk.
There is no way to tell whether a symlink call fails due to
@@ -639,6 +620,12 @@ lock_if_free (lock_info_type *clasher, char *lfname)
return err;
}
+static Lisp_Object
+make_lock_file_name (Lisp_Object fn)
+{
+ return ENCODE_FILE (call1 (intern ("make-lock-file-name"), fn));
+}
+
/* lock_file locks file FN,
meaning it serves notice on the world that you intend to edit that file.
This should be done only when about to modify a file-visiting
@@ -660,10 +647,9 @@ lock_if_free (lock_info_type *clasher, char *lfname)
void
lock_file (Lisp_Object fn)
{
- Lisp_Object orig_fn, encoded_fn;
+ Lisp_Object orig_fn;
char *lfname = NULL;
lock_info_type lock_info;
- USE_SAFE_ALLOCA;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
@@ -672,29 +658,25 @@ lock_file (Lisp_Object fn)
return;
orig_fn = fn;
- fn = Fexpand_file_name (fn, Qnil);
+ fn = make_lock_file_name (Fexpand_file_name (fn, Qnil));
#ifdef WINDOWSNT
/* Ensure we have only '/' separators, to avoid problems with
looking (inside fill_in_lock_file_name) for backslashes in file
names encoded by some DBCS codepage. */
dostounix_filename (SSDATA (fn));
#endif
- encoded_fn = ENCODE_FILE (fn);
- if (create_lockfiles)
- /* Create the name of the lock-file for file fn */
- MAKE_LOCK_NAME (lfname, encoded_fn);
-
+ lfname = SSDATA (fn);
/* See if this file is visited and has changed on disk since it was
visited. */
Lisp_Object subject_buf = get_truename_buffer (orig_fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))
- && !(lfname && current_lock_owner (NULL, lfname) == -2))
+ && !(create_lockfiles && current_lock_owner (NULL, lfname) == -2))
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
/* Don't do locking if the user has opted out. */
- if (lfname)
+ if (create_lockfiles)
{
/* Try to lock the lock. FIXME: This ignores errors when
lock_if_free returns a positive errno value. */
@@ -715,7 +697,6 @@ lock_file (Lisp_Object fn)
if (!NILP (attack))
lock_file_1 (lfname, 1);
}
- SAFE_FREE ();
}
}
@@ -723,12 +704,9 @@ lock_file (Lisp_Object fn)
unlock_file_body (Lisp_Object fn)
{
char *lfname;
- USE_SAFE_ALLOCA;
-
- Lisp_Object filename = Fexpand_file_name (fn, Qnil);
- fn = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, fn);
+ Lisp_Object filename = make_lock_file_name (Fexpand_file_name (fn, Qnil));
+ lfname = SSDATA (filename);
int err = current_lock_owner (0, lfname);
if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
@@ -736,7 +714,6 @@ unlock_file_body (Lisp_Object fn)
if (0 < err)
report_file_errno ("Unlocking file", filename, err);
- SAFE_FREE ();
return Qnil;
}
@@ -842,11 +819,10 @@ DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
char *lfname;
int owner;
lock_info_type locker;
- USE_SAFE_ALLOCA;
filename = Fexpand_file_name (filename, Qnil);
- Lisp_Object encoded_filename = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, encoded_filename);
+ Lisp_Object lockname = make_lock_file_name (filename);
+ lfname = SSDATA (lockname);
owner = current_lock_owner (&locker, lfname);
switch (owner)
@@ -857,7 +833,6 @@ DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
default: report_file_errno ("Testing file lock", filename, owner);
}
- SAFE_FREE ();
return ret;
#endif
}
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 257cbc2d32..b97e0256fb 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -949,6 +949,44 @@ files-tests-file-name-non-special-make-auto-save-file-name
(make-auto-save-file-name)
(kill-buffer)))))))
+(ert-deftest files-test-auto-save-name-default ()
+ (with-temp-buffer
+ (let ((auto-save-file-name-transforms nil))
+ (setq buffer-file-name "/tmp/foo.txt")
+ (should (equal (make-auto-save-file-name) "/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-transform ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil))))
+ (should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-unique ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
+ (should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#")))
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
+ (should (equal (make-auto-save-file-name)
+ "/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
+
+(ert-deftest files-test-lock-name-default ()
+ (let ((lock-file-name-transforms nil))
+ (should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt"))))
+
+(ert-deftest files-test-lock-name-unique ()
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
+ (should (equal (make-lock-file-name "/tmp/foo.txt")
+ "/var/tmp/.#!tmp!foo.txt")))
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
+ (should (equal (make-lock-file-name "/tmp/foo.txt")
+ "/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
+
(ert-deftest files-tests-file-name-non-special-make-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
(let ((default-directory nospecial-dir))
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.