From d35868bec96718705c9bc8aaac3bc583c837033f Mon Sep 17 00:00:00 2001
From: Michael Albinus <michael.albinus@gmx.de>
Date: Wed, 7 Jul 2021 18:36:53 +0200
Subject: [PATCH] Implement file locks for remote files (Bug#49261)

* doc/lispref/files.texi (Magic File Names): Add file-locked-p,
lock-file and unlock-file.

* etc/NEWS: Tramp supports file locks now.

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-adb-handle-write-region): Handle LOCKNAME.

* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.

* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-crypt-handle-file-locked-p, tramp-crypt-handle-lock-file)
(tramp-crypt-handle-unlock-file): New defun.

* lisp/net/tramp-fuse.el (tramp-fuse-mounted-p): Simplify.
(tramp-fuse-unmount): New defun.

* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-gvfs-maybe-open-connection): Set "lock-pid" connection property.

* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-rclone-maybe-open-connection): Set "lock-pid" connection property.

* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-sh-handle-write-region): Handle LOCKNAME.

* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-smb-handle-copy-directory): Use `sleep-for'.
(tramp-smb-handle-write-region): Handle LOCKNAME.

* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-sshfs-handle-write-region): Handle LOCKNAME.
(tramp-sshfs-maybe-open-connection): Set "lock-pid" connection property.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-sudoedit-maybe-open-connection):
Set "lock-pid" connection property.

* lisp/net/tramp.el (tramp-file-name-for-operation):
Add `file-locked-p', `lock-file' and `unlock-file'.
(tramp-make-lock-name, tramp-get-lock-file, tramp-get-lock-pid)
(tramp-handle-file-locked-p, tramp-handle-lock-file)
(tramp-handle-unlock-file): New defuns.
(tramp-lock-file-contents-regexp): New regexp.
(tramp-handle-write-region): Handle LOCKNAME.

* src/filelock.c (lock_file, unlock_file_body, Ffile_locked_p):
Call handler if exists.
(Flock_file, Funlock_file): New defuns.
(Qlock_file, Qunlock_file, Qfile_locked_p): Declare symbols.
(Slock_file, Sunlock_file): Declare subroutines.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test40-make-nearby-temp-file)
(tramp-archive-test43-file-system-info): Rename.

* test/lisp/net/tramp-tests.el (top): Set `create-lockfiles' to nil.
(tramp--test-fuse-p): New defun.
(tramp-test14-delete-directory): Use it.
(tramp-test39-lock-file): New test.
(tramp-test40-make-nearby-temp-file)
(tramp-test41-special-characters)
(tramp-test41-special-characters-with-stat)
(tramp-test41-special-characters-with-perl)
(tramp-test41-special-characters-with-ls, tramp-test42-utf8)
(tramp-test42-utf8-with-stat, tramp-test42-utf8-with-perl)
(tramp-test42-utf8-with-ls, tramp-test43-file-system-info)
(tramp-test44-asynchronous-requests, tramp-test45-auto-load)
(tramp-test45-delay-load, tramp-test45-recursive-load)
(tramp-test45-remote-load-path, tramp-test46-unload): Rename.
(tramp--test-special-characters, tramp--test-utf8)
(tramp--test-asynchronous-requests-timeout): Modify docstring.
---
 doc/lispref/files.texi               |  10 ++-
 etc/NEWS                             |   6 +-
 lisp/net/tramp-adb.el                |  30 +++++--
 lisp/net/tramp-archive.el            |   3 +
 lisp/net/tramp-cache.el              |   2 +
 lisp/net/tramp-crypt.el              |  18 ++++
 lisp/net/tramp-fuse.el               |  17 +++-
 lisp/net/tramp-gvfs.el               |   6 ++
 lisp/net/tramp-rclone.el             |   7 ++
 lisp/net/tramp-sh.el                 |  26 +++++-
 lisp/net/tramp-smb.el                |  28 +++++-
 lisp/net/tramp-sshfs.el              |  46 +++++++---
 lisp/net/tramp-sudoedit.el           |   7 ++
 lisp/net/tramp.el                    | 109 ++++++++++++++++++++---
 src/filelock.c                       |  58 ++++++++++++-
 test/lisp/net/tramp-archive-tests.el |   4 +-
 test/lisp/net/tramp-tests.el         | 125 +++++++++++++++++++++------
 17 files changed, 432 insertions(+), 70 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5238597a465..ae763a21afe 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3273,7 +3273,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-equal-p},
 @code{file-executable-p}, @code{file-exists-p},
 @code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
 @code{file-modes}, @code{file-name-all-completions},
 @code{file-name-as-directory},
 @code{file-name-case-insensitive-p},
@@ -3292,7 +3292,7 @@ first, before handlers for jobs such as remote file access.
 @code{get-file-buffer},
 @code{insert-directory},
 @code{insert-file-contents},@*
-@code{load},
+@code{load}, @code{lock-file},
 @code{make-auto-save-file-name},
 @code{make-directory},
 @code{make-directory-internal},
@@ -3307,6 +3307,7 @@ first, before handlers for jobs such as remote file access.
 @code{substitute-in-file-name},@*
 @code{temporary-file-directory},
 @code{unhandled-file-name-directory},
+@code{unlock-file},
 @code{vc-registered},
 @code{verify-visited-file-modtime},@*
 @code{write-region}.
@@ -3331,7 +3332,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-equal-p},
 @code{file-executable-p}, @code{file-exists-p},
 @code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
 @code{file-modes}, @code{file-name-all-completions},
 @code{file-name-as-directory},
 @code{file-name-case-insensitive-p},
@@ -3350,7 +3351,7 @@ first, before handlers for jobs such as remote file access.
 @code{get-file-buffer},
 @code{insert-directory},
 @code{insert-file-contents},
-@code{load},
+@code{load}, @code{lock-file},
 @code{make-auto-save-file-name},
 @code{make-direc@discretionary{}{}{}tory},
 @code{make-direc@discretionary{}{}{}tory-internal},
