From: Michael Albinus Date: Sun, 18 Jul 2021 14:58:52 +0000 (+0200) Subject: Make remote file locks more robust X-Git-Tag: emacs-28.0.90~1820 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7075ebbf5b67e58d8270c0e3673133ac0586f8b5;p=emacs.git 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 8138d9a3608..b081e5957a3 100644 --- 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 4008c25d3af..4e4f5548e20 100644 --- 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 99f4063988f..c5b84a6e4e4 100644 --- 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 736c7efd242..093335a77b5 100644 --- 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 3dd22acea51..be4b4279b4d 100644 --- 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))