[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 9ce6541: Further cleanup for file locks
From: |
Michael Albinus |
Subject: |
master 9ce6541: Further cleanup for file locks |
Date: |
Fri, 9 Jul 2021 12:14:27 -0400 (EDT) |
branch: master
commit 9ce6541ac9710933beca7f9944087fe4849d5ae9
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Further cleanup for file locks
* doc/misc/tramp.texi (Top, Configuration): Adapt node name for
file locks.
(Auto-save File Lock and Backup): Rename node name and section
title. Add file-lock to @cindex. Describe file locks.
* lisp/dired.el (dired-trivial-filenames): Add lock files.
(dired-font-lock-keywords): Move files suffixed with
`completion-ignored-extensions' up. Add lock files to these checks.
* lisp/net/tramp.el (tramp-get-lock-file, tramp-handle-unlock-file):
Use `when-let'
(tramp-lock-file-info-regexp): Rename from
`tramp-lock-file-contents-regexp'.
(tramp-handle-file-locked-p, tramp-handle-lock-file): Adapt callees.
(tramp-handle-lock-file): Set file modes of lockname.
* src/buffer.c (Frestore_buffer_modified_p):
* src/fileio.c (write_region):
* src/insdel.c (prepare_to_modify_buffer_1): Call Flock_file.
* src/filelock.c (Qmake_lock_file_name): Declare symbol.
(make_lock_file_name): Use it. Don't check Fboundp, it doesn't
work for interned symbols.
(lock_file): Return a Lisp_Object. Don't check create_lockfiles.
Remove MSDOS version of the function.
(Flock_file): Check create_lockfiles.
(Flock_buffer): Call Flock_file.
* src/lisp.h (lock_file): Remove.
* test/lisp/shadowfile-tests.el (shadow-test08-shadow-todo)
(shadow-test09-shadow-copy-files): Let-bind `create-lockfiles'.
* test/lisp/net/tramp-tests.el (create-lockfiles): Don't set it
globally.
(tramp-test39-lock-file): Check also for `set-visited-file-name'.
---
doc/misc/tramp.texi | 24 +++++++++++---
lisp/dired.el | 50 +++++++++++++++--------------
lisp/net/tramp.el | 60 ++++++++++++++++++-----------------
src/buffer.c | 2 +-
src/fileio.c | 2 +-
src/filelock.c | 74 ++++++++++++++++++++-----------------------
src/insdel.c | 2 +-
src/lisp.h | 1 -
test/lisp/net/tramp-tests.el | 15 ++++-----
test/lisp/shadowfile-tests.el | 2 ++
10 files changed, 123 insertions(+), 109 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 6ef9459..8ba5f01 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -142,7 +142,8 @@ Configuring @value{tramp} for use
* Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@@ -691,7 +692,8 @@ may be used in your init file:
* Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -2745,9 +2747,10 @@ Open a remote connection with a more concise command
@kbd{C-x C-f
@end itemize
-@node Auto-save and Backup
-@section Auto-save and Backup configuration
+@node Auto-save File Lock and Backup
+@section Auto-save, File Lock and Backup configuration
@cindex auto-save
+@cindex file-lock
@cindex backup
@vindex backup-directory-alist
@@ -2842,6 +2845,19 @@ auto-saved files to the same directory as the original
file.
Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location.
+@vindex lock-file-name-transforms
+And still more issues to handle. Since @w{Emacs 28}, file locks use a
+similar user option as auto-save files, called
+@code{lock-file-name-transforms}. By default this user option is
+@code{nil}, meaning to keep file locks in the same directory as the
+original file.
+
+If you change @code{lock-file-name-transforms} in order to keep file
+locks for remote files somewhere else, you will loose Emacs' feature
+to warn you, if a file is changed in parallel from different Emacs
+sessions, or via different remote connections. Be careful with such
+settings.
+
@vindex tramp-allow-unsafe-temporary-files
Per default, @value{tramp} asks for confirmation if a
@samp{root}-owned backup or auto-save remote file has to be written to
diff --git a/lisp/dired.el b/lisp/dired.el
index 9ddd2c5..fb353a9 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -163,7 +163,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
-(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
+(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#")
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@@ -615,6 +615,31 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;;
+ ;; Files suffixed with `completion-ignored-extensions'.
+ '(eval .
+ ;; It is quicker to first find just an extension, then go back to the
+ ;; start of that file name. So we do this complex MATCH-ANCHORED form.
+ (list (concat
+ "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)$")
+ '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
+ ;;
+ ;; Files suffixed with `completion-ignored-extensions'
+ ;; plus a character put in by -F.
+ '(eval .
+ (list (concat "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)[*=|]$")
+ '(".+" (progn
+ (end-of-line)
+ ;; If the last character is not part of the filename,
+ ;; move back to the start of the filename
+ ;; so it can be fontified.
+ ;; Otherwise, leave point at the end of the line;
+ ;; that way, nothing is fontified.
+ (unless (get-text-property (1- (point)) 'mouse-face)
+ (dired-move-to-filename)))
+ nil (0 dired-ignored-face))))
+ ;;
;; Broken Symbolic link.
(list dired-re-sym
(list (lambda (end)
@@ -659,29 +684,6 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-special
'(".+" (dired-move-to-filename) nil (0 'dired-special)))
;;
- ;; Files suffixed with `completion-ignored-extensions'.
- '(eval .
- ;; It is quicker to first find just an extension, then go back to the
- ;; start of that file name. So we do this complex MATCH-ANCHORED form.
- (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
- '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
- ;;
- ;; Files suffixed with `completion-ignored-extensions'
- ;; plus a character put in by -F.
- '(eval .
- (list (concat "\\(" (regexp-opt completion-ignored-extensions)
- "\\|#\\)[*=|]$")
- '(".+" (progn
- (end-of-line)
- ;; If the last character is not part of the filename,
- ;; move back to the start of the filename
- ;; so it can be fontified.
- ;; Otherwise, leave point at the end of the line;
- ;; that way, nothing is fontified.
- (unless (get-text-property (1- (point)) 'mouse-face)
- (dired-move-to-filename)))
- nil (0 dired-ignored-face))))
- ;;
;; Explicitly put the default face on file names ending in a colon to
;; avoid fontifying them as directory header.
(list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7578d6f..fc714c9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3819,9 +3819,9 @@ User is always nil."
(cons (expand-file-name filename) (cdr result)))))
(defun tramp-get-lock-file (file)
- "Read lockfile of FILE.
-Return nil when there is no lockfile"
- (let ((lockname (tramp-compat-make-lock-file-name file)))
+ "Read lockfile info of FILE.
+Return nil when there is no lockfile."
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
(or (file-symlink-p lockname)
(and (file-readable-p lockname)
(with-temp-buffer
@@ -3839,51 +3839,53 @@ Return nil when there is no lockfile"
(or (process-id p)
(tramp-get-connection-property p "lock-pid" (emacs-pid))))))
-(defconst tramp-lock-file-contents-regexp
+(defconst tramp-lock-file-info-regexp
;; USER@HOST.PID[:BOOT_TIME]
"\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
"Like `file-locked-p' for Tramp files."
- (when-let ((contents (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-contents-regexp contents)))
- (or (and (string-equal (match-string 1 contents) (user-login-name))
- (string-equal (match-string 2 contents) (system-name))
- (string-equal (match-string 3 contents) (tramp-get-lock-pid file)))
- (match-string 1 contents))))
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
+ (or (and (string-equal (match-string 1 info) (user-login-name))
+ (string-equal (match-string 2 info) (system-name))
+ (string-equal (match-string 3 info) (tramp-get-lock-pid file)))
+ (match-string 1 info))))
(defun tramp-handle-lock-file (file)
"Like `lock-file' for Tramp files."
;; See if this file is visited and has changed on disk since it
;; was visited.
(catch 'dont-lock
- (unless (or (null create-lockfiles)
- (eq (file-locked-p file) t)) ;; Locked by me.
- (when-let ((contents (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-contents-regexp
contents)))
+ (unless (eq (file-locked-p file) t) ;; Locked by me.
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
(unless (ask-user-about-lock
file (format
- "%s@%s (pid %s)" (match-string 1 contents)
- (match-string 2 contents) (match-string 3 contents)))
+ "%s@%s (pid %s)" (match-string 1 info)
+ (match-string 2 info) (match-string 3 info)))
(throw 'dont-lock nil)))
- (let ((lockname (tramp-compat-make-lock-file-name file))
- ;; USER@HOST.PID[:BOOT_TIME]
- (contents
- (format
- "%s@%s.%s" (user-login-name) (system-name)
- (tramp-get-lock-pid file)))
- create-lockfiles signal-hook-function)
- (condition-case nil
- (make-symbolic-link contents lockname 'ok-if-already-exists)
- (error (write-region contents nil lockname)))))))
+ (when-let ((lockname (tramp-compat-make-lock-file-name file))
+ ;; USER@HOST.PID[:BOOT_TIME]
+ (info
+ (format
+ "%s@%s.%s" (user-login-name) (system-name)
+ (tramp-get-lock-pid file))))
+ (let (create-lockfiles signal-hook-function)
+ (condition-case nil
+ (make-symbolic-link info lockname 'ok-if-already-exists)
+ (error
+ (write-region info nil lockname)
+ (set-file-modes lockname #o0644))))))))
(defun tramp-handle-unlock-file (file)
"Like `unlock-file' for Tramp files."
- (condition-case err
- (delete-file (tramp-compat-make-lock-file-name file))
- (error (userlock--handle-unlock-error err))))
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (condition-case err
+ (delete-file lockname)
+ (error (userlock--handle-unlock-error err)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix
must-suffix)
"Like `load' for Tramp files."
diff --git a/src/buffer.c b/src/buffer.c
index 3cd47fe..bbb0edd 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1449,7 +1449,7 @@ state of the current buffer. Use with care. */)
{
bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
- lock_file (fn);
+ Flock_file (fn);
else if (already && NILP (flag))
Funlock_file (fn);
}
diff --git a/src/fileio.c b/src/fileio.c
index 30e6caf..04c9d7d 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5168,7 +5168,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
if (open_and_close_file && !auto_saving)
{
- lock_file (lockname);
+ Flock_file (lockname);
file_locked = 1;
}
diff --git a/src/filelock.c b/src/filelock.c
index 9f1968f..106633f 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -622,10 +622,7 @@ lock_if_free (lock_info_type *clasher, char *lfname)
static Lisp_Object
make_lock_file_name (Lisp_Object fn)
{
- Lisp_Object func = intern ("make-lock-file-name");
- if (NILP (Fboundp (func)))
- return Qnil;
- return call1 (func, Fexpand_file_name (fn, Qnil));
+ return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil));
}
/* lock_file locks file FN,
@@ -646,7 +643,7 @@ make_lock_file_name (Lisp_Object fn)
This function can signal an error, or return t meaning
take away the lock, or return nil meaning ignore the lock. */
-void
+static Lisp_Object
lock_file (Lisp_Object fn)
{
lock_info_type lock_info;
@@ -655,7 +652,7 @@ lock_file (Lisp_Object fn)
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
if (will_dump_p ())
- return;
+ return Qnil;
/* If the file name has special constructs in it,
call the corresponding file name handler. */
@@ -663,13 +660,12 @@ lock_file (Lisp_Object fn)
handler = Ffind_file_name_handler (fn, Qlock_file);
if (!NILP (handler))
{
- call2 (handler, Qlock_file, fn);
- return;
+ return call2 (handler, Qlock_file, fn);
}
Lisp_Object lock_filename = make_lock_file_name (fn);
if (NILP (lock_filename))
- return;
+ return Qnil;
char *lfname = SSDATA (ENCODE_FILE (lock_filename));
/* See if this file is visited and has changed on disk since it was
@@ -678,32 +674,29 @@ lock_file (Lisp_Object fn)
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (lock_filename))
- && !(create_lockfiles && current_lock_owner (NULL, lfname) == -2))
+ && 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 (create_lockfiles)
+ /* Try to lock the lock. FIXME: This ignores errors when
+ lock_if_free returns a positive errno value. */
+ if (lock_if_free (&lock_info, lfname) < 0)
{
- /* Try to lock the lock. FIXME: This ignores errors when
- lock_if_free returns a positive errno value. */
- if (lock_if_free (&lock_info, lfname) < 0)
- {
- /* Someone else has the lock. Consider breaking it. */
- Lisp_Object attack;
- char *dot = lock_info.dot;
- ptrdiff_t pidlen = lock_info.colon - (dot + 1);
- static char const replacement[] = " (pid ";
- int replacementlen = sizeof replacement - 1;
- memmove (dot + replacementlen, dot + 1, pidlen);
- strcpy (dot + replacementlen + pidlen, ")");
- memcpy (dot, replacement, replacementlen);
- attack = call2 (intern ("ask-user-about-lock"), fn,
- build_string (lock_info.user));
- /* Take the lock if the user said so. */
- if (!NILP (attack))
- lock_file_1 (lfname, 1);
- }
+ /* Someone else has the lock. Consider breaking it. */
+ Lisp_Object attack;
+ char *dot = lock_info.dot;
+ ptrdiff_t pidlen = lock_info.colon - (dot + 1);
+ static char const replacement[] = " (pid ";
+ int replacementlen = sizeof replacement - 1;
+ memmove (dot + replacementlen, dot + 1, pidlen);
+ strcpy (dot + replacementlen + pidlen, ")");
+ memcpy (dot, replacement, replacementlen);
+ attack = call2 (intern ("ask-user-about-lock"), fn,
+ build_string (lock_info.user));
+ /* Take the lock if the user said so. */
+ if (!NILP (attack))
+ lock_file_1 (lfname, 1);
}
+ return Qnil;
}
static Lisp_Object
@@ -732,12 +725,6 @@ unlock_file_handle_error (Lisp_Object err)
return Qnil;
}
-#else /* MSDOS */
-void
-lock_file (Lisp_Object fn)
-{
-}
-
#endif /* MSDOS */
void
@@ -760,8 +747,14 @@ DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0,
If the option `create-lockfiles' is nil, this does nothing. */)
(Lisp_Object file)
{
- CHECK_STRING (file);
- lock_file (file);
+#ifndef MSDOS
+ /* Don't do locking if the user has opted out. */
+ if (create_lockfiles)
+ {
+ CHECK_STRING (file);
+ lock_file (file);
+ }
+#endif /* MSDOS */
return Qnil;
}
@@ -805,7 +798,7 @@ If the option `create-lockfiles' is nil, this does nothing.
*/)
CHECK_STRING (file);
if (SAVE_MODIFF < MODIFF
&& !NILP (file))
- lock_file (file);
+ Flock_file (file);
return Qnil;
}
@@ -892,6 +885,7 @@ Info node `(emacs)Interlocking'. */);
DEFSYM (Qlock_file, "lock-file");
DEFSYM (Qunlock_file, "unlock-file");
DEFSYM (Qfile_locked_p, "file-locked-p");
+ DEFSYM (Qmake_lock_file_name, "make-lock-file-name");
defsubr (&Slock_file);
defsubr (&Sunlock_file);
diff --git a/src/insdel.c b/src/insdel.c
index e38b091..e66120e 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1989,7 +1989,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t
end,
/* Make binding buffer-file-name to nil effective. */
&& !NILP (BVAR (base_buffer, filename))
&& SAVE_MODIFF >= MODIFF)
- lock_file (BVAR (base_buffer, file_truename));
+ Flock_file (BVAR (base_buffer, file_truename));
/* If `select-active-regions' is non-nil, save the region text. */
/* FIXME: Move this to Elisp (via before-change-functions). */
diff --git a/src/lisp.h b/src/lisp.h
index ce4b80a..1795b9d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4621,7 +4621,6 @@ extern int str_collate (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern void syms_of_sysdep (void);
/* Defined in filelock.c. */
-extern void lock_file (Lisp_Object);
extern void unlock_all_files (void);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 0e70f8e..44fd1b4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -122,7 +122,6 @@
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
- create-lockfiles nil
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
tramp-persistency-file-name nil
@@ -5794,16 +5793,16 @@ Use direct async.")
;; Quit the file lock machinery.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
- (should-error (lock-file tmp-name) :type 'file-locked))
- (should (stringp (file-locked-p tmp-name)))
-
- ;; The same for `write-region'.
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
+ (should-error (lock-file tmp-name) :type 'file-locked)
+ ;; The same for `write-region'.
(should-error (write-region "foo" nil tmp-name) :type
'file-locked)
(should-error
(write-region "foo" nil tmp-name nil nil tmp-name)
- :type 'file-locked))
+ :type 'file-locked)
+ ;; The same for `set-visited-file-name'.
+ (with-temp-buffer
+ (should-error
+ (set-visited-file-name tmp-name) :type 'file-locked)))
(should (stringp (file-locked-p tmp-name)))
(should-not (file-exists-p tmp-name)))
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 84a9479..268bb64 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -732,6 +732,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
@@ -877,6 +878,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 9ce6541: Further cleanup for file locks,
Michael Albinus <=