@@ -3363,6 +3364,7 @@ first, before handlers for jobs such as remote file access.
 @code{start-file-process},
 @code{substitute-in-file-name},
 @code{unhandled-file-name-directory},
+@code{unlock-file},
 @code{vc-regis@discretionary{}{}{}tered},
 @code{verify-visited-file-modtime},
 @code{write-region}.
diff --git a/etc/NEWS b/etc/NEWS
index 7bf8c1d8f56..0e8a846408e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -323,6 +323,7 @@ emulators by using the new input-meta-mode with the special value
 ** New frame parameter 'drag-with-tab-line'.
 This parameter, similar to 'drag-with-header-line', allows moving frames
 by dragging the tab lines of their topmost windows with the mouse.
+
 
 * Editing Changes in Emacs 28.1
 
@@ -1467,6 +1468,9 @@ rare cases) Tramp blocks Emacs, and we need further debug information.
 directory must be confirmed.  In order to suppress this confirmation,
 set user option 'tramp-allow-unsafe-temporary-files' to t.
 
++++
+*** Tramp supports file locks now.
+
 ** Tempo
 
 ---
@@ -2932,7 +2936,7 @@ The former is now declared obsolete.
 * Lisp Changes in Emacs 28.1
 
 ---
-*** :safe settings in 'defcustom' are now propagated to the loaddefs files.
+*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
 
 +++
 ** New function 'syntax-class-to-char'.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index f9569523d94..9c1c8aca1ca 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -133,6 +133,7 @@ It is used for TCP/IP devices."
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-adb-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-adb-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -159,6 +160,7 @@ It is used for TCP/IP devices."
     (insert-directory . tramp-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-adb-handle-make-directory)
     (make-directory-internal . ignore)
@@ -180,6 +182,7 @@ It is used for TCP/IP devices."
     (tramp-get-remote-uid . ignore)
     (tramp-set-file-uid-gid . ignore)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-adb-handle-write-region))
