mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-13 03:06:23 -08:00
Code Issues Projects Releases Wiki Activity

Merge with Tramp 2.5.2.3 (Do not merge with master)

Browse source 
* doc/misc/tramp.texi (Archive file names): Explicitly say how to
open an archive with Tramp (Bug#25076).

* doc/misc/trampver.texi:
* lisp/net/trampver.el: Change version to "2.5.3-pre".

* lisp/net/tramp-adb.el (tramp-adb-handle-process-file)
* lisp/net/tramp-sh.el (tramp-sh-handle-process-file):
* lisp/net/tramp-smb.el (tramp-smb-handle-process-file):
* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file):
Improve implementation.  (Bug#53854)

* lisp/net/tramp-adb.el (tramp-adb-tolerate-tilde):
* lisp/net/tramp-sshfs.el (tramp-sshfs-tolerate-tilde):
New defuns.  Advice `shell-mode' with them.

* lisp/net/tramp.el (tramp-register-autoload-file-name-handlers):
* lisp/net/tramp-archive.el (tramp-register-archive-file-name-handler):
Check, whether the real file name handler is already registered.
rules.  (Bug#54542)

* lisp/net/tramp.el (tramp-autoload-file-name-handler)
(tramp-register-autoload-file-name-handlers)
(tramp-unload-file-name-handlers, tramp-unload-tramp):
* lisp/net/tramp-archive.el (tramp-archive-autoload-file-name-regexp)
(tramp-archive-autoload-file-name-handler)
(tramp-register-archive-file-name-handler):
Add `tramp-autoload' property.

* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist):
Use `tramp-handle-file-notify-add-watch',
`tramp-handle-file-notify-rm-watch' and
`tramp-handle-file-notify-valid-p'.

* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
Use `tramp-handle-insert-file-contents'.

* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
* lisp/net/lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection):
* tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection): Do not
set "lock-pid" connection-property.
(tramp-sudoedit-handle-delete-file): Use "rm -f".

* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-executable-p):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-executable-p):
Check also for setuid/setgid bit.
(tramp-gvfs-handle-expand-file-name):
Respect `tramp-tolerate-tilde'.

* lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory):
Do not modify disk space information when
`dired--insert-disk-space' is available.  (Bug#54512)

* lisp/net/tramp-sh.el (tramp-maybe-open-connection): Extend suppression
(tramp-get-remote-dev-tty): New defun.
(tramp-sh-handle-make-process): Use it.

