From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Lars Ingebrigtsen Newsgroups: gmane.emacs.bugs Subject: bug#49261: 28.0.50; File Locking Breaks Presumptuous Toolchains Date: Wed, 07 Jul 2021 18:01:25 +0200 Message-ID: <8735sqnmei.fsf@gnus.org> References: <87o8bn7bie.fsf@gnus.org> <87zgv6vuon.fsf@gmx.de> <837di9lwbm.fsf@gnu.org> <87a6n5vuu4.fsf@gnus.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4286"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: Michael Albinus , ncaprisunfan@gmail.com, 49261@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Jul 07 18:03:55 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 1m1A1i-0000qy-Fr for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 07 Jul 2021 18:03:54 +0200 Original-Received: from localhost ([::1]:44452 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m1A1h-0004tR-66 for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 07 Jul 2021 12:03:53 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49544) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m19zv-0002t5-Dr for bug-gnu-emacs@gnu.org; Wed, 07 Jul 2021 12:02:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:41758) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m19zu-0004xs-5D for bug-gnu-emacs@gnu.org; Wed, 07 Jul 2021 12:02:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m19zu-0002sG-1b for bug-gnu-emacs@gnu.org; Wed, 07 Jul 2021 12:02:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 07 Jul 2021 16:02:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49261 X-GNU-PR-Package: emacs Original-Received: via spool by 49261-submit@debbugs.gnu.org id=B49261.162567370211018 (code B ref 49261); Wed, 07 Jul 2021 16:02:01 +0000 Original-Received: (at 49261) by debbugs.gnu.org; 7 Jul 2021 16:01:42 +0000 Original-Received: from localhost ([127.0.0.1]:53304 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m19zZ-0002rd-DD for submit@debbugs.gnu.org; Wed, 07 Jul 2021 12:01:42 -0400 Original-Received: from quimby.gnus.org ([95.216.78.240]:53232) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m19zV-0002rM-Sq for 49261@debbugs.gnu.org; Wed, 07 Jul 2021 12:01:40 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org; s=20200322; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date: References:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=xSp6+PT+637dCCD9WPwAWPuh1PwxK94pvmgGo0ezmfo=; b=dAFdaMZ61puNI5aKR4rCww11dh PhzQ92vYWtRw/i1zGcqEtrgI8cfJTh9qa4tnT/p3fcFK3ILu2UR6+TRIj8709wRZ4LLnM8XVcD6s+ lKkG5CoVPL8gi9gHZmUMvfG2A0eC2Kai7mvUooJjLWVykg4IIeElqERcdNVIUcwBbkUk=; Original-Received: from cm-84.212.220.105.getinternet.no ([84.212.220.105] helo=elva) by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1m19zM-0007at-2E; Wed, 07 Jul 2021 18:01:30 +0200 X-Now-Playing: Yoko Ono's _Feeling the Space_: "Coffin Car" In-Reply-To: <87a6n5vuu4.fsf@gnus.org> (Lars Ingebrigtsen's message of "Fri, 02 Jul 2021 13:06:11 +0200") 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:209592 Archived-At: Lars Ingebrigtsen 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