@@ -533,9 +536,10 @@ But handle the case, if the \"test\" command is not available."
 		       rw-path)))))))
 
 (defun tramp-adb-handle-write-region
-  (start end filename &optional append visit _lockname mustbenew)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
+  (setq filename (expand-file-name filename)
+	lockname (file-truename (or lockname filename)))
   (with-parsed-tramp-file-name filename nil
     (when (and mustbenew (file-exists-p filename)
 	       (or (eq mustbenew 'excl)
@@ -544,15 +548,26 @@ But handle the case, if the \"test\" command is not available."
 		     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let* ((curbuf (current-buffer))
+    (let* ((auto-saving
+	    (string-match-p "^#.+#$" (file-name-nondirectory filename)))
+	   file-locked
+	   (curbuf (current-buffer))
 	   (tmpfile (tramp-compat-make-temp-file filename)))
+
+      ;; Lock file.
+      (when (and (not auto-saving) (file-remote-p lockname)
+		 (not (eq (file-locked-p lockname) t)))
+	(setq file-locked t)
+	;; `lock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'lock-file lockname))
+
       (when (and append (file-exists-p filename))
 	(copy-file filename tmpfile 'ok)
 	(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
       (write-region start end tmpfile append 'no-message)
       (with-tramp-progress-reporter
-        v 3 (format-message
-             "Moving tmp file `%s' to `%s'" tmpfile filename)
+	  v 3 (format-message
+	       "Moving tmp file `%s' to `%s'" tmpfile filename)
 	(unwind-protect
 	    (unless (tramp-adb-execute-adb-command
 		     v "push" tmpfile (tramp-compat-file-name-unquote localname))
@@ -575,6 +590,11 @@ But handle the case, if the \"test\" command is not available."
 	      (file-attributes filename))
 	     (current-time))))
 
+      ;; Unlock file.
+      (when (and file-locked (eq (file-locked-p lockname) t))
+	;; `unlock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'unlock-file lockname))
+
       ;; The end.
       (when (and (null noninteractive)
 		 (or (eq visit t) (null visit) (stringp visit)))
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index d723fd5c6d5..a6f479bcbcb 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -236,6 +236,7 @@ It must be supported by libarchive(3).")
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-archive-handle-file-local-copy)
+    (file-locked-p . ignore)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-archive-handle-file-name-all-completions)
     ;; `file-name-as-directory' performed by default handler.
@@ -262,6 +263,7 @@ It must be supported by libarchive(3).")
     (insert-directory . tramp-archive-handle-insert-directory)
     (insert-file-contents . tramp-archive-handle-insert-file-contents)
     (load . tramp-archive-handle-load)
+    (lock-file . ignore)
     (make-auto-save-file-name . ignore)
     (make-directory . tramp-archive-handle-not-implemented)
     (make-directory-internal . tramp-archive-handle-not-implemented)
@@ -283,6 +285,7 @@ It must be supported by libarchive(3).")
     (tramp-get-remote-uid . ignore)
     (tramp-set-file-uid-gid . ignore)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . ignore)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-archive-handle-not-implemented))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index a41620ab9f7..579234f9f50 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -49,6 +49,8 @@
 ;;   an open connection.  Examples: "scripts" keeps shell script
 ;;   definitions already sent to the remote shell, "last-cmd-time" is
 ;;   the time stamp a command has been sent to the remote process.
+;;   "lock-pid" is the timestamp a (network) process is created, it is
+;;   used instead of the pid in file locks.
 ;;
 ;; - The key is nil.  These are temporary properties related to the
 ;;   local machine.  Examples: "parse-passwd" and "parse-group" keep
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 1d8c0ad2170..31988bc9ef9 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -182,6 +182,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-handle-file-local-copy)
+    (file-locked-p . tramp-crypt-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
     ;; `file-name-as-directory' performed by default handler.
@@ -208,6 +209,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
     (insert-directory . tramp-crypt-handle-insert-directory)
     ;; `insert-file-contents' performed by default handler.
     (load . tramp-handle-load)
+    (lock-file . tramp-crypt-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-crypt-handle-make-directory)
     (make-directory-internal . ignore)
@@ -229,6 +231,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
     ;; `tramp-get-remote-uid' performed by default handler.
     (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-crypt-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-handle-write-region))
@@ -734,6 +737,11 @@ absolute file names."
   (let (tramp-crypt-enabled)
     (file-executable-p (tramp-crypt-encrypt-file-name filename))))
 
+(defun tramp-crypt-handle-file-locked-p (filename)
+  "Like `file-locked-p' for Tramp files."
+  (let (tramp-crypt-enabled)
+    (file-locked-p (tramp-crypt-encrypt-file-name filename))))
+
 (defun tramp-crypt-handle-file-name-all-completions (filename directory)
   "Like `file-name-all-completions' for Tramp files."
   (all-completions
@@ -797,6 +805,11 @@ WILDCARD is not supported."
 	  (delete-region (prop-match-beginning match) (prop-match-end match))
 	  (insert (propertize string 'dired-filename t)))))))
 
+(defun tramp-crypt-handle-lock-file (filename)
+  "Like `lock-file' for Tramp files."
+  (let (tramp-crypt-enabled)
+    (lock-file (tramp-crypt-encrypt-file-name filename))))
+
 (defun tramp-crypt-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
   (with-parsed-tramp-file-name (expand-file-name dir) nil
@@ -848,6 +861,11 @@ WILDCARD is not supported."
       (tramp-set-file-uid-gid
        (tramp-crypt-encrypt-file-name filename) uid gid))))
 
+(defun tramp-crypt-handle-unlock-file (filename)
+  "Like `unlock-file' for Tramp files."
+  (let (tramp-crypt-enabled)
+    (unlock-file (tramp-crypt-encrypt-file-name filename))))
+
 (add-hook 'tramp-unload-hook
 	  (lambda ()
 	    (unload-feature 'tramp-crypt 'force)))
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index ec1db8680f2..93b184a36c2 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -164,10 +164,9 @@
     (or (tramp-get-connection-property
          (tramp-get-connection-process vec) "mounted" nil)
         (let* ((default-directory (tramp-compat-temporary-file-directory))
-               (fuse (concat "fuse." (tramp-file-name-method vec)))
-               (mount (shell-command-to-string (format "mount -t %s" fuse))))
-          (tramp-message vec 6 "%s %s" "mount -t" fuse)
-          (tramp-message vec 6 "\n%s" mount)
+               (command (format "mount -t fuse.%s" (tramp-file-name-method vec)))
+	       (mount (shell-command-to-string command)))
+          (tramp-message vec 6 "%s\n%s" command mount)
           (tramp-set-connection-property
            (tramp-get-connection-process vec) "mounted"
            (when (string-match
@@ -176,6 +175,16 @@
 	          mount)
              (match-string 1 mount)))))))
 
+(defun tramp-fuse-unmount (vec)
+  "Unmount fuse volume determined by VEC."
+  (let ((default-directory (tramp-compat-temporary-file-directory))
+        (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec))))
+    (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
+    (tramp-flush-connection-property
+     (tramp-get-connection-process vec) "mounted")
+    ;; Give the caches a chance to expire.
+    (sleep-for 1)))
+
 (defun tramp-fuse-local-file-name (filename)
   "Return local mount name of FILENAME."
   (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f1d24dc0c41..e784ea83ef2 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -774,6 +774,7 @@ It has been changed in GVFS 1.14.")
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -800,6 +801,7 @@ It has been changed in GVFS 1.14.")
     (insert-directory . tramp-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-gvfs-handle-make-directory)
     (make-directory-internal . ignore)
@@ -821,6 +823,7 @@ It has been changed in GVFS 1.14.")
     (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
     (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-handle-write-region))
@@ -2144,6 +2147,9 @@ connection if a previous connection has died for some reason."
       (process-put p 'vector vec)
       (set-process-query-on-exit-flag p nil)
 
+      ;; Mark process for filelock.
+      (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)))
 
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3b6de3e0b70..6c710dd0b1b 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -96,6 +96,7 @@
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -122,6 +123,7 @@
     (insert-directory . tramp-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-fuse-handle-make-directory)
     (make-directory-internal . ignore)
@@ -143,6 +145,7 @@
     (tramp-get-remote-uid . ignore)
     (tramp-set-file-uid-gid . ignore)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-handle-write-region))
@@ -358,6 +361,10 @@ connection if a previous connection has died for some reason."
 	  (process-put p 'vector vec)
 	  (set-process-query-on-exit-flag p nil)
 
+	  ;; Mark process for filelock.
+	  (tramp-set-connection-property
+	   p "lock-pid" (truncate (time-to-seconds)))
+
 	  ;; Set connection-local variables.
 	  (tramp-set-connection-local-variables vec)))
 
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5f597ff46e4..11037227790 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -962,6 +962,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
     (file-exists-p . tramp-sh-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-sh-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-sh-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -988,6 +989,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
     (insert-directory . tramp-sh-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-sh-handle-make-directory)
     ;; `make-directory-internal' performed by default handler.
@@ -1009,6 +1011,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
     (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
     (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . tramp-sh-handle-vc-registered)
     (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
     (write-region . tramp-sh-handle-write-region))
@@ -3233,9 +3236,10 @@ implementation will be used."
       tmpfile)))
 
 (defun tramp-sh-handle-write-region
-  (start end filename &optional append visit _lockname mustbenew)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
+  (setq filename (expand-file-name filename)
+	lockname (file-truename (or lockname filename)))
   (with-parsed-tramp-file-name filename nil
     (when (and mustbenew (file-exists-p filename)
 	       (or (eq mustbenew 'excl)
@@ -3244,13 +3248,23 @@ implementation will be used."
 		     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let ((uid (or (tramp-compat-file-attribute-user-id
+    (let ((auto-saving
+	   (string-match-p "^#.+#$" (file-name-nondirectory filename)))
+	  file-locked
+	  (uid (or (tramp-compat-file-attribute-user-id
 		    (file-attributes filename 'integer))
 		   (tramp-get-remote-uid v 'integer)))
 	  (gid (or (tramp-compat-file-attribute-group-id
 		    (file-attributes filename 'integer))
 		   (tramp-get-remote-gid v 'integer))))
 
+      ;; Lock file.
+      (when (and (not auto-saving) (file-remote-p lockname)
+		 (not (eq (file-locked-p lockname) t)))
+	(setq file-locked t)
+	;; `lock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'lock-file lockname))
+
       (if (and (tramp-local-host-p v)
 	       ;; `file-writable-p' calls `file-expand-file-name'.  We
 	       ;; cannot use `tramp-run-real-handler' therefore.
@@ -3465,6 +3479,12 @@ implementation will be used."
 	;; Set the ownership.
         (when need-chown
           (tramp-set-file-uid-gid filename uid gid))
+
+	;; Unlock file.
+	(when (and file-locked (eq (file-locked-p lockname) t))
+	  ;; `unlock-file' exists since Emacs 28.1.
+	  (tramp-compat-funcall 'unlock-file lockname))
+
 	(when (and (null noninteractive)
 		   (or (eq visit t) (null visit) (stringp visit)))
 	  (tramp-message v 0 "Wrote %s" filename))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 13edf16756f..500245b3e19 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -247,6 +247,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-smb-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -273,6 +274,7 @@ See `tramp-actions-before-shell' for more info.")
     (insert-directory . tramp-smb-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-smb-handle-make-directory)
     (make-directory-internal . tramp-smb-handle-make-directory-internal)
@@ -294,6 +296,7 @@ See `tramp-actions-before-shell' for more info.")
     (tramp-get-remote-uid . ignore)
     (tramp-set-file-uid-gid . ignore)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-smb-handle-write-region))
@@ -532,7 +535,7 @@ arguments to pass to the OPERATION."
 		      (tramp-process-actions p v nil tramp-smb-actions-with-tar)
 
 		      (while (process-live-p p)
-			(sit-for 0.1))
+			(sleep-for 0.1))
 		      (tramp-message v 6 "\n%s" (buffer-string))))
 
 		;; Reset the transfer process properties.
