Make remote file locks more robust

* lisp/net/tramp.el (tramp-handle-write-region):
* lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
* lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region):
Make file locks more robust.

* test/lisp/net/tramp-tests.el (tramp-test39-make-lock-file-name):
Rename and extend.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 8138d9a3608839d395a775cfb3c384811676f165..b081e5957a315b38345da9921d2070f62b21fdd0 100644 (file)
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -549,14 +549,14 @@ 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 (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (curbuf (current-buffer))
          (tmpfile (tramp-compat-make-temp-file filename)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -592,7 +592,7 @@ But handle the case, if the \"test\" command is not available."
             (current-time))))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4008c25d3af14a6258dfe1ac66bae364ccb52ca4..4e4f5548e20448a68187892c58ecabc848c052b0 100644 (file)
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1589,14 +1589,14 @@ 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 (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (curbuf (current-buffer))
          (tmpfile (tramp-compat-make-temp-file filename)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -1635,7 +1635,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
             (current-time))))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 

diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 99f4063988fbc774a9610bdae4ac6a04829faaf4..c5b84a6e4e46f83b642a41cc4620aaa5407c5bc1 100644 (file)
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -295,12 +295,12 @@ arguments to pass to the OPERATION."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked)
+    (let ((file-locked (eq (file-locked-p lockname) t)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -311,7 +311,7 @@ arguments to pass to the OPERATION."
        (tramp-flush-file-properties v localname))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 736c7efd242d5859443bf68a06d1a91908600d21..093335a77b5fb5271c71db31a4c1d33fdea58213 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4463,7 +4463,7 @@ of."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (tmpfile (tramp-compat-make-temp-file filename))
          (modes (tramp-default-file-modes
                  filename (and (eq mustbenew 'excl) 'nofollow)))
@@ -4477,7 +4477,7 @@ of."
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -4515,7 +4515,7 @@ of."
       (tramp-set-file-uid-gid filename uid gid)
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3dd22acea513f980875f6fd3dda97082da912710..be4b4279b4d483c1f69132b9bac1c9eeba27db96 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2466,7 +2466,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'.
+           ;; We do not test lockname here.  See
+           ;; `tramp-test39-make-lock-file-name'.
 
            ;; Do not overwrite if excluded.
            (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
@@ -5746,8 +5747,8 @@ Use direct async.")
        (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'."
+(ert-deftest tramp-test39-make-lock-file-name ()
+  "Check `make-lock-file-name', `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.
@@ -5783,6 +5784,15 @@ Use direct async.")
            (with-no-warnings (lock-file tmp-name1))
            (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
 
+            ;; `save-buffer' removes the lock.
+            (with-temp-buffer
+              (set-visited-file-name tmp-name1)
+              (insert "foo")
+              (save-buffer))
+            (should-not (with-no-warnings (file-locked-p tmp-name1)))
+           (with-no-warnings (lock-file tmp-name1))
+           (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
            ;; A new connection changes process id, and also the
            ;; lockname contents.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@@ -5838,8 +5848,7 @@ Use direct async.")
                (should-error
                  (set-visited-file-name tmp-name1)
                 :type 'file-locked)))
-           (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
-           (should-not (file-exists-p tmp-name1)))
+           (should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
 
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name1))