* lisp/net/tramp-sshfs.el (tramp-methods) <sshfs>:
Add "-t -t" to `tramp-login-args'.
Add "-o dir_cache=no" to `tramp-mount-args'.  (Bug#54126)
Add "-o transform_symlinks" to `tramp-mount-args'.
(tramp-sshfs-file-name-handler-alist):
Use `tramp-sshfs-handle-file-writable-p'.
(tramp-sshfs-handle-file-writable-p): New defun.  (Bug#54130)
(tramp-sshfs-handle-write-region): Set file modification time.
(Bug#54016)
(tramp-sshfs-file-name-handler-alist):
Use `tramp-sshfs-handle-set-file-times'.
(tramp-sshfs-handle-set-file-times): New defun.

* test/lisp/net/tramp-tests.el (tramp--test-expensive-test-p):
Rename from `tramp--test-expensive-test'.  Make it a defun.  Adapt
all callees.
(tramp-test07-file-exists-p, tramp-test14-delete-directory)
(tramp-test18-file-attributes, tramp-test20-file-modes)
(tramp-test28-process-file, tramp-test29-start-file-process)
(tramp-test30-make-process, tramp-test32-shell-command)
(tramp-test33-environment-variables, tramp--test-check-files)
(tramp--test-special-characters, tramp-test46-unload): Adapt tests.
(tramp-test39-detect-external-change): New test.
(tramp-test29-start-file-process)
(tramp--test--deftest-direct-async-process)
(tramp-test30-make-process, tramp-test31-interrupt-process)
(tramp-test34-explicit-shell-file-name)
(tramp-test44-asynchronous-requests):
Add :tramp-asynchronous-processes tag.
(tramp--test-asynchronous-processes-p): New defun.
(tramp--test-hpux-p, tramp--test-macos-p): Protect against errors.
This commit is contained in:
Michael Albinus 2022-04-07 11:17:52 +02:00
parent 4161a36849
commit 009e88e002
14 changed files with 596 additions and 239 deletions
Download patch file Download diff file Expand all files Collapse all files

6
doc/misc/tramp.texi
View file

@ -4008,8 +4008,10 @@ methods}. Internally, file archives are mounted via the
@acronym{GVFS} @option{archive} method.
A file archive is a regular file of kind @file{/path/to/dir/file.EXT}.
The extension @samp{.EXT} identifies the type of the file archive. A
file inside a file archive, called archive file name, has the name
The extension @samp{.EXT} identifies the type of the file archive. To
examine the contents of an archive with Dired, open file name as if it
were a directory (i.e., open @file{/path/to/dir/file.EXT/}). A file
inside a file archive, called archive file name, has the name
@file{/path/to/dir/file.EXT/dir/file}.
Most of the @ref{Magic File Names, , magic file name operations,

2
doc/misc/trampver.texi
View file

@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
@set trampver 2.5.2.28.1
@set trampver 2.5.3-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1

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

@ -815,10 +815,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Determine input.
(if (null infile)
(setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
(setq stderr (tramp-file-local-name (cadr destination)))
(setq stderr (tramp-unquote-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@ -870,7 +870,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq ret (tramp-adb-send-command-and-check
v (format
"(cd %s; %s)"
(tramp-shell-quote-argument localname) command)
(tramp-unquote-shell-quote-argument localname)
command)
t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
@ -900,8 +901,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(unless process-file-side-effects
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.
@ -986,6 +986,10 @@ implementation will be used."
(name1 name)
(i 0))
(when (string-match-p "[[:multibyte:]]" command)
(tramp-error
v 'file-error "Cannot apply multi-byte command `%s'" command))
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
@ -1264,7 +1268,7 @@ connection if a previous connection has died for some reason."
(if (zerop (length device))
(tramp-error vec 'file-error "Device %s not connected" host))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
(args (if (> (length host) 0)
(list "-s" device "shell")
@ -1368,6 +1372,24 @@ connection if a previous connection has died for some reason."
`(:application tramp :protocol ,tramp-adb-method)
'tramp-adb-connection-local-default-shell-profile))
;; `shell-mode' tries to open remote files like "/adb::~/.history".
;; This fails, because the tilde cannot be expanded. Tell
;; `tramp-handle-expand-file-name' to tolerate this.
(defun tramp-adb-tolerate-tilde (orig-fun)
"Advice for `shell-mode' to tolerate tilde in remote file names."
(let ((tramp-tolerate-tilde
(or tramp-tolerate-tilde
(equal (file-remote-p default-directory 'method)
tramp-adb-method))))
(funcall orig-fun)))
(add-function
:around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
(add-hook 'tramp-adb-unload-hook
(lambda ()
(remove-function
(symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-adb 'force)))

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

@ -188,6 +188,8 @@ It must be supported by libarchive(3).")
"\\)" ;; \1
"\\(" "/" ".*" "\\)" "\\'"))) ;; \2
(put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t)
;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
;; is not autoloaded. So we cannot expect it to be known in
;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
@ -363,15 +365,21 @@ arguments to pass to the OPERATION."
(tramp-archive-autoload t))
(apply #'tramp-autoload-file-name-handler operation args)))))
(put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
(progn (defun tramp-register-archive-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
(when tramp-archive-enabled
(when (and tramp-archive-enabled
(not
(rassq #'tramp-archive-file-name-handler file-name-handler-alist)))
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
#'tramp-archive-autoload-file-name-handler))
(put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
(put #'tramp-register-archive-file-name-handler 'tramp-autoload t)
;;;###autoload
(progn
(add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)

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

@ -49,8 +49,6 @@
;; 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

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

@ -192,9 +192,9 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
;; `file-name-nondirectory' performed by default handler.
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . tramp-crypt-handle-file-ownership-preserved-p)
(file-readable-p . tramp-crypt-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@ -207,7 +207,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-crypt-handle-insert-directory)
;; `insert-file-contents' performed by default handler.
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
(lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)

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

@ -1160,10 +1160,9 @@ file names."
(tramp-get-connection-property v "default-location" "~")
nil t localname 1)))
;; Tilde expansion is not possible.
(when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
(tramp-error
v 'file-error
"Cannot expand tilde in file `%s'" name))
(when (and (not tramp-tolerate-tilde)
(string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; We do not pass "/..".
@ -1181,7 +1180,9 @@ file names."
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
v (tramp-run-real-handler #'expand-file-name (list localname))))))
v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
(defun tramp-gvfs-get-directory-attributes (directory)
"Return GVFS attributes association list of all files in DIRECTORY."
@ -1396,7 +1397,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
(tramp-check-cached-permissions v ?x))))
(or (tramp-check-cached-permissions v ?x)
(tramp-check-cached-permissions v ?s)))))
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@ -1612,22 +1614,18 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-file-name-user vec)
(when-let ((localname
(tramp-get-connection-property
(tramp-get-process vec) "share"
(tramp-get-connection-property vec "default-location" nil))))
(tramp-get-process vec) "share" nil)))
(tramp-compat-file-attribute-user-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format)))))
(file-attributes (tramp-make-tramp-file-name vec localname) id-format)))))
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
(when-let ((localname
(tramp-get-connection-property
(tramp-get-process vec) "share"
(tramp-get-connection-property vec "default-location" nil))))
(tramp-get-process vec) "share" nil)))
(tramp-compat-file-attribute-group-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format))))
(file-attributes (tramp-make-tramp-file-name vec localname) id-format))))
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@ -2134,9 +2132,6 @@ 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)))
@ -2256,13 +2251,7 @@ connection if a previous connection has died for some reason."
COMMAND is a command from the gvfs-* utilities. It is replaced
by the corresponding gio tool call if available. `call-process'
is applied, and it returns t if the return code is zero."
(let* ((locale (tramp-get-local-locale vec))
(process-environment
(append
`(,(format "LANG=%s" locale)
,(format "LANGUAGE=%s" locale)
,(format "LC_ALL=%s" locale))
process-environment)))
(let ((locale (tramp-get-local-locale vec)))
(when (tramp-gvfs-gio-tool-p vec)
;; Use gio tool.
(setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping))
@ -2272,7 +2261,14 @@ is applied, and it returns t if the return code is zero."
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
(or (zerop (apply #'tramp-call-process vec command nil t nil args))
(or (zerop
(apply
#'tramp-call-process vec "env" nil t nil
(append `(,(format "LANG=%s" locale)
,(format "LANGUAGE=%s" locale)
,(format "LC_ALL=%s" locale)
,command)
args)))
;; Remove information about mounted connection.
(and (tramp-flush-file-properties vec "/") nil)))))

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

@ -106,9 +106,9 @@
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-fuse-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@ -362,10 +362,6 @@ 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)))

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

@ -1574,6 +1574,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
(or (tramp-check-cached-permissions v ?x)
(tramp-check-cached-permissions v ?s)
(tramp-run-test "-x" filename)))))
(defun tramp-sh-handle-file-readable-p (filename)
@ -2663,7 +2664,9 @@ The method used must be an out-of-band method."
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
(when (and (re-search-forward "^\\([[:space:]]*total\\)" nil t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let ((available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
@ -2817,8 +2820,10 @@ implementation will be used."
(string-match-p "sh$" program)
(= (length args) 2)
(string-equal "-c" (car args))
;; Don't if there is a string.
(not (string-match-p "'\\|\"" (cadr args)))))
;; Don't if there is a quoted string.
(not (string-match-p "'\\|\"" (cadr args)))
;; Check, that /dev/tty is usable.
(tramp-get-remote-dev-tty v)))
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
@ -3080,10 +3085,10 @@ implementation will be used."
;; Determine input.
(if (null infile)
(setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input 'nohop))
@ -3114,7 +3119,7 @@ implementation will be used."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
(setq stderr (tramp-file-local-name (cadr destination)))
(setq stderr (tramp-unquote-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@ -3135,7 +3140,8 @@ implementation will be used."
(setq ret (tramp-send-command-and-check
v (format
"cd %s && %s"
(tramp-shell-quote-argument localname) command)
(tramp-unquote-shell-quote-argument localname)
command)
t t t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
@ -3167,8 +3173,7 @@ implementation will be used."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(unless process-file-side-effects
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.
@ -4093,13 +4098,10 @@ file exists and nonzero exit status otherwise."
;; The algorithm is as follows: we try a list of several commands.
;; For each command, we first run `$cmd /' -- this should return
;; true, as the root directory always exists. And then we run
;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
;; does not exist. This should return false. We use the first
;; command we find that seems to work.
;; `$cmd /\ this\ file\ does\ not\ exist\ ', hoping that the file
;; indeed does not exist. This should return false. We use the
;; first command we find that seems to work.
;; The list of commands to try is as follows:
;; `ls -d' This works on most systems, but NetBSD 1.4
;; has a bug: `ls' always returns zero exit
;; status, even for files which don't exist.
;; `test -e' Some Bourne shells have a `test' builtin
;; which does not know the `-e' option.
;; `/bin/test -e' For those, the `test' binary on disk normally
@ -4107,6 +4109,10 @@ file exists and nonzero exit status otherwise."
;; is sometimes `/bin/test' and sometimes it's
;; `/usr/bin/test'.
;; `/usr/bin/test -e' In case `/bin/test' does not exist.
;; `ls -d' This works on most systems, but NetBSD 1.4
;; has a bug: `ls' always returns zero exit
;; status, even for files which don't exist.
(unless (or
(ignore-errors
(and (setq result (format "%s -e" (tramp-get-test-command vec)))
@ -4839,6 +4845,7 @@ connection if a previous connection has died for some reason."
;; If Tramp opens the same connection within a short time frame,
;; there is a problem. We shall signal this.
(unless (or (process-live-p p)
(and (processp p) (not non-essential))
(not (tramp-file-name-equal-p
vec (car tramp-current-connection)))
(time-less-p
@ -5815,6 +5822,12 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
command))
(delete-file tmpfile)))))
(defun tramp-get-remote-dev-tty (vec)
"Check, whether remote /dev/tty is usable."
(with-tramp-connection-property vec "dev-tty"
(tramp-send-command-and-check
vec "echo </dev/tty")))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
"Return the compress command related to PROP.

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

@ -1126,7 +1126,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Insert size information.
(when full-directory-p
(insert
(if avail
(if (and avail
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(format "total used in directory %s available %s\n" used avail)
(format "total %s\n" used))))
@ -1284,10 +1286,10 @@ component is used as the target of the symlink."
;; Determine input.
(when infile
(setq infile (expand-file-name infile))
(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@ -1376,8 +1378,7 @@ component is used as the target of the symlink."
(when tmpinput (delete-file tmpinput))
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
(unless process-file-side-effects
(when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.

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

@ -51,11 +51,14 @@
(add-to-list 'tramp-methods
`(,tramp-sshfs-method
(tramp-mount-args (("-C") ("-p" "%p")
("-o" "dir_cache=no")
("-o" "transform_symlinks")
("-o" "idmap=user,reconnect")))
;; These are for remote processes.
(tramp-login-program "ssh")
(tramp-login-args (("-q")("-l" "%u") ("-p" "%p")
("-e" "none") ("%h") ("%l")))
(tramp-login-args (("-q") ("-l" "%u") ("-p" "%p")
("-e" "none") ("-t" "-t")
("%h") ("%l")))
(tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@ -106,9 +109,9 @@
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@ -117,7 +120,7 @@
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-sshfs-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-handle-file-writable-p)
(file-writable-p . tramp-sshfs-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
@ -136,7 +139,7 @@
(set-file-acl . ignore)
(set-file-modes . tramp-sshfs-handle-set-file-modes)
(set-file-selinux-context . ignore)
(set-file-times . ignore)
(set-file-times . tramp-sshfs-handle-set-file-times)
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-handle-start-file-process)
@ -219,6 +222,10 @@ arguments to pass to the OPERATION."
;;`file-system-info' exists since Emacs 27.1.
(tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename)))
(defun tramp-sshfs-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(file-writable-p (tramp-fuse-local-file-name filename)))
(defun tramp-sshfs-handle-insert-file-contents
(filename &optional visit beg end replace)
"Like `insert-file-contents' for Tramp files."
@ -239,16 +246,69 @@ arguments to pass to the OPERATION."
(error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((command
(let ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(command
(format
"cd %s && exec %s"
localname
(mapconcat #'tramp-shell-quote-argument (cons program args) " "))))
(tramp-unquote-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
input tmpinput stderr tmpstderr outbuf)
;; Determine input.
(if (null infile)
(setq input (tramp-get-remote-null-device v))
(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input 'nohop))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
;; Determine output.
(cond
;; Just a buffer.
((bufferp destination)
(setq outbuf destination))
;; A buffer name.
((stringp destination)
(setq outbuf (get-buffer-create destination)))
;; (REAL-DESTINATION ERROR-DESTINATION)
((consp destination)
;; output.
(cond
((bufferp (car destination))
(setq outbuf (car destination)))
((stringp (car destination))
(setq outbuf (get-buffer-create (car destination))))
((car destination)
(setq outbuf (current-buffer))))
;; stderr.
(cond
((stringp (cadr destination))
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
(setq stderr (tramp-unquote-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
(when stderr (setq command (format "%s 2>%s" command stderr)))
(unwind-protect
(apply
#'tramp-call-process
v (tramp-get-method-parameter v 'tramp-login-program)
infile destination display
nil outbuf display
(tramp-expand-args
v 'tramp-login-args
?h (or (tramp-file-name-host v) "")
@ -256,7 +316,20 @@ arguments to pass to the OPERATION."
?p (or (tramp-file-name-port v) "")
?l command))
(unless process-file-side-effects
;; Synchronize stderr.
(when tmpstderr
(tramp-cleanup-connection v 'keep-debug 'keep-password)
(tramp-fuse-unmount v))
;; Provide error file.
(when tmpstderr
(rename-file tmpstderr (cadr destination) t))
;; Cleanup. We remove all file cache values for the
;; connection, because the remote process could have changed
;; them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
(tramp-flush-directory-properties v ""))))))
(defun tramp-sshfs-handle-rename-file
@ -285,6 +358,15 @@ arguments to pass to the OPERATION."
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
"Like `set-file-times' for Tramp files."
(or (file-exists-p filename) (write-region "" nil filename nil 0))
(with-parsed-tramp-file-name filename nil
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
(tramp-compat-set-file-times
(tramp-fuse-local-file-name filename) timestamp flag))))
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
@ -313,6 +395,13 @@ arguments to pass to the OPERATION."
start end (tramp-fuse-local-file-name filename) append 'nomessage)
(tramp-flush-file-properties v localname))
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
(or (tramp-compat-file-attribute-modification-time
(file-attributes filename))
(current-time))))
;; Unlock file.
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
@ -345,9 +434,6 @@ 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)))
@ -386,6 +472,24 @@ connection if a previous connection has died for some reason."
(with-tramp-connection-property
vec "gid-string" (tramp-get-local-gid 'string)))
;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history".
;; This fails, because the tilde cannot be expanded. Tell
;; `tramp-handle-expand-file-name' to tolerate this.
(defun tramp-sshfs-tolerate-tilde (orig-fun)
"Advice for `shell-mode' to tolerate tilde in remote file names."
(let ((tramp-tolerate-tilde
(or tramp-tolerate-tilde
(equal (file-remote-p default-directory 'method)
tramp-sshfs-method))))
(funcall orig-fun)))
(add-function
:around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
(add-hook 'tramp-sshfs-unload-hook
(lambda ()
(remove-function
(symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-sshfs 'force)))

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

@ -99,9 +99,9 @@ See `tramp-actions-before-shell' for more info.")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-sudoedit-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@ -336,7 +336,7 @@ absolute file names."
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(unless (tramp-sudoedit-send-command
v "rm" (tramp-compat-file-name-unquote localname))
v "rm" "-f" (tramp-compat-file-name-unquote localname))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@ -789,9 +789,6 @@ 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)

6
lisp/net/trampver.el
View file

@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
;; Version: 2.5.2.28.1
;; Version: 2.5.3-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
(defconst tramp-version "2.5.2.28.1"
(defconst tramp-version "2.5.3-pre"
"This version of Tramp.")
;;;###tramp-autoload
@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
(format "Tramp 2.5.2.28.1 is not fit for %s"
(format "Tramp 2.5.3-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))

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

@ -160,13 +160,6 @@ being the result.")
;; Return result.
(cdr tramp--test-enabled-checked))
(defsubst tramp--test-expensive-test ()
"Whether expensive tests are run."
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:expensive-test)))))
(defun tramp--test-make-temp-name (&optional local quoted)
"Return a temporary file name for test.
If LOCAL is non-nil, a local file name is returned.
@ -2298,7 +2291,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `file-exist-p', `write-region' and `delete-file'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
@ -2306,8 +2299,10 @@ This checks also `file-name-as-directory', `file-name-directory',
(delete-file tmp-name)
(should-not (file-exists-p tmp-name))
;; Trashing files doesn't work on MS Windows, and for crypted remote files.
(unless (or (tramp--test-windows-nt-p) (tramp--test-crypt-p))
;; Trashing files doesn't work when `system-move-file-to-trash'
;; is defined (on MS Windows and macOS), and for crypted remote
;; files.
(unless (or (fboundp 'system-move-file-to-trash) (tramp--test-crypt-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@ -2331,7 +2326,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `file-local-copy'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
tmp-name2)
(unwind-protect
@ -2363,7 +2358,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `insert-file-contents'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(with-temp-buffer
@ -2400,7 +2395,7 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `write-region'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(inhibit-message t))
(unwind-protect
@ -2541,8 +2536,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -2569,7 +2565,7 @@ This checks also `file-name-as-directory', `file-name-directory',
(with-temp-buffer
(insert-file-contents target)
(should (string-equal (buffer-string) "foo")))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(copy-file source target)
:type 'file-already-exists))
@ -2588,7 +2584,8 @@ This checks also `file-name-as-directory', `file-name-directory',
(make-directory target)
(should (file-directory-p target))
;; This has been changed in Emacs 26.1.
(when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
(when (and (tramp--test-expensive-test-p)
(tramp--test-emacs26-p))
(should-error
(copy-file source target)
:type 'file-already-exists)
@ -2653,8 +2650,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(skip-unless (tramp--test-enabled))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -2684,7 +2682,7 @@ This checks also `file-name-as-directory', `file-name-directory',
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil source)
(should (file-exists-p source))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(rename-file source target)
:type 'file-already-exists))
@ -2703,7 +2701,8 @@ This checks also `file-name-as-directory', `file-name-directory',
(make-directory target)
(should (file-directory-p target))
;; This has been changed in Emacs 26.1.
(when (and (tramp--test-expensive-test) (tramp--test-emacs26-p))
(when (and (tramp--test-expensive-test-p)
(tramp--test-emacs26-p))
(should-error
(rename-file source target)
:type 'file-already-exists)
@ -2771,7 +2770,7 @@ This checks also `file-name-as-directory', `file-name-directory',
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo/bar" tmp-name1))
(unusual-file-mode-1 #o740)
@ -2809,7 +2808,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"Check `delete-directory'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1)))
;; Delete empty directory.
@ -2833,9 +2832,12 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should-not (file-directory-p tmp-name1))
;; Trashing directories works only since Emacs 27.1. It doesn't
;; work on MS Windows, for crypted remote directories and for ange-ftp.
(when (and (not (tramp--test-windows-nt-p)) (not (tramp--test-crypt-p))
(not (tramp--test-ftp-p)) (tramp--test-emacs27-p))
;; work when `system-move-file-to-trash' is defined (on MS
;; Windows and macOS), for crypted remote directories and for
;; ange-ftp.
(when (and (not (fboundp 'system-move-file-to-trash))
(not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))
(tramp--test-emacs27-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@ -2883,7 +2885,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (expand-file-name
@ -2994,7 +2996,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"Check `directory-files'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "bla" tmp-name1))
(tmp-name3 (expand-file-name "foo" tmp-name1)))
@ -3038,7 +3040,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
"Check `file-expand-wildcards'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tmp-name3 (expand-file-name "bar" tmp-name1))
@ -3108,7 +3110,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Emacs 27.1.
(skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
@ -3193,7 +3195,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Since Emacs 26.1.
(skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2
@ -3297,7 +3299,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Relative file names in dired are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name2 (expand-file-name "foo" tmp-name1))
@ -3351,7 +3353,7 @@ This tests also `access-file', `file-readable-p',
`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
@ -3474,8 +3476,10 @@ This tests also `access-file', `file-readable-p',
(should
(string-equal
(tramp-compat-file-attribute-type attr)
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name3))))
(funcall
(if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity)
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name3)))))
(delete-file tmp-name2))
(when test-file-ownership-preserved-p
@ -3570,7 +3574,7 @@ They might differ only in time attributes or directory size."
"Check `directory-files-and-attributes'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; `directory-files-and-attributes' contains also values for
;; "../". Ensure that this doesn't change during tests, for
;; example due to handling temporary files.
@ -3628,7 +3632,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-set-file-modes-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)))
@ -3644,8 +3648,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(should (= (file-modes tmp-name1) #o444))
(should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
(unless (zerop (tramp-compat-file-attribute-user-id
(file-attributes tmp-name1)))
(unless (or (zerop (tramp-compat-file-attribute-user-id
(file-attributes tmp-name1)))
(tramp--test-sshfs-p))
(should-not (file-writable-p tmp-name1)))
;; Check the NOFOLLOW arg. It exists since Emacs 28. For
;; regular files, there shouldn't be a difference.
@ -3723,7 +3728,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; older Emacsen, therefore.
(skip-unless (tramp--test-emacs26-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
@ -3748,11 +3753,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(if quoted #'tramp-compat-file-name-unquote #'identity)
(file-remote-p tmp-name1 'localname))
(file-symlink-p tmp-name2)))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-already-exists))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
;; A number means interactive case.
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
@ -3792,7 +3797,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
;; Check directory as newname.
(make-directory tmp-name4)
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name4)
:type 'file-already-exists))
@ -3820,7 +3825,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Check `add-name-to-file'.
(unwind-protect
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(tramp--test-ignore-add-name-to-file-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
@ -3935,11 +3940,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(string-equal
(file-truename tmp-name2)
(file-truename tmp-name3)))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name2))
:type tramp-file-missing))
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name3))
:type tramp-file-missing))
@ -3957,7 +3962,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Detect cyclic symbolic links.
(unwind-protect
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
@ -3995,7 +4000,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(or (tramp--test-adb-p) (tramp--test-gvfs-p)
(tramp--test-sh-p) (tramp--test-sudoedit-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name nil quoted)))
@ -4045,7 +4050,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `set-visited-file-modtime' and `verify-visited-file-modtime'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
@ -4078,8 +4083,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -4157,8 +4163,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
@ -4305,7 +4312,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unwind-protect
(dolist
(syntax
(if (tramp--test-expensive-test)
(if (tramp--test-expensive-test-p)
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
@ -4347,7 +4354,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-change-syntax orig-syntax))))
(dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
@ -4414,7 +4421,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `load'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
@ -4443,10 +4450,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
(fnnd (file-name-nondirectory tmp-name))
(default-directory tramp-test-temporary-file-directory)
(buffer (get-buffer-create "*tramp-tests*"))
kill-buffer-query-functions)
(unwind-protect
(progn
@ -4479,32 +4487,87 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(should (zerop (process-file "ls" nil t nil fnnd)))
;; "ls" could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should (string-equal (format "%s\n" fnnd) (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
;; Check DESTINATION.
(dolist (destination `(nil t ,buffer))
(when (bufferp destination)
(with-current-buffer destination
(delete-region (point-min) (point-max))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(should (zerop (process-file "ls" nil destination nil fnnd)))
(with-current-buffer
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
(while (re-search-forward
tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (if destination (format "%s\n" fnnd) "")
(buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(goto-char (point-max)))
;; Second run. The output must be appended.
(goto-char (point-max))
(should (zerop (process-file "ls" nil t t fnnd)))
;; "ls" could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
;; A non-nil DISPLAY must not raise the buffer.
(should-not (get-buffer-window (current-buffer) t))))
;; Second run. The output must be appended.
(should (zerop (process-file "ls" nil destination t fnnd)))
(with-current-buffer
(if (bufferp destination) destination (current-buffer))
;; "ls" could produce colorized output.
(goto-char (point-min))
(while (re-search-forward
tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
(if destination (format "%s\n%s\n" fnnd fnnd) "")
(buffer-string))))
(unless (eq destination t)
(should (string-empty-p (buffer-string))))
;; A non-nil DISPLAY must not raise the buffer.
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))
;; Check remote and local INFILE.
(dolist (local '(nil t))
(with-temp-buffer
(setq tmp-name (tramp--test-make-temp-name local quoted))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(should (zerop (process-file "cat" tmp-name t)))
(should (string-equal "foo" (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))
;; Check remote and local DESTNATION file. This isn't
;; implemented yet ina all file name handler backends.
;; (dolist (local '(nil t))
;; (setq tmp-name (tramp--test-make-temp-name local quoted))
;; (should
;; (zerop (process-file "echo" nil `(:file ,tmp-name) nil "foo")))
;; (with-temp-buffer
;; (insert-file-contents tmp-name)
;; (should (string-equal "foo" (buffer-string)))
;; (should-not (get-buffer-window (current-buffer) t))
;; (delete-file tmp-name)))
;; Check remote and local STDERR.
(dolist (local '(nil t))
(setq tmp-name (tramp--test-make-temp-name local quoted))
(should-not
(zerop
(process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
(with-temp-buffer
(insert-file-contents tmp-name)
(should
(string-match-p
"cat:.* No such file or directory" (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-file tmp-name))))))
;; Must be a command, because used as `sigusr1' handler.
@ -4519,11 +4582,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
:tags '(:expensive-test)
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
@ -4586,8 +4649,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc)))
;; "telnet" and "sshfs" do not cooperate with disabled filter.
(unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
;; Disabled process filter. "sshfs" does not cooperate.
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test3" (current-buffer) "cat"))
@ -4596,8 +4659,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(set-process-filter proc t)
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
;; Read output. There shouldn't be any.
(with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
;; No output due to process filter.
@ -4675,7 +4738,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
,docstring
:tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and ,unstable '(:unstable)))
(skip-unless (tramp--test-enabled))
(let ((default-directory tramp-test-temporary-file-directory)
(ert-test (ert-get-test ',test))
@ -4698,13 +4762,15 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
:tags '(:expensive-test)
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and (getenv "EMACS_EMBA_CI")
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
@ -4778,8 +4844,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup.
(ignore-errors (delete-process proc)))
;; "telnet" and "sshfs" do not cooperate with disabled filter.
(unless (or (tramp--test-telnet-p) (tramp--test-sshfs-p))
;; Disabled process filter. "sshfs" does not cooperate.
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
(setq proc
@ -4792,8 +4858,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(should (equal (process-status proc) 'run))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
;; Read output. There shouldn't be any.
(with-timeout (10)
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
;; No output due to process filter.
@ -4941,8 +5007,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
:tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
'(:expensive-test :unstable) '(:expensive-test))
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
@ -5009,7 +5076,7 @@ INPUT, if non-nil, is a string sent to the process."
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(default-directory tramp-test-temporary-file-directory)
;; Suppress nasty messages.
@ -5017,10 +5084,12 @@ INPUT, if non-nil, is a string sent to the process."
kill-buffer-query-functions)
(dolist (this-shell-command
'(;; Synchronously.
shell-command
;; Asynchronously.
tramp--test-async-shell-command))
(append
;; Synchronously.
'(shell-command)
;; Asynchronously.
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-async-shell-command))))
;; Test ordinary `{async-}shell-command'.
(unwind-protect
@ -5061,31 +5130,34 @@ INPUT, if non-nil, is a string sent to the process."
(ignore-errors (kill-buffer stderr))))))
;; Test sending string to `async-shell-command'.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(tramp--test-async-shell-command
"read line; ls $line" (current-buffer) nil
;; String to be sent.
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
(string-equal
;; tramp-adb.el echoes, so we must add the string.
(if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
(file-name-nondirectory tmp-name))
(format "%s\n" (file-name-nondirectory tmp-name)))
(buffer-string))))
(when (tramp--test-asynchronous-processes-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(tramp--test-async-shell-command
"read line; ls $line" (current-buffer) nil
;; String to be sent.
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
(string-equal
;; tramp-adb.el echoes, so we must add the string.
(if (and (tramp--test-adb-p)
(not (tramp-direct-async-process-p)))
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
(file-name-nondirectory tmp-name))
(format "%s\n" (file-name-nondirectory tmp-name)))
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
;; Test `async-shell-command-width'. It exists since Emacs 26.1,
;; but seems to work since Emacs 27.1 only.
(when (and (tramp--test-sh-p) (tramp--test-emacs27-p))
(when (and (tramp--test-asynchronous-processes-p)
(tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
(default-directory tramp-test-temporary-file-directory)
(cols (ignore-errors
@ -5232,10 +5304,12 @@ INPUT, if non-nil, is a string sent to the process."
(skip-unless (not (tramp--test-crypt-p)))
(dolist (this-shell-command-to-string
'(;; Synchronously.
shell-command-to-string
;; Asynchronously.
tramp--test-shell-command-to-string-asynchronously))
(append
;; Synchronously.
'(shell-command-to-string)
;; Asynchronously.
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-shell-command-to-string-asynchronously))))
(let ((default-directory tramp-test-temporary-file-directory)
(shell-file-name "/bin/sh")
@ -5424,7 +5498,7 @@ Use direct async.")
;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test34-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
:tags '(:expensive-test)
:tags '(:expensive-test :tramp-asynchronous-processes)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
@ -5598,7 +5672,7 @@ Use direct async.")
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
;; process.
@ -5668,7 +5742,7 @@ Use direct async.")
"Check `make-auto-save-file-name'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
tramp-allow-unsafe-temporary-files)
@ -5791,7 +5865,7 @@ Use direct async.")
"Check `find-backup-file-name'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(ange-ftp-make-backup-files t)
@ -5943,7 +6017,7 @@ Use direct async.")
;; `lock-file', `unlock-file', `file-locked-p' and
;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
;; see compiler warnings for older Emacsen.
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(remote-file-name-inhibit-cache t)
@ -6064,6 +6138,79 @@ 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-detect-external-change ()
"Check that an external file modification is reported."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
;; Since Emacs 28.1.
(skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(dolist (create-lockfiles '(nil t))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(remote-file-name-inhibit-cache t)
(remote-file-name-inhibit-locks nil)
tramp-allow-unsafe-temporary-files
(inhibit-message t)
;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
(tramp-fuse-unmount-on-cleanup t)
auto-save-default
(backup-inhibited t)
noninteractive)
(with-temp-buffer
(unwind-protect
(progn
(setq buffer-file-name tmp-name
buffer-file-truename tmp-name)
(insert "foo")
;; Bug#53207: with `create-lockfiles' nil, saving the
;; buffer results in a prompt.
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (_) (ert-fail "Test failed unexpectedly"))))
(save-buffer))
(should-not (file-locked-p tmp-name))
;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
(with-no-warnings (when (symbol-plist 'ert-with-message-capture)
;; For local files, just changing the file
;; modification on disk doesn't hurt, because file
;; contents in buffer and on disk are equal. For
;; remote files, file contents is not compared. We
;; mock an older modification time in buffer,
;; because Tramp regards modification times equal if
;; they differ for less than 2 seconds.
(set-visited-file-modtime (time-add (current-time) -60))
;; Some Tramp methods cannot check the file
;; modification time properly, for them it doesn't
;; make sense to test.
(when (not (verify-visited-file-modtime))
(cl-letf (((symbol-function 'read-char-choice)
(lambda (prompt &rest _) (message "%s" prompt) ?y)))
(ert-with-message-capture captured-messages
(insert "bar")
(when create-lockfiles
(should (string-match-p
(format
"^%s changed on disk; really edit the buffer\\?"
(if (tramp--test-crypt-p)
".+" (file-name-nondirectory tmp-name)))
captured-messages))
(should (file-locked-p tmp-name)))))
;; `save-buffer' removes the file lock.
(cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always)
((symbol-function 'read-char-choice)
(lambda (&rest _) ?y)))
(save-buffer))
(should-not (file-locked-p tmp-name))))))
;; Cleanup.
(set-buffer-modified-p nil)
(ignore-errors (delete-file tmp-name))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)))))))
;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
@ -6131,6 +6278,19 @@ This requires restrictions of file name syntax."
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-ftp-file-name-handler))
(defun tramp--test-asynchronous-processes-p ()
"Whether asynchronous processes tests are run.
This is used in tests which we dont't want to tag
`:tramp-asynchronous-processes' completely."
(and
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:tramp-asynchronous-processes))))
;; tramp-adb.el cannot apply multi-byte commands.
(not (and (tramp--test-adb-p)
(string-match-p "[[:multibyte:]]" default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is crypted."
(tramp-crypt-file-name-p tramp-test-temporary-file-directory))
@ -6141,6 +6301,15 @@ This does not support some special file names."
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
This is used in tests which we dont't want to tag `:expensive'
completely."
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
(list (make-ert-test :name (ert-test-name (ert-running-test))
:body nil :tags '(:expensive-test)))))
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
@ -6169,7 +6338,7 @@ If optional METHOD is given, it is checked first."
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
(file-truename tramp-test-temporary-file-directory)
(tramp-check-remote-uname tramp-test-vec "^HP-UX"))
(ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX")))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
@ -6184,7 +6353,7 @@ a $'' syntax."
"Check, whether the remote host runs macOS."
;; We must refill the cache. `file-truename' does it.
(file-truename tramp-test-temporary-file-directory)
(tramp-check-remote-uname tramp-test-vec "Darwin"))
(ignore-errors (tramp-check-remote-uname tramp-test-vec "Darwin")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
@ -6284,8 +6453,9 @@ This requires restrictions of file name syntax."
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p))
'(nil t) '(nil)))
(dolist (quoted
(if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p))
'(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
@ -6437,6 +6607,31 @@ This requires restrictions of file name syntax."
(delete-file file3)
(should-not (file-exists-p file3))))
;; Check, that a process runs on a remote
;; `default-directory' with special characters. See
;; Bug#53846.
(when (and (tramp--test-expensive-test-p)
(tramp--test-supports-processes-p)
;; Prior Emacs 27, `shell-file-name' was
;; hard coded as "/bin/sh" for remote
;; processes in Emacs. That doesn't work
;; for tramp-adb.el. tramp-sshfs.el times
;; out for older Emacsen, reason unknown.
(or (and (not (tramp--test-adb-p))
(not (tramp--test-sshfs-p)))
(tramp--test-emacs27-p)))
(let ((default-directory file1))
(dolist (this-shell-command
(append
;; Synchronously.
'(shell-command)
;; Asynchronously.
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-async-shell-command))))
(with-temp-buffer
(funcall this-shell-command "cat -- *" (current-buffer))
(should (string-equal elt (buffer-string)))))))
(delete-file file2)
(should-not (file-exists-p file2))
(delete-directory file1)
@ -6445,7 +6640,7 @@ This requires restrictions of file name syntax."
;; Check, that environment variables are set correctly.
;; We do not run on macOS due to encoding problems. See
;; Bug#36940.
(when (and (tramp--test-expensive-test) (tramp--test-sh-p)
(when (and (tramp--test-expensive-test-p) (tramp--test-sh-p)
(not (tramp--test-crypt-p))
(not (eq system-type 'darwin)))
(dolist (elt files)
@ -6506,7 +6701,7 @@ This requires restrictions of file name syntax."
(unless (or (tramp--test-ftp-p)
(tramp--test-gvfs-p)
(tramp--test-windows-nt-or-smb-p))
"*foo*bar*baz*")
"*foo+bar*baz+")
(if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
"'foo'bar'baz'"
"'foo\"bar'baz\"")
@ -6527,7 +6722,7 @@ This requires restrictions of file name syntax."
"{foo}bar{baz}")))
;; Simplify test in order to speed up.
(apply #'tramp--test-check-files
(if (tramp--test-expensive-test)
(if (tramp--test-expensive-test-p)
files (list (mapconcat #'identity files ""))))))
;; These tests are inspired by Bug#17238.
@ -6626,7 +6821,7 @@ Use the \"ls\" command."
;; to U+1FFFF).
"🌈🍒👋")
(when (tramp--test-expensive-test)
(when (tramp--test-expensive-test-p)
(delete-dups
(mapcar
;; Use all available language specific snippets.
@ -6798,8 +6993,10 @@ This is needed in timer functions as well as process filters and sentinels."
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
:tags (if (getenv "EMACS_EMBA_CI")
'(:expensive-test :unstable) '(:expensive-test))
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and (or (getenv "EMACS_HYDRA_CI")
(getenv "EMACS_EMBA_CI"))
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
@ -7113,7 +7310,6 @@ process sentinels. They shall not disturb each other."
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
(skip-unless noninteractive)
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
(skip-unless (tramp--test-emacs26-p))
@ -7126,28 +7322,34 @@ Since it unloads Tramp, it shall be the last test to run."
(should (featurep 'tramp-archive))
;; This unloads also tramp-archive.el and tramp-theme.el if needed.
(unload-feature 'tramp 'force)
;; No Tramp feature must be left.
;; No Tramp feature must be left except the test packages.
(should-not (featurep 'tramp))
(should-not (featurep 'tramp-archive))
(should-not (featurep 'tramp-theme))
(should-not
(all-completions
"tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features))))
;; `file-name-handler-alist' must be clean.
(should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist)))
;; There shouldn't be left a bound symbol, except buffer-local
;; variables, and autoload functions. We do not regard our test
;; variables, and autoloaded functions. We do not regard our test
;; symbols, and the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
(and (functionp x) (null (autoloadp (symbol-function x))))
(macrop x))
(string-match-p "^tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
(not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
(not (string-match-p "unload-hook$" (symbol-name x)))
(not (get x 'tramp-autoload))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
(should-not (cl--find-class 'tramp-file-name))
@ -7156,6 +7358,7 @@ Since it unloads Tramp, it shall be the last test to run."
(and (functionp x)
(string-match-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
@ -7165,7 +7368,24 @@ Since it unloads Tramp, it shall be the last test to run."
(not (string-match-p "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))
;; There shouldn't be left an advice function from Tramp.
(mapatoms
(lambda (x)
(and (functionp x)
(advice-mapc
(lambda (fun _symbol)
(and (string-match-p "^tramp" (symbol-name fun))
(ert-fail
(format "Function `%s' still contains Tramp advice" x))))
x))))
;; Reload.
(require 'tramp)
(require 'tramp-archive)
(should (featurep 'tramp))
(should (featurep 'tramp-archive)))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp].