From: Michael Albinus Date: Fri, 9 Jul 2021 16:14:19 +0000 (+0200) Subject: Further cleanup for file locks X-Git-Tag: emacs-28.0.90~1915 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9ce6541ac9710933beca7f9944087fe4849d5ae9;p=emacs.git 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'. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6ef9459077e..8ba5f0118a3 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 9ddd2c542dc..fb353a92e45 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 7578d6fe308..fc714c9339a 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 3cd47fede36..bbb0edd792c 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 30e6caf7ea5..04c9d7d4af3 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 9f1968f07de..106633f5846 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 e38b091f542..e66120eb08a 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 ce4b80a27ec..1795b9d811b 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 0e70f8e1d23..44fd1b45b26 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 84a9479480e..268bb64f241 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)