@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},
@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},
@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}.
@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},
@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},
@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}.
** 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.
+
\f
* Editing Changes in Emacs 28.1
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
---
* 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'.
(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)
(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)
(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))
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)
(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))
(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)))
(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.
(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)
(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))
;; 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
(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.
(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)
;; `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))
(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
(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
(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)))
(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
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)))
(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)
(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)
(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))
(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)))
(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)
(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)
(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))
(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)))
(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)
(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.
(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))
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)
(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.
;; 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))
(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)
(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)
(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))
(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.
(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)
(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
(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)))
(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)
(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)
(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))
(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)
(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))))
\f
;; File name conversions.
(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)
(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)
(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)
(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))
(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))
(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)
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))
;; 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
(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)
(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
(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
(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 "/////"
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
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);
}
}
\f
+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.
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);
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);
}
(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.
(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.
;; 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.
(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
"^\\'")
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.
(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
(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)))
(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
(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
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)))
(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)
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)
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)
(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))
(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)))
(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)
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)
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)
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.
(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.
(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."
(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.
(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.
(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))
(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.
(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)
;; * 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)
projects / emacs.git / commitdiff