master 9ce6541: Further cleanup for file locks

[Michael Albinus]

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)