mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Further cleanup for file locks

Browse source 
* 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'.
This commit is contained in:
Michael Albinus 2021-07-09 18:14:19 +02:00
parent 2870a72d0d
commit 9ce6541ac9
10 changed files with 123 additions and 109 deletions
Download patch file Download diff file Expand all files Collapse all files

24
doc/misc/tramp.texi
View file

@ -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

50
lisp/dired.el
View file

@ -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 ".*:$")

60
lisp/net/tramp.el
View file

@ -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."

2
src/buffer.c
View file

@ -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);
}

2
src/fileio.c
View file

@ -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;
}

74
src/filelock.c
View file

@ -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);

2
src/insdel.c
View file

@ -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). */

1
src/lisp.h
View file

@ -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);

15
test/lisp/net/tramp-tests.el
View file

@ -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)))

2
test/lisp/shadowfile-tests.el
View file

@ -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)