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

Add make-nearby-temp-file' and temporary-file-directory'

Browse source 
* doc/lispref/files.texi (Unique File Names):
Introduce `make-nearby-temp-file' and `temporary-file-directory'.
(Magic File Names): Mention `make-nearby-temp-file' and
`temporary-file-directory'.

* etc/NEWS (provided): Mention `make-nearby-temp-file' and
`temporary-file-directory'.

* lisp/files.el (mounted-file-systems): New defcustom.
(temporary-file-directory, make-nearby-temp-file): New defuns.
(normal-backup-enable-predicate): Fix docstring.

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
<make-nearby-temp-file, temporary-file-directory>: Add handler.

* lisp/net/tramp.el (tramp-file-name-for-operation):
Add `make-nearby-temp-file' and `temporary-file-directory'.
(tramp-get-remote-tmpdir): Remove compatibility code.
(tramp-handle-temporary-file-directory)
(tramp-handle-make-nearby-temp-file): New defuns.

* lisp/org/ob-core.el (org-babel-local-file-name):
* lisp/progmodes/gud.el (gud-common-init):
* lisp/vc/vc-hooks.el (vc-user-login-name): Use `file-remote-p'.

* lisp/vc/vc-git.el (vc-git-checkin): Handle remote log message.

* test/lisp/net/tramp-tests.el (tramp-test06-directory-file-name):
Check `tramp--test-enabled'.
(tramp-test18-file-attributes): Add tests for
`file-ownership-preserved-p'.
(tramp-test27-start-file-process, tramp-test28-shell-command):
Reduce timeouts in `accept-process-output'.
(tramp-test--shell-command-to-string-asynchronously): Add timeout.
(tramp-test29-environment-variables): Remove additional sleep calls.
(tramp-test32-make-nearby-temp-file): New test.
(tramp--test-special-characters, tramp--test-utf8): Adapt docstring.
(tramp-test33-special-characters)
(tramp-test33-special-characters-with-stat)
(tramp-test33-special-characters-with-perl)
(tramp-test33-special-characters-with-ls, tramp-test34-utf8)
(tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
(tramp-test34-utf8-with-ls)
(tramp-test35-asynchronous-requests)
(tramp-test36-recursive-load, tramp-test37-unload): Rename.
(tramp--test-ftp-p): Simplify check.
(tramp--test-sh-p): New defun.
(tramp-test20-file-modes, tramp-test22-file-times)
(tramp-test26-process-file, tramp-test27-start-file-process)
(tramp-test28-shell-command)
(tramp-test29-environment-variables)
(tramp-test30-vc-registered)
(tramp-test33-special-characters-with-stat)
(tramp-test33-special-characters-with-perl)
(tramp-test33-special-characters-with-ls)
(tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
(tramp-test34-utf8-with-ls)
(tramp-test35-asynchronous-requests): Use it.
This commit is contained in:
Michael Albinus 2016-08-07 13:57:23 +02:00
parent a798547727
commit 2c0506173d
13 changed files with 249 additions and 149 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
doc/lispref/files.texi
View file

@ -2440,6 +2440,50 @@ condition, between the @code{make-temp-name} call and the creation of
the file, which in some cases may cause a security hole.
@end defun
Sometimes, it is necessary to create a temporary file on a remote host
or a mounted directory. The following two functions support this.
@defun make-nearby-temp-file prefix &optional dir-flag suffix
This function is similar to @code{make-temp-file}, but it creates a
temporary file as close as possible to @code{default-directory}. If
@var{prefix} is a relative file name, and @code{default-directory} is
a remote file name or located on a mounted file systems, the temporary
file is created in the directory returned by the function
@code{temporary-file-directory}. Otherwise, the function
@code{make-temp-file} is used. @var{prefix}, @var{dir-flag} and
@var{suffix} have the same meaning as in @code{make-temp-file}.
@example
@group
(let ((default-directory "/ssh:remotehost:"))
(make-nearby-temp-file "foo"))
@result{} "/ssh:remotehost:/tmp/foo232J6v"
@end group
@end example
@end defun
@defun temporary-file-directory
The directory for writing temporary files via
@code{make-nearby-temp-file}. In case of a remote
@code{default-directory}, this is a directory for temporary files on
that remote host. If such a directory does not exist, or
@code{default-directory} ought to be located on a mounted file system
(see @code{mounted-file-systems}), the function returns
@code{default-directory}. For a non-remote and non-mounted
@code{default-directory}, the value of the variable
@code{temporary-file-directory} is returned.
@end defun
In order to extract the local part of the path name from a temporary
file, the following code could be used:
@example
@group
(let ((tmpfile (make-nearby-temp-file "foo")))
(or (file-remote-p tmpfile 'localname) tmpfile))
@end group
@end example
@node File Name Completion
@subsection File Name Completion
@cindex file name completion subroutines
@ -2903,6 +2947,7 @@ first, before handlers for jobs such as remote file access.
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
@code{make-nearby-temp-file},
@code{make-symbolic-link},@*
@code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
@ -2910,6 +2955,7 @@ first, before handlers for jobs such as remote file access.
@code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process},
@code{substitute-in-file-name},@*
@code{temporary-file-directory},
@code{unhandled-file-name-directory},
@code{vc-registered},
@code{verify-visited-file-modtime},@*

6
etc/NEWS
View file

@ -563,7 +563,11 @@ ABBR is a time zone abbreviation. The affected functions are
The Info-quoted and tex-verbatim faces now default to inheriting from it.
** New built-in function `mapcan' which avoids unnecessary consing (and garbage
collection).
collection).
+++
** The new functions `make-nearby-temp-file' and `temporary-file-directory'
can be used for creation of temporary files of remote or mounted directories.
* Changes in Emacs 25.2 on Non-Free Operating Systems

47
lisp/files.el
View file

@ -1314,6 +1314,36 @@ Optional second argument FLAVOR controls the units and the display format:
(car post-fixes))
(if (eq flavor 'iec) "iB" ""))))
(defcustom mounted-file-systems
(if (memq system-type '(windows-nt cygwin))
"^//[^/]+/"
;; regexp-opt.el is not dumped into emacs binary.
;;(concat
;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
"^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
"File systems which ought to be mounted."
:group 'files
:version "25.2"
:require 'regexp-opt
:type 'regexp)
(defun temporary-file-directory ()
"The directory for writing temporary files.
In case of a remote `default-directory', this is a directory for
temporary files on that remote host. If such a directory does
not exist, or `default-directory' ought to be located on a
mounted file system (see `mounted-file-systems'), the function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
(if handler
(funcall handler 'temporary-file-directory)
(if (string-match mounted-file-systems default-directory)
default-directory
temporary-file-directory))))
(defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
@ -1350,6 +1380,21 @@ If SUFFIX is non-nil, add that at the end of the file name."
nil)
file)))
(defun make-nearby-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file as close as possible to `default-directory'.
If PREFIX is a relative file name, and `default-directory' is a
remote file name or located on a mounted file systems, the
temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
(let ((handler (find-file-name-handler
default-directory 'make-nearby-temp-file)))
(if (and handler (not (file-name-absolute-p default-directory)))
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))))
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
The value is a new name of FILE.
@ -4404,7 +4449,7 @@ ignored."
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and /tmp."
`small-temporary-file-directory', and \"/tmp\"."
(let ((temporary-file-directory temporary-file-directory)
caseless)
;; On MS-Windows, file-truename will convert short 8+3 aliases to

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

@ -148,6 +148,7 @@ It is used for TCP/IP devices."
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
@ -159,6 +160,7 @@ It is used for TCP/IP devices."
(shell-command . tramp-adb-handle-shell-command)
(start-file-process . tramp-adb-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)

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

@ -502,6 +502,7 @@ Every entry is a list (NAME ADDRESS).")
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
@ -513,6 +514,7 @@ Every entry is a list (NAME ADDRESS).")
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)

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

@ -1043,6 +1043,7 @@ of command line.")
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file)
@ -1054,6 +1055,7 @@ of command line.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-sh-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)

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

@ -265,6 +265,7 @@ See `tramp-actions-before-shell' for more info.")
(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)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
@ -276,6 +277,7 @@ See `tramp-actions-before-shell' for more info.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)

22
lisp/net/tramp.el
View file

@ -1917,7 +1917,9 @@ ARGS are the arguments OPERATION has been called with."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((member operation
'(process-file shell-command start-file-process))
'(process-file shell-command start-file-process
;; Emacs 25.2+ only.
make-nearby-temp-file temporary-file-directory))
default-directory)
;; PROC.
((member operation
@ -3893,9 +3895,6 @@ be granted."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(when (file-remote-p (tramp-get-connection-property vec "tmpdir" ""))
;; Compatibility code: Cached value shall be the local path only.
(tramp-set-connection-property vec "tmpdir" 'undef))
(let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
@ -3985,6 +3984,21 @@ ALIST is of the form ((FROM . TO) ...)."
(setq alist (cdr alist))))
string))
(defun tramp-handle-temporary-file-directory ()
"Like `temporary-file-directory' for Tramp files."
(catch 'result
(dolist (dir `(,(ignore-errors
(tramp-get-remote-tmpdir
(tramp-dissect-file-name default-directory)))
,default-directory))
(when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
(throw 'result (expand-file-name dir))))))
(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
"Like `make-nearby-temp-file' for Tramp files."
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))
;;; Compatibility functions section:
(defun tramp-call-process

13
lisp/org/ob-core.el
View file

@ -43,11 +43,6 @@
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
(filename &optional dir-flag))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
(declare-function tramp-file-name-user "tramp" (vec))
(declare-function tramp-file-name-host "tramp" (vec))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)
t)
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-edit-src-code "org-src"
(&optional context code edit-buffer-name))
@ -2670,7 +2665,7 @@ of the string."
(start end program &optional delete buffer display &rest args)
"Use Tramp to handle `call-process-region'.
Fixes a bug in `tramp-handle-call-process-region'."
(if (and (featurep 'tramp) (file-remote-p default-directory))
(if (file-remote-p default-directory)
(let ((tmpfile (tramp-compat-make-temp-file "")))
(write-region start end tmpfile)
(when delete (delete-region start end))
@ -2687,11 +2682,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
(if (file-remote-p file)
(let (localname)
(with-parsed-tramp-file-name file nil
localname))
file))
(or (file-remote-p file 'localname) file))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.

6
lisp/progmodes/gud.el
View file

@ -2567,9 +2567,6 @@ comint mode, which see."
:group 'gud
:type 'boolean)
(declare-function tramp-file-name-localname "tramp" (vec))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
;; Perform initializations common to all debuggers.
;; The first arg is the specified command line,
;; which starts with the program to debug.
@ -2628,8 +2625,7 @@ comint mode, which see."
(setcar w
(if (file-remote-p file)
;; Tramp has already been loaded if we are here.
(setq file (tramp-file-name-localname
(tramp-dissect-file-name file)))
(setq file (file-remote-p file 'localname))
file))))
(apply 'make-comint (concat "gud" filepart) program nil
(if massage-args (funcall massage-args file args) args))

7
lisp/vc/vc-git.el
View file

@ -705,7 +705,12 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; arguments must be in the system codepage, and therefore
;; might not support the non-ASCII characters in the log
;; message.
(if (eq system-type 'windows-nt) (make-temp-file "git-msg"))))
(if (eq system-type 'windows-nt)
(if (file-remote-p file1)
(let ((default-directory (file-name-directory file1)))
(file-remote-p
(make-nearby-temp-file "git-msg") 'localname))
(make-temp-file "git-msg")))))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))

2
lisp/vc/vc-hooks.el
View file

@ -394,7 +394,7 @@ For registered files, the possible values are:
(defun vc-user-login-name (file)
"Return the name under which the user accesses the given FILE."
(or (and (eq (string-match tramp-file-name-regexp file) 0)
(or (and (file-remote-p file)
;; tramp case: execute "whoami" via tramp
(let ((default-directory (file-name-directory file))
process-file-side-effects)

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

@ -639,23 +639,24 @@ This checks also `file-name-as-directory', `file-name-directory',
(unhandled-file-name-directory "/method:host:/path/to/file"))
;; Bug#10085.
(dolist (n-e '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
(let ((non-essential n-e)
tramp-default-method)
(dolist (file
`(,(file-remote-p tramp-test-temporary-file-directory 'method)
,(file-remote-p tramp-test-temporary-file-directory 'host)))
(unless (zerop (length file))
(setq file (format "/%s:" file))
(should (string-equal (directory-file-name file) file))
(should
(string-equal
(file-name-as-directory file)
(if (tramp-completion-mode-p) file (concat file "./"))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
(dolist (n-e '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
(let ((non-essential n-e)
tramp-default-method)
(dolist (file
`(,(file-remote-p tramp-test-temporary-file-directory 'method)
,(file-remote-p tramp-test-temporary-file-directory 'host)))
(unless (zerop (length file))
(setq file (format "/%s:" file))
(should (string-equal (directory-file-name file) file))
(should
(string-equal
(file-name-as-directory file)
(if (tramp-completion-mode-p) file (concat file "./"))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) ""))))))))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
@ -1091,7 +1092,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p' and `file-regular-p'."
This tests also `file-readable-p', `file-regular-p' and
`file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
;; We must use `file-truename' for the temporary directory, because
@ -1111,10 +1113,16 @@ This tests also `file-readable-p' and `file-regular-p'."
attr)
(unwind-protect
(progn
;; `file-ownership-preserved-p' should return t for
;; non-existing files. It is implemented only in tramp-sh.el.
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
@ -1138,9 +1146,13 @@ This tests also `file-readable-p' and `file-regular-p'."
(condition-case err
(progn
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should (string-equal
(car attr)
@ -1167,11 +1179,15 @@ This tests also `file-readable-p' and `file-regular-p'."
(tramp-file-name-localname (tramp-dissect-file-name tmp-name3))))
(delete-file tmp-name2))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(delete-file tmp-name1)
(make-directory tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (eq (car attr) t)))
@ -1227,13 +1243,7 @@ This tests also `file-readable-p' and `file-regular-p'."
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless
(not
(memq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'(tramp-adb-file-name-handler
tramp-gvfs-file-name-handler
tramp-smb-file-name-handler))))
(skip-unless (tramp--test-sh-p))
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
@ -1337,11 +1347,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
(skip-unless (tramp--test-enabled))
(skip-unless
(not
(memq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name))
@ -1499,11 +1505,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(not
(memq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'(tramp-gvfs-file-name-handler tramp-smb-file-name-handler))))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(let* ((tmp-name (tramp--test-make-temp-name))
(fnnd (file-name-nondirectory tmp-name))
@ -1548,13 +1550,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(not
(memq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'(tramp-adb-file-name-handler
tramp-gvfs-file-name-handler
tramp-smb-file-name-handler))))
(skip-unless (tramp--test-sh-p))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name))
@ -1569,7 +1565,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@ -1587,7 +1583,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@ -1608,7 +1604,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Read output.
(with-timeout (10 (ert-fail "`start-file-process' timed out"))
(while (< (- (point-max) (point-min)) (length "foo"))
(accept-process-output proc 1)))
(accept-process-output proc 0.1)))
(should (string-equal (buffer-string) "foo")))
;; Cleanup.
@ -1618,13 +1614,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `shell-command'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(not
(memq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'(tramp-adb-file-name-handler
tramp-gvfs-file-name-handler
tramp-smb-file-name-handler))))
(skip-unless (tramp--test-sh-p))
(let ((tmp-name (tramp--test-make-temp-name))
(default-directory tramp-test-temporary-file-directory)
@ -1657,7 +1647,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min))
(1+ (length (file-name-nondirectory tmp-name))))
(accept-process-output (get-buffer-process (current-buffer)) 1)))
(accept-process-output
(get-buffer-process (current-buffer)) 0.1)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
@ -1686,7 +1677,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min))
(1+ (length (file-name-nondirectory tmp-name))))
(accept-process-output (get-buffer-process (current-buffer)) 1)))
(accept-process-output
(get-buffer-process (current-buffer)) 0.1)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
@ -1708,9 +1700,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(async-shell-command command (current-buffer))
;; Suppress nasty messages.
(set-process-sentinel (get-buffer-process (current-buffer)) nil)
(while (get-buffer-process (current-buffer))
(accept-process-output (get-buffer-process (current-buffer)) 0.1))
(accept-process-output)
(with-timeout (10)
(while (get-buffer-process (current-buffer))
(accept-process-output (get-buffer-process (current-buffer)) 0.1)))
(accept-process-output nil 0.1)
(buffer-substring-no-properties (point-min) (point-max))))
;; This test is inspired by Bug#23952.
@ -1718,10 +1711,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check that remote processes set / unset environment variables properly."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (tramp--test-sh-p))
(dolist (this-shell-command-to-string
'(;; Synchronously.
@ -1798,10 +1788,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `vc-registered'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (tramp--test-sh-p))
(let* ((default-directory tramp-test-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name))
@ -1947,6 +1934,36 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-directory tmp-name2 'recursive)))))
(ert-deftest tramp-test32-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
(let ((default-directory tramp-test-temporary-file-directory)
tmp-file)
;; The remote host shall know a tempory file directory.
(should (stringp (temporary-file-directory)))
(should
(string-equal
(file-remote-p default-directory)
(file-remote-p (temporary-file-directory))))
;; The temporary file shall be located on the remote host.
(setq tmp-file (make-nearby-temp-file "tramp-test"))
(should (file-exists-p tmp-file))
(should (file-regular-p tmp-file))
(should
(string-equal
(file-remote-p default-directory)
(file-remote-p tmp-file)))
(delete-file tmp-file)
(should-not (file-exists-p tmp-file))
(setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
(should (file-exists-p tmp-file))
(should (file-directory-p tmp-file))
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."
@ -1956,11 +1973,13 @@ This requires restrictions of file name syntax."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
(and (eq (tramp-find-foreign-file-name-handler
tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler)
(string-match
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))))
(string-match
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p ()
"Check, whether the remote host runs a GVFS based method.
This requires restrictions of file name syntax."
(tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
@ -1968,10 +1987,11 @@ This does not support special file names."
(string-equal
"rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p ()
"Check, whether the remote host runs a GVFS based method.
This requires restrictions of file name syntax."
(tramp-gvfs-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(defun tramp--test-smb-or-windows-nt-p ()
"Check, whether the locale or remote host runs MS Windows.
@ -2123,7 +2143,7 @@ Several special characters do not work properly there."
(ignore-errors (delete-directory tmp-name2 'recursive)))))
(defun tramp--test-special-characters ()
"Perform the test in `tramp-test32-special-characters*'."
"Perform the test in `tramp-test33-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
@ -2164,23 +2184,19 @@ Several special characters do not work properly there."
"{foo}bar{baz}"))
;; These tests are inspired by Bug#17238.
(ert-deftest tramp-test32-special-characters ()
(ert-deftest tramp-test33-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(tramp--test-special-characters))
(ert-deftest tramp-test32-special-characters-with-stat ()
(ert-deftest tramp-test33-special-characters-with-stat ()
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@ -2191,16 +2207,12 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
(ert-deftest tramp-test32-special-characters-with-perl ()
(ert-deftest tramp-test33-special-characters-with-perl ()
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@ -2214,16 +2226,12 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
(ert-deftest tramp-test32-special-characters-with-ls ()
(ert-deftest tramp-test33-special-characters-with-ls ()
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(let ((tramp-connection-properties
(append
@ -2238,7 +2246,7 @@ Use the `ls' command."
(tramp--test-special-characters)))
(defun tramp--test-utf8 ()
"Perform the test in `tramp-test33-utf8*'."
"Perform the test in `tramp-test34-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
@ -2252,23 +2260,19 @@ Use the `ls' command."
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
(ert-deftest tramp-test33-utf8 ()
(ert-deftest tramp-test34-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(tramp--test-utf8))
(ert-deftest tramp-test33-utf8-with-stat ()
(ert-deftest tramp-test34-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@ -2279,16 +2283,12 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-utf8)))
(ert-deftest tramp-test33-utf8-with-perl ()
(ert-deftest tramp-test34-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@ -2302,16 +2302,12 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-utf8)))
(ert-deftest tramp-test33-utf8-with-ls ()
(ert-deftest tramp-test34-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (and (tramp--test-sh-p) (not (tramp--test-rsync-p))))
(let ((tramp-connection-properties
(append
@ -2326,7 +2322,7 @@ Use the `ls' command."
(tramp--test-utf8)))
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test34-asynchronous-requests ()
(ert-deftest tramp-test35-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@ -2334,10 +2330,7 @@ process sentinels. They shall not disturb each other."
:expected-result :failed
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless
(eq
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-sh-file-name-handler))
(skip-unless (tramp--test-sh-p))
;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This
;; has the side effect, that this test fails instead to abort. Good
@ -2416,7 +2409,7 @@ process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(ignore-errors (kill-buffer buf)))))))
(ert-deftest tramp-test35-recursive-load ()
(ert-deftest tramp-test36-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@ -2439,7 +2432,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test36-unload ()
(ert-deftest tramp-test37-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
;; Mark as failed until all symbols are unbound.
@ -2477,7 +2470,6 @@ Since it unloads Tramp, it shall be the last test to run."
;; * dired-compress-file
;; * dired-uncache
;; * file-acl
;; * file-ownership-preserved-p
;; * file-selinux-context
;; * find-backup-file-name
;; * set-file-acl
@ -2485,10 +2477,9 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Fix `tramp-test15-copy-directory' for `rsync'.
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#16928. Set expected error of `tramp-test34-asynchronous-requests'.
;; * Fix `tramp-test36-unload' (Not all symbols are unbound). Set
;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'.
;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set
;; expected error.
(defun tramp-test-all (&optional interactive)