@@ -1573,9 +1576,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
       (error filename))))
 
 (defun tramp-smb-handle-write-region
-  (start end filename &optional append visit _lockname mustbenew)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
+  (setq filename (expand-file-name filename)
+	lockname (file-truename (or lockname filename)))
   (with-parsed-tramp-file-name filename nil
     (when (and mustbenew (file-exists-p filename)
 	       (or (eq mustbenew 'excl)
@@ -1584,8 +1588,19 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
 		     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let ((curbuf (current-buffer))
+    (let ((auto-saving
+	   (string-match-p "^#.+#$" (file-name-nondirectory filename)))
+	  file-locked
+	  (curbuf (current-buffer))
 	  (tmpfile (tramp-compat-make-temp-file filename)))
+
+      ;; Lock file.
+      (when (and (not auto-saving) (file-remote-p lockname)
+		 (not (eq (file-locked-p lockname) t)))
+	(setq file-locked t)
+	;; `lock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'lock-file lockname))
+
       (when (and append (file-exists-p filename))
 	(copy-file filename tmpfile 'ok))
       ;; We say `no-message' here because we don't want the visited file
@@ -1618,6 +1633,11 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
 	      (file-attributes filename))
 	     (current-time))))
 
+      ;; Unlock file.
+      (when (and file-locked (eq (file-locked-p lockname) t))
+	;; `unlock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'unlock-file lockname))
+
       ;; The end.
       (when (and (null noninteractive)
 		 (or (eq visit t) (null visit) (stringp visit)))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index cac8c40abb3..babd770be9b 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -96,6 +96,7 @@
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -122,6 +123,7 @@
     (insert-directory . tramp-handle-insert-directory)
     (insert-file-contents . tramp-sshfs-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-fuse-handle-make-directory)
     (make-directory-internal . ignore)
@@ -143,6 +145,7 @@
     (tramp-get-remote-uid . ignore)
     (tramp-set-file-uid-gid . ignore)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-sshfs-handle-write-region))
@@ -279,9 +282,10 @@ arguments to pass to the OPERATION."
        (tramp-fuse-local-file-name filename) mode flag))))
 
 (defun tramp-sshfs-handle-write-region
-  (start end filename &optional append visit _lockname mustbenew)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
+  (setq filename (expand-file-name filename)
+	lockname (file-truename (or lockname filename)))
   (with-parsed-tramp-file-name filename nil
     (when (and mustbenew (file-exists-p filename)
 	       (or (eq mustbenew 'excl)
@@ -290,15 +294,32 @@ arguments to pass to the OPERATION."
 		     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (write-region
-     start end (tramp-fuse-local-file-name filename) append 'nomessage)
-    (tramp-flush-file-properties v localname)
-
-    ;; The end.
-    (when (and (null noninteractive)
-	       (or (eq visit t) (null visit) (stringp visit)))
-      (tramp-message v 0 "Wrote %s" filename))
-    (run-hooks 'tramp-handle-write-region-hook)))
+    (let ((auto-saving
+	   (string-match-p "^#.+#$" (file-name-nondirectory filename)))
+	  file-locked)
+
+      ;; Lock file.
+      (when (and (not auto-saving) (file-remote-p lockname)
+		 (not (eq (file-locked-p lockname) t)))
+	(setq file-locked t)
+	;; `lock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'lock-file lockname))
+
+      (let (create-lockfiles)
+	(write-region
+	 start end (tramp-fuse-local-file-name filename) append 'nomessage)
+	(tramp-flush-file-properties v localname))
+
+      ;; Unlock file.
+      (when (and file-locked (eq (file-locked-p lockname) t))
+	;; `unlock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'unlock-file lockname))
+
+      ;; The end.
+      (when (and (null noninteractive)
+		 (or (eq visit t) (null visit) (stringp visit)))
+	(tramp-message v 0 "Wrote %s" filename))
+      (run-hooks 'tramp-handle-write-region-hook))))
 
 
 ;; File name conversions.
@@ -321,6 +342,9 @@ connection if a previous connection has died for some reason."
       (process-put p 'vector vec)
       (set-process-query-on-exit-flag p nil)
 
+      ;; Mark process for filelock.
+      (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)
 
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index d6417094bae..aa6f85ec6ef 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -88,6 +88,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-exists-p . tramp-sudoedit-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-handle-file-local-copy)
+    (file-locked-p . tramp-handle-file-locked-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions
      . tramp-sudoedit-handle-file-name-all-completions)
@@ -115,6 +116,7 @@ See `tramp-actions-before-shell' for more info.")
     (insert-directory . tramp-handle-insert-directory)
     (insert-file-contents . tramp-handle-insert-file-contents)
     (load . tramp-handle-load)
+    (lock-file . tramp-handle-lock-file)
     (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
     (make-directory . tramp-sudoedit-handle-make-directory)
     (make-directory-internal . ignore)
@@ -136,6 +138,7 @@ See `tramp-actions-before-shell' for more info.")
     (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
     (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
     (unhandled-file-name-directory . ignore)
+    (unlock-file . tramp-handle-unlock-file)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-sudoedit-handle-write-region))
@@ -713,6 +716,7 @@ ID-FORMAT valid values are `string' and `integer'."
 (defun tramp-sudoedit-handle-write-region
   (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
+  (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
     (let* ((uid (or (tramp-compat-file-attribute-user-id
 		     (file-attributes filename 'integer))
@@ -776,6 +780,9 @@ connection if a previous connection has died for some reason."
       (process-put p 'vector vec)
       (set-process-query-on-exit-flag p nil)
 
+      ;; Mark process for filelock.
+      (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
       ;; Set connection-local variables.
       (tramp-set-connection-local-variables vec)
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 04ec06d2512..37d60e854f2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2455,6 +2455,8 @@ Must be handled by the callers."
 	      file-name-case-insensitive-p
 	      ;; Emacs 27+ only.
 	      file-system-info
+	      ;; Emacs 28+ only.
+	      file-locked-p lock-file unlock-file
 	      ;; Tramp internal magic file name function.
 	      tramp-set-file-uid-gid))
     (if (file-name-absolute-p (nth 0 args))
@@ -3816,6 +3818,76 @@ User is always nil."
       ;; Result.
       (cons (expand-file-name filename) (cdr result)))))
 
+(defun tramp-make-lock-name (file)
+  "Implement MAKE_LOCK_NAME of filelock.c."
+  (expand-file-name
+   (concat ".#" (file-name-nondirectory file)) (file-name-directory file)))
+
+(defun tramp-get-lock-file (file)
+  "Read lockfile of FILE.
+Return nil when there is no lockfile"
+  (let ((lockname (tramp-make-lock-name file)))
+    (or (file-symlink-p lockname)
+	(and (file-readable-p lockname)
+	     (with-temp-buffer
+	       (insert-file-contents-literally lockname)
+	       (buffer-string))))))
+
+(defun tramp-get-lock-pid (file)
+  "Determine pid for lockfile of FILE."
+  ;; Some Tramp methods do not offer a connection process, but just a
+  ;; network process as a place holder.  Those processes use the
+  ;; "lock-pid" connection property as fake pid, in fact it is the
+  ;; time stamp the process is created.
+  (let ((p (tramp-get-process  (tramp-dissect-file-name file))))
+    (number-to-string
+     (or (process-id p)
+	 (tramp-get-connection-property p "lock-pid" (emacs-pid))))))
+
+(defconst tramp-lock-file-contents-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))))
+
+(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 (ask-user-about-lock
+		 file (format
+		       "%s@%s (pid %s)" (match-string 1 contents)
+		       (match-string 2 contents) (match-string 3 contents)))
+	  (throw 'dont-lock nil)))
+
+      (let ((lockname (tramp-make-lock-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)))))))
+
+(defun tramp-handle-unlock-file (file)
+  "Like `unlock-file' for Tramp files."
+  (delete-file (tramp-make-lock-name file)))
+
 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
   "Like `load' for Tramp files."
   (with-parsed-tramp-file-name (expand-file-name file) nil
@@ -4355,9 +4427,10 @@ of."
 	   (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))
 
 (defun tramp-handle-write-region
-  (start end filename &optional append visit _lockname mustbenew)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
+  (setq filename (expand-file-name filename)
+	lockname (file-truename (or lockname filename)))
   (with-parsed-tramp-file-name filename nil
     (when (and mustbenew (file-exists-p filename)
 	       (or (eq mustbenew 'excl)
@@ -4366,7 +4439,10 @@ of."
 		     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let ((tmpfile (tramp-compat-make-temp-file filename))
+    (let ((auto-saving
+	   (string-match-p "^#.+#$" (file-name-nondirectory filename)))
+	  file-locked
+	  (tmpfile (tramp-compat-make-temp-file filename))
 	  (modes (tramp-default-file-modes
 		  filename (and (eq mustbenew 'excl) 'nofollow)))
 	  (uid (or (tramp-compat-file-attribute-user-id
@@ -4375,6 +4451,14 @@ of."
 	  (gid (or (tramp-compat-file-attribute-group-id
 		    (file-attributes filename 'integer))
 		   (tramp-get-remote-gid v 'integer))))
+
+      ;; Lock file.
+      (when (and (not auto-saving) (file-remote-p lockname)
+		 (not (eq (file-locked-p lockname) t)))
+	(setq file-locked t)
+	;; `lock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'lock-file lockname))
+
       (when (and append (file-exists-p filename))
 	(copy-file filename tmpfile 'ok))
       ;; The permissions of the temporary file should be set.  If
@@ -4404,13 +4488,18 @@ of."
 	     (current-time))))
 
       ;; Set the ownership.
-      (tramp-set-file-uid-gid filename uid gid))
-
-    ;; The end.
-    (when (and (null noninteractive)
-	       (or (eq visit t) (null visit) (stringp visit)))
-      (tramp-message v 0 "Wrote %s" filename))
-    (run-hooks 'tramp-handle-write-region-hook)))
+      (tramp-set-file-uid-gid filename uid gid)
+
+      ;; Unlock file.
+      (when (and file-locked (eq (file-locked-p lockname) t))
+	;; `unlock-file' exists since Emacs 28.1.
+	(tramp-compat-funcall 'unlock-file lockname))
+
+      ;; The end.
+      (when (and (null noninteractive)
+		 (or (eq visit t) (null visit) (stringp visit)))
+	(tramp-message v 0 "Wrote %s" filename))
+      (run-hooks 'tramp-handle-write-region-hook))))
 
 ;; This is used in tramp-sh.el and tramp-sudoedit.el.
 (defconst tramp-stat-marker "/////"
diff --git a/src/filelock.c b/src/filelock.c
index 446a262a1ce..dcdc635c25e 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -671,6 +671,16 @@ lock_file (Lisp_Object fn)
   if (will_dump_p ())
     return;
 
+  /* If the file name has special constructs in it,
+     call the corresponding file name handler.  */
+  Lisp_Object handler;
+  handler = Ffind_file_name_handler (fn, Qlock_file);
+  if (!NILP (handler))
+    {
+      call2 (handler, Qlock_file, fn);
+      return;
+    }
+
   orig_fn = fn;
   fn = Fexpand_file_name (fn, Qnil);
 #ifdef WINDOWSNT
@@ -725,6 +735,16 @@ unlock_file_body (Lisp_Object fn)
   char *lfname;
   USE_SAFE_ALLOCA;
 
+  /* If the file name has special constructs in it,
+     call the corresponding file name handler.  */
+  Lisp_Object handler;
+  handler = Ffind_file_name_handler (fn, Qunlock_file);
+  if (!NILP (handler))
+    {
+      call2 (handler, Qunlock_file, fn);
+      return Qnil;
+    }
+
   Lisp_Object filename = Fexpand_file_name (fn, Qnil);
   fn = ENCODE_FILE (filename);
 
@@ -784,6 +804,27 @@ unlock_all_files (void)
     }
 }
 
+DEFUN ("lock-file", Flock_file, Slock_file,
+       0, 1, 0,
+       doc: /* Lock FILE.
+If the option `create-lockfiles' is nil, this does nothing.  */)
+  (Lisp_Object file)
+{
+  CHECK_STRING (file);
+  lock_file (file);
+  return Qnil;
+}
+
+DEFUN ("unlock-file", Funlock_file, Sunlock_file,
+       0, 1, 0,
+       doc: /* Unlock FILE.  */)
+  (Lisp_Object file)
+{
+  CHECK_STRING (file);
+  unlock_file (file);
+  return Qnil;
+}
+
 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
        0, 1, 0,
        doc: /* Lock FILE, if current buffer is modified.
@@ -844,6 +885,15 @@ t if it is locked by you, else a string saying which user has locked it.  */)
   lock_info_type locker;
   USE_SAFE_ALLOCA;
 
+  /* If the file name has special constructs in it,
+     call the corresponding file name handler.  */
+  Lisp_Object handler;
+  handler = Ffind_file_name_handler (filename, Qfile_locked_p);
+  if (!NILP (handler))
+    {
+      return call2 (handler, Qfile_locked_p, filename);
+    }
+
   filename = Fexpand_file_name (filename, Qnil);
   Lisp_Object encoded_filename = ENCODE_FILE (filename);
   MAKE_LOCK_NAME (lfname, encoded_filename);
@@ -876,7 +926,13 @@ The name of the (per-buffer) lockfile is constructed by prepending a
 Info node `(emacs)Interlocking'.  */);
   create_lockfiles = true;
 
-  defsubr (&Sunlock_buffer);
+  DEFSYM (Qlock_file, "lock-file");
+  DEFSYM (Qunlock_file, "unlock-file");
+  DEFSYM (Qfile_locked_p, "file-locked-p");
+
+  defsubr (&Slock_file);
+  defsubr (&Sunlock_file);
   defsubr (&Slock_buffer);
+  defsubr (&Sunlock_buffer);
   defsubr (&Sfile_locked_p);
 }
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index ca1163bb775..aac1b13bd0e 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
       (tramp-archive-cleanup-hash))))
 
 ;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-archive-test39-make-nearby-temp-file ()
+(ert-deftest tramp-archive-test40-make-nearby-temp-file ()
   "Check `make-nearby-temp-file' and `temporary-file-directory'."
   (skip-unless tramp-archive-enabled)
   ;; Since Emacs 26.1.
@@ -893,7 +893,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
     (delete-directory tmp-file)
     (should-not (file-exists-p tmp-file))))
 
-(ert-deftest tramp-archive-test42-file-system-info ()
+(ert-deftest tramp-archive-test43-file-system-info ()
   "Check that `file-system-info' returns proper values."
   (skip-unless tramp-archive-enabled)
   ;; Since Emacs 27.1.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7f894448a67..0e70f8e1d23 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,7 +33,7 @@
 ;; remote host, set this environment variable to "/dev/null" or
 ;; whatever is appropriate on your system.
 
-;; For slow remote connections, `tramp-test43-asynchronous-requests'
+;; For slow remote connections, `tramp-test44-asynchronous-requests'
 ;; might be too heavy.  Setting $REMOTE_PARALLEL_PROCESSES to a proper
 ;; value less than 10 could help.
 
@@ -122,6 +122,7 @@
 (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
@@ -2463,6 +2464,8 @@ This checks also `file-name-as-directory', `file-name-directory',
 			  "^\\'")
 			tramp--test-messages))))))))
 
+	    ;; We do not test lockname here.  See `tramp-test39-lock-file'.
+
 	    ;; Do not overwrite if excluded.
 	    (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
 		      ;; Ange-FTP.
@@ -2833,8 +2836,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
 	   (delete-directory tmp-name1 nil 'trash)
 	   ;; tramp-rclone.el and tramp-sshfs.el call the local
 	   ;; `delete-directory'.  This raises another error.
-	   :type (if (or (tramp--test-rclone-p) (tramp--test-sshfs-p))
-		     'error 'file-error))
+	   :type (if (tramp--test-fuse-p) 'error 'file-error))
 	  (delete-directory tmp-name1 'recursive 'trash)
 	  (should-not (file-directory-p tmp-name1))
 	  (should
@@ -5741,8 +5743,77 @@ Use direct async.")
 	(ignore-errors (delete-file tmp-name1))
 	(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
 
+;; The functions were introduced in Emacs 28.1.
+(ert-deftest tramp-test39-lock-file ()
+  "Check `lock-file', `unlock-file' and `file-locked-p'."
+  (skip-unless (tramp--test-enabled))
+  (skip-unless (not (tramp--test-ange-ftp-p)))
+  ;; Since Emacs 28.1.
+  (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file)))
+
+  (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+    (let ((tmp-name (tramp--test-make-temp-name nil quoted))
+	  (remote-file-name-inhibit-cache t)
+	  (create-lockfiles t)
+          (inhibit-message t)
+	  ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
+	  (tramp-cleanup-connection-hook
+	   (append
+	    (and (tramp--test-fuse-p) '(tramp-fuse-unmount))
+	    tramp-cleanup-connection-hook))
+	  noninteractive)
+
+      (unwind-protect
+	  (progn
+	    ;; A simple file lock.
+	    (should-not (file-locked-p tmp-name))
+	    (lock-file tmp-name)
+	    (should (eq (file-locked-p tmp-name) t))
+
+	    ;; If it is locked already, nothing changes.
+	    (lock-file tmp-name)
+	    (should (eq (file-locked-p tmp-name) t))
+
+	    ;; A new connection changes process id, and also the
+	    ;; lockname contents.
+	    (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+	    (should (stringp (file-locked-p tmp-name)))
+
+	    ;; Steal the file lock.
+	    (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+	    (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
+	      (lock-file tmp-name))
+	    (should (eq (file-locked-p tmp-name) t))
+
+	    ;; Ignore the file lock.
+	    (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+	    (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
+	      (lock-file tmp-name))
+	    (should (stringp (file-locked-p tmp-name)))
+
+	    ;; 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 (write-region "foo" nil tmp-name) :type 'file-locked)
+	      (should-error
+	       (write-region "foo" nil tmp-name nil nil tmp-name)
+	       :type 'file-locked))
+	    (should (stringp (file-locked-p tmp-name)))
+	    (should-not (file-exists-p tmp-name)))
+
+	;; Cleanup.
+	(ignore-errors (delete-file tmp-name))
+	(unlock-file tmp-name)
+	(should-not (file-locked-p tmp-name))))))
+
 ;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test39-make-nearby-temp-file ()
+(ert-deftest tramp-test40-make-nearby-temp-file ()
   "Check `make-nearby-temp-file' and `temporary-file-directory'."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-ange-ftp-p)))
@@ -5825,6 +5896,10 @@ This does not support globbing characters in file names (yet)."
   (string-match-p
    "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
 
+(defun tramp--test-fuse-p ()
+  "Check, whether an FUSE file system isused."
+  (or (tramp--test-rclone-p) (tramp--test-sshfs-p)))
+
 (defun tramp--test-gdrive-p ()
   "Check, whether the gdrive method is used."
   (string-equal
@@ -6115,7 +6190,7 @@ This requires restrictions of file name syntax."
 	(ignore-errors (delete-directory tmp-name2 'recursive))))))
 
 (defun tramp--test-special-characters ()
-  "Perform the test in `tramp-test40-special-characters*'."
+  "Perform the test in `tramp-test41-special-characters*'."
   ;; Newlines, slashes and backslashes in file names are not
   ;; supported.  So we don't test.  And we don't test the tab
   ;; character on Windows or Cygwin, because the backslash is
@@ -6173,7 +6248,7 @@ This requires restrictions of file name syntax."
 	       files (list (mapconcat #'identity files ""))))))
 
 ;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test40-special-characters ()
+(ert-deftest tramp-test41-special-characters ()
   "Check special characters in file names."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-rsync-p)))
@@ -6181,7 +6256,7 @@ This requires restrictions of file name syntax."
 
   (tramp--test-special-characters))
 
-(ert-deftest tramp-test40-special-characters-with-stat ()
+(ert-deftest tramp-test41-special-characters-with-stat ()
   "Check special characters in file names.
 Use the `stat' command."
   :tags '(:expensive-test)
@@ -6199,7 +6274,7 @@ Use the `stat' command."
 	  tramp-connection-properties)))
     (tramp--test-special-characters)))
 
-(ert-deftest tramp-test40-special-characters-with-perl ()
+(ert-deftest tramp-test41-special-characters-with-perl ()
   "Check special characters in file names.
 Use the `perl' command."
   :tags '(:expensive-test)
@@ -6220,7 +6295,7 @@ Use the `perl' command."
 	  tramp-connection-properties)))
     (tramp--test-special-characters)))
 
-(ert-deftest tramp-test40-special-characters-with-ls ()
+(ert-deftest tramp-test41-special-characters-with-ls ()
   "Check special characters in file names.
 Use the `ls' command."
   :tags '(:expensive-test)
@@ -6241,7 +6316,7 @@ Use the `ls' command."
     (tramp--test-special-characters)))
 
 (defun tramp--test-utf8 ()
-  "Perform the test in `tramp-test41-utf8*'."
+  "Perform the test in `tramp-test42-utf8*'."
   (let* ((utf8 (if (and (eq system-type 'darwin)
 			(memq 'utf-8-hfs (coding-system-list)))
 		   'utf-8-hfs 'utf-8))
@@ -6287,7 +6362,7 @@ Use the `ls' command."
 	     (replace-regexp-in-string "[ \t\n/.?]" "" x)))
 	  language-info-alist)))))))
 
-(ert-deftest tramp-test41-utf8 ()
+(ert-deftest tramp-test42-utf8 ()
   "Check UTF8 encoding in file names and file contents."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-docker-p)))
@@ -6300,7 +6375,7 @@ Use the `ls' command."
 
   (tramp--test-utf8))
 
-(ert-deftest tramp-test41-utf8-with-stat ()
+(ert-deftest tramp-test42-utf8-with-stat ()
   "Check UTF8 encoding in file names and file contents.
 Use the `stat' command."
   :tags '(:expensive-test)
@@ -6322,7 +6397,7 @@ Use the `stat' command."
 	  tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test41-utf8-with-perl ()
+(ert-deftest tramp-test42-utf8-with-perl ()
   "Check UTF8 encoding in file names and file contents.
 Use the `perl' command."
   :tags '(:expensive-test)
@@ -6347,7 +6422,7 @@ Use the `perl' command."
 	  tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test41-utf8-with-ls ()
+(ert-deftest tramp-test42-utf8-with-ls ()
   "Check UTF8 encoding in file names and file contents.
 Use the `ls' command."
   :tags '(:expensive-test)
@@ -6371,7 +6446,7 @@ Use the `ls' command."
 	  tramp-connection-properties)))
     (tramp--test-utf8)))
 
-(ert-deftest tramp-test42-file-system-info ()
+(ert-deftest tramp-test43-file-system-info ()
   "Check that `file-system-info' returns proper values."
   (skip-unless (tramp--test-enabled))
   ;; Since Emacs 27.1.
@@ -6388,11 +6463,11 @@ Use the `ls' command."
 		 (numberp (nth 1 fsi))
 		 (numberp (nth 2 fsi))))))
 
-;; `tramp-test43-asynchronous-requests' could be blocked.  So we set a
+;; `tramp-test44-asynchronous-requests' could be blocked.  So we set a
 ;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300
 ;; seconds.  Similar check is performed in the timer function.
 (defconst tramp--test-asynchronous-requests-timeout 300
-  "Timeout for `tramp-test43-asynchronous-requests'.")
+  "Timeout for `tramp-test44-asynchronous-requests'.")
 
 (defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
   "Set \"process-name\" and \"process-buffer\" connection properties.
@@ -6428,7 +6503,7 @@ This is needed in timer functions as well as process filters and sentinels."
 	 (tramp-flush-connection-property v "process-buffer")))))
 
 ;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test43-asynchronous-requests ()
+(ert-deftest tramp-test44-asynchronous-requests ()
   "Check parallel asynchronous requests.
 Such requests could arrive from timers, process filters and
 process sentinels.  They shall not disturb each other."
@@ -6628,11 +6703,11 @@ process sentinels.  They shall not disturb each other."
         (ignore-errors (cancel-timer timer))
         (ignore-errors (delete-directory tmp-name 'recursive))))))
 
-;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests
+;; (tramp--test--deftest-direct-async-process tramp-test44-asynchronous-requests
 ;;   "Check parallel direct asynchronous requests." 'unstable)
 
 ;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test44-auto-load ()
+(ert-deftest tramp-test45-auto-load ()
   "Check that Tramp autoloads properly."
   ;; If we use another syntax but `default', Tramp is already loaded
   ;; due to the `tramp-change-syntax' call.
@@ -6657,7 +6732,7 @@ process sentinels.  They shall not disturb each other."
 	(mapconcat #'shell-quote-argument load-path " -L ")
 	(shell-quote-argument code)))))))
 
-(ert-deftest tramp-test44-delay-load ()
+(ert-deftest tramp-test45-delay-load ()
   "Check that Tramp is loaded lazily, only when needed."
   ;; The autoloaded Tramp objects are different since Emacs 26.1.  We
   ;; cannot test older Emacsen, therefore.
@@ -6690,7 +6765,7 @@ process sentinels.  They shall not disturb each other."
 	  (mapconcat #'shell-quote-argument load-path " -L ")
 	  (shell-quote-argument (format code tm)))))))))
 
-(ert-deftest tramp-test44-recursive-load ()
+(ert-deftest tramp-test45-recursive-load ()
   "Check that Tramp does not fail due to recursive load."
   (skip-unless (tramp--test-enabled))
 
@@ -6714,7 +6789,7 @@ process sentinels.  They shall not disturb each other."
 	  (mapconcat #'shell-quote-argument load-path " -L ")
 	  (shell-quote-argument code))))))))
 
-(ert-deftest tramp-test44-remote-load-path ()
+(ert-deftest tramp-test45-remote-load-path ()
   "Check that Tramp autoloads its packages with remote `load-path'."
   ;; The autoloaded Tramp objects are different since Emacs 26.1.  We
   ;; cannot test older Emacsen, therefore.
@@ -6743,7 +6818,7 @@ process sentinels.  They shall not disturb each other."
 	(mapconcat #'shell-quote-argument load-path " -L ")
 	(shell-quote-argument code)))))))
 
-(ert-deftest tramp-test45-unload ()
+(ert-deftest tramp-test46-unload ()
   "Check that Tramp and its subpackages unload completely.
 Since it unloads Tramp, it shall be the last test to run."
   :tags '(:expensive-test)
@@ -6826,7 +6901,7 @@ If INTERACTIVE is non-nil, the tests are run interactively."
 ;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and
 ;;   for direct async processes.
 ;; * Check, why direct async processes do not work for
-;;   `tramp-test43-asynchronous-requests'.
+;;   `tramp-test44-asynchronous-requests'.
 
 (provide 'tramp-tests)
 
-- 
2.39.2