Commit d35868be authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent 90c89e8b
Pipeline #11327 failed with stages
in 58 seconds
......@@ -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}.
......
......@@ -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'.
......
......@@ -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)))
......
......@@ -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))
......
......@@ -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
......
......@@ -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)))
......
......@@ -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)))
......
......@@ -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)))
......
......@@ -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)))
......
......@@ -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))
......
......@@ -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)))
......
......@@ -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)
......
......@@ -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)
......