procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement file locks for remote files (Bug#49261)

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2021-07-07 18:36:53 +02:00
parent 90c89e8bde
commit d35868bec9
17 changed files with 430 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
doc/lispref/files.texi
View file

@ -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}.

6
etc/NEWS
View file

@ -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'.

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

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

3
lisp/net/tramp-archive.el
View file

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

2
lisp/net/tramp-cache.el
View file

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

18
lisp/net/tramp-crypt.el
View file

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

17
lisp/net/tramp-fuse.el
View file

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

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

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

7
lisp/net/tramp-rclone.el
View file

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

26
lisp/net/tramp-sh.el
View file

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

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

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

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

@ -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)
(let ((auto-saving
(string-match-p "^#.+#$" (file-name-nondirectory filename)))
file-locked)
;; 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)))
;; 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)

7
lisp/net/tramp-sudoedit.el
View file

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

107
lisp/net/tramp.el
View file

@ -2455,6 +2455,8 @@ Must be handled by the callers."
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))
@ -3816,6 +3818,76 @@ User is always nil."
;; 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
@ -4355,9 +4427,10 @@ of."
(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)
@ -4366,7 +4439,10 @@ of."
(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
@ -4375,6 +4451,14 @@ of."
(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
@ -4404,13 +4488,18 @@ of."
(current-time))))
;; Set the ownership.
(tramp-set-file-uid-gid filename uid gid))
(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)))
;; 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 "/////"

58
src/filelock.c
View file

@ -671,6 +671,16 @@ lock_file (Lisp_Object fn)
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
@ -725,6 +735,16 @@ unlock_file_body (Lisp_Object fn)
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);
@ -784,6 +804,27 @@ unlock_all_files (void)
}
}
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.
@ -844,6 +885,15 @@ t if it is locked by you, else a string saying which user has locked it. */)
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);
@ -876,7 +926,13 @@ The name of the (per-buffer) lockfile is constructed by prepending a
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);
}

4
test/lisp/net/tramp-archive-tests.el
View file

@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(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.
@ -893,7 +893,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(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.

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

@ -33,7 +33,7 @@
;; 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.
@ -122,6 +122,7 @@
(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
@ -2463,6 +2464,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'.
;; Do not overwrite if excluded.
(cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
;; Ange-FTP.
@ -2833,8 +2836,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(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
@ -5741,8 +5743,77 @@ Use direct async.")
(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)))
@ -5825,6 +5896,10 @@ This does not support globbing characters in file names (yet)."
(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
@ -6115,7 +6190,7 @@ This requires restrictions of file name syntax."
(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
@ -6173,7 +6248,7 @@ This requires restrictions of file name syntax."
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)))
@ -6181,7 +6256,7 @@ This requires restrictions of file name syntax."
(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)
@ -6199,7 +6274,7 @@ Use the `stat' command."
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)
@ -6220,7 +6295,7 @@ Use the `perl' command."
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)
@ -6241,7 +6316,7 @@ Use the `ls' command."
(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))
@ -6287,7 +6362,7 @@ Use the `ls' command."
(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)))
@ -6300,7 +6375,7 @@ Use the `ls' command."
(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)
@ -6322,7 +6397,7 @@ Use the `stat' command."
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)
@ -6347,7 +6422,7 @@ Use the `perl' command."
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)
@ -6371,7 +6446,7 @@ Use the `ls' command."
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.
@ -6388,11 +6463,11 @@ Use the `ls' command."
(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.
@ -6428,7 +6503,7 @@ This is needed in timer functions as well as process filters and sentinels."
(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."
@ -6628,11 +6703,11 @@ 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.
@ -6657,7 +6732,7 @@ process sentinels. They shall not disturb each other."
(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.
@ -6690,7 +6765,7 @@ process sentinels. They shall not disturb each other."
(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))
@ -6714,7 +6789,7 @@ process sentinels. They shall not disturb each other."
(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.
@ -6743,7 +6818,7 @@ process sentinels. They shall not disturb each other."
(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)
@ -6826,7 +6901,7 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * 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)