andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make remote file locks more robust

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2021-07-18 16:58:52 +02:00
parent 1bd012ce43
commit 7075ebbf5b
5 changed files with 26 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/net/tramp-adb.el
View file

@ -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))

6
lisp/net/tramp-smb.el
View file

@ -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))

6
lisp/net/tramp-sshfs.el
View file

@ -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))

6
lisp/net/tramp.el
View file

@ -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))

19
test/lisp/net/tramp-tests.el
View file

@ -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))