Line data Source code
1 : ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
6 : ;; Michael Albinus <michael.albinus@gmx.de>
7 : ;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
8 : ;; Keywords: comm, processes
9 : ;; Package: tramp
10 :
11 : ;; This file is part of GNU Emacs.
12 :
13 : ;; GNU Emacs is free software: you can redistribute it and/or modify
14 : ;; it under the terms of the GNU General Public License as published by
15 : ;; the Free Software Foundation, either version 3 of the License, or
16 : ;; (at your option) any later version.
17 :
18 : ;; GNU Emacs is distributed in the hope that it will be useful,
19 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 : ;; GNU General Public License for more details.
22 :
23 : ;; You should have received a copy of the GNU General Public License
24 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 :
26 : ;;; Commentary:
27 :
28 : ;; This package provides remote file editing, similar to ange-ftp.
29 : ;; The difference is that ange-ftp uses FTP to transfer files between
30 : ;; the local and the remote host, whereas tramp.el uses a combination
31 : ;; of rsh and rcp or other work-alike programs, such as ssh/scp.
32 : ;;
33 : ;; For more detailed instructions, please see the info file.
34 : ;;
35 : ;; Notes:
36 : ;; -----
37 : ;;
38 : ;; This package only works for Emacs 24.1 and higher.
39 : ;;
40 : ;; Also see the todo list at the bottom of this file.
41 : ;;
42 : ;; The current version of Tramp can be retrieved from the following URL:
43 : ;; http://ftp.gnu.org/gnu/tramp/
44 : ;;
45 : ;; There's a mailing list for this, as well. Its name is:
46 : ;; tramp-devel@gnu.org
47 : ;; You can use the Web to subscribe, under the following URL:
48 : ;; http://lists.gnu.org/mailman/listinfo/tramp-devel
49 : ;;
50 : ;; For the adventurous, the current development sources are available
51 : ;; via Git. You can find instructions about this at the following URL:
52 : ;; http://savannah.gnu.org/projects/tramp/
53 : ;;
54 : ;; Don't forget to put on your asbestos longjohns, first!
55 :
56 : ;;; Code:
57 :
58 : (require 'tramp-compat)
59 :
60 : ;; Pacify byte-compiler.
61 : (require 'cl-lib)
62 : (defvar auto-save-file-name-transforms)
63 : (defvar eshell-path-env)
64 : (defvar ls-lisp-use-insert-directory-program)
65 : (defvar outline-regexp)
66 :
67 : ;;; User Customizable Internal Variables:
68 :
69 : (defgroup tramp nil
70 : "Edit remote files with a combination of ssh, scp, etc."
71 : :group 'files
72 : :group 'comm
73 : :link '(custom-manual "(tramp)Top")
74 : :version "22.1")
75 :
76 : ;; Maybe we need once a real Tramp mode, with key bindings etc.
77 : ;;;###autoload
78 : (defcustom tramp-mode t
79 : "Whether Tramp is enabled.
80 : If it is set to nil, all remote file names are used literally."
81 : :group 'tramp
82 : :type 'boolean
83 : :require 'tramp)
84 :
85 : (defcustom tramp-verbose 3
86 : "Verbosity level for Tramp messages.
87 : Any level x includes messages for all levels 1 .. x-1. The levels are
88 :
89 : 0 silent (no tramp messages at all)
90 : 1 errors
91 : 2 warnings
92 : 3 connection to remote hosts (default level)
93 : 4 activities
94 : 5 internal
95 : 6 sent and received strings
96 : 7 file caching
97 : 8 connection properties
98 : 9 test commands
99 : 10 traces (huge)."
100 : :group 'tramp
101 : :type 'integer
102 : :require 'tramp)
103 :
104 : (defcustom tramp-backup-directory-alist nil
105 : "Alist of filename patterns and backup directory names.
106 : Each element looks like (REGEXP . DIRECTORY), with the same meaning like
107 : in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
108 : is a local file name, the backup directory is prepended with Tramp file
109 : name prefix \(method, user, host) of file.
110 :
111 : \(setq tramp-backup-directory-alist backup-directory-alist)
112 :
113 : gives the same backup policy for Tramp files on their hosts like the
114 : policy for local files."
115 : :group 'tramp
116 : :type '(repeat (cons (regexp :tag "Regexp matching filename")
117 : (directory :tag "Backup directory name")))
118 : :require 'tramp)
119 :
120 : (defcustom tramp-auto-save-directory nil
121 : "Put auto-save files in this directory, if set.
122 : The idea is to use a local directory so that auto-saving is faster.
123 : This setting has precedence over `auto-save-file-name-transforms'."
124 : :group 'tramp
125 : :type '(choice (const :tag "Use default" nil)
126 : (directory :tag "Auto save directory name"))
127 : :require 'tramp)
128 :
129 : (defcustom tramp-encoding-shell
130 : (or (tramp-compat-funcall 'w32-shell-name) "/bin/sh")
131 : "Use this program for encoding and decoding commands on the local host.
132 : This shell is used to execute the encoding and decoding command on the
133 : local host, so if you want to use `~' in those commands, you should
134 : choose a shell here which groks tilde expansion. `/bin/sh' normally
135 : does not understand tilde expansion.
136 :
137 : For encoding and decoding, commands like the following are executed:
138 :
139 : /bin/sh -c COMMAND < INPUT > OUTPUT
140 :
141 : This variable can be used to change the \"/bin/sh\" part. See the
142 : variable `tramp-encoding-command-switch' for the \"-c\" part.
143 :
144 : If the shell must be forced to be interactive, see
145 : `tramp-encoding-command-interactive'.
146 :
147 : Note that this variable is not used for remote commands. There are
148 : mechanisms in tramp.el which automatically determine the right shell to
149 : use for the remote host."
150 : :group 'tramp
151 : :type '(file :must-match t)
152 : :require 'tramp)
153 :
154 : (defcustom tramp-encoding-command-switch
155 : (if (tramp-compat-funcall 'w32-shell-dos-semantics) "/c" "-c")
156 : "Use this switch together with `tramp-encoding-shell' for local commands.
157 : See the variable `tramp-encoding-shell' for more information."
158 : :group 'tramp
159 : :type 'string
160 : :require 'tramp)
161 :
162 : (defcustom tramp-encoding-command-interactive
163 : (unless (tramp-compat-funcall 'w32-shell-dos-semantics) "-i")
164 : "Use this switch together with `tramp-encoding-shell' for interactive shells.
165 : See the variable `tramp-encoding-shell' for more information."
166 : :version "24.1"
167 : :group 'tramp
168 : :type '(choice (const nil) string)
169 : :require 'tramp)
170 :
171 : ;;;###tramp-autoload
172 : (defvar tramp-methods nil
173 : "Alist of methods for remote files.
174 : This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
175 : Each NAME stands for a remote access method. Each PARAM is a
176 : pair of the form (KEY VALUE). The following KEYs are defined:
177 : * `tramp-remote-shell'
178 : This specifies the shell to use on the remote host. This
179 : MUST be a Bourne-like shell. It is normally not necessary to
180 : set this to any value other than \"/bin/sh\": Tramp wants to
181 : use a shell which groks tilde expansion, but it can search
182 : for it. Also note that \"/bin/sh\" exists on all Unixen,
183 : this might not be true for the value that you decide to use.
184 : You Have Been Warned.
185 : * `tramp-remote-shell-login'
186 : This specifies the arguments to let `tramp-remote-shell' run
187 : as a login shell. It defaults to (\"-l\"), but some shells,
188 : like ksh, require another argument. See
189 : `tramp-connection-properties' for a way to overwrite the
190 : default value.
191 : * `tramp-remote-shell-args'
192 : For implementation of `shell-command', this specifies the
193 : arguments to let `tramp-remote-shell' run a single command.
194 : * `tramp-login-program'
195 : This specifies the name of the program to use for logging in to the
196 : remote host. This may be the name of rsh or a workalike program,
197 : or the name of telnet or a workalike, or the name of su or a workalike.
198 : * `tramp-login-args'
199 : This specifies the list of arguments to pass to the above
200 : mentioned program. Please note that this is a list of list of arguments,
201 : that is, normally you don't want to put \"-a -b\" or \"-f foo\"
202 : here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
203 : There are some patterns: \"%h\" in this list is replaced by the host
204 : name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
205 : port number, and \"%%\" can be used to obtain a literal percent character.
206 : If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
207 : expansion (i.e. no host or no user specified), this list is not used as
208 : argument. By this, arguments like (\"-l\" \"%u\") are optional.
209 : \"%t\" is replaced by the temporary file name produced with
210 : `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
211 : parameter of a program, if exists. \"%c\" adds additional
212 : `tramp-ssh-controlmaster-options' options for the first hop.
213 : * `tramp-login-env'
214 : A list of environment variables and their values, which will
215 : be set when calling `tramp-login-program'.
216 : * `tramp-async-args'
217 : When an asynchronous process is started, we know already that
218 : the connection works. Therefore, we can pass additional
219 : parameters to suppress diagnostic messages, in order not to
220 : tamper the process output.
221 : * `tramp-copy-program'
222 : This specifies the name of the program to use for remotely copying
223 : the file; this might be the absolute filename of scp or the name of
224 : a workalike program. It is always applied on the local host.
225 : * `tramp-copy-args'
226 : This specifies the list of parameters to pass to the above mentioned
227 : program, the hints for `tramp-login-args' also apply here.
228 : * `tramp-copy-env'
229 : A list of environment variables and their values, which will
230 : be set when calling `tramp-copy-program'.
231 : * `tramp-remote-copy-program'
232 : The listener program to be applied on remote side, if needed.
233 : * `tramp-remote-copy-args'
234 : The list of parameters to pass to the listener program, the hints
235 : for `tramp-login-args' also apply here. Additionally, \"%r\" could
236 : be used here and in `tramp-copy-args'. It denotes a randomly
237 : chosen port for the remote listener.
238 : * `tramp-copy-keep-date'
239 : This specifies whether the copying program when the preserves the
240 : timestamp of the original file.
241 : * `tramp-copy-keep-tmpfile'
242 : This specifies whether a temporary local file shall be kept
243 : for optimization reasons (useful for \"rsync\" methods).
244 : * `tramp-copy-recursive'
245 : Whether the operation copies directories recursively.
246 : * `tramp-default-port'
247 : The default port of a method.
248 : * `tramp-tmpdir'
249 : A directory on the remote host for temporary files. If not
250 : specified, \"/tmp\" is taken as default.
251 : * `tramp-connection-timeout'
252 : This is the maximum time to be spent for establishing a connection.
253 : In general, the global default value shall be used, but for
254 : some methods, like \"su\" or \"sudo\", a shorter timeout
255 : might be desirable.
256 : * `tramp-case-insensitive'
257 : Whether the remote file system handles file names case insensitive.
258 : Only a non-nil value counts, the default value nil means to
259 : perform further checks on the remote host. See
260 : `tramp-connection-properties' for a way to overwrite this.
261 :
262 : What does all this mean? Well, you should specify `tramp-login-program'
263 : for all methods; this program is used to log in to the remote site. Then,
264 : there are two ways to actually transfer the files between the local and the
265 : remote side. One way is using an additional scp-like program. If you want
266 : to do this, set `tramp-copy-program' in the method.
267 :
268 : Another possibility for file transfer is inline transfer, i.e. the
269 : file is passed through the same buffer used by `tramp-login-program'. In
270 : this case, the file contents need to be protected since the
271 : `tramp-login-program' might use escape codes or the connection might not
272 : be eight-bit clean. Therefore, file contents are encoded for transit.
273 : See the variables `tramp-local-coding-commands' and
274 : `tramp-remote-coding-commands' for details.
275 :
276 : So, to summarize: if the method is an out-of-band method, then you
277 : must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
278 : inline method, then these two parameters should be nil.
279 :
280 : Notes:
281 :
282 : When using `su' or `sudo' the phrase \"open connection to a remote
283 : host\" sounds strange, but it is used nevertheless, for consistency.
284 : No connection is opened to a remote host, but `su' or `sudo' is
285 : started on the local host. You should specify a remote host
286 : `localhost' or the name of the local host. Another host name is
287 : useful only in combination with `tramp-default-proxies-alist'.")
288 :
289 : (defcustom tramp-default-method
290 : ;; An external copy method seems to be preferred, because it performs
291 : ;; much better for large files, and it hasn't too serious delays
292 : ;; for small files. But it must be ensured that there aren't
293 : ;; permanent password queries. Either a password agent like
294 : ;; "ssh-agent" or "Pageant" shall run, or the optional
295 : ;; password-cache.el or auth-sources.el packages shall be active for
296 : ;; password caching. If we detect that the user is running OpenSSH
297 : ;; 4.0 or newer, we could reuse the connection, which calls also for
298 : ;; an external method.
299 : (cond
300 : ;; PuTTY is installed. We don't take it, if it is installed on a
301 : ;; non-windows system, or pscp from the pssh (parallel ssh) package
302 : ;; is found.
303 : ((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp")
304 : ;; There is an ssh installation.
305 : ((executable-find "scp") "scp")
306 : ;; Fallback.
307 : (t "ftp"))
308 : "Default method to use for transferring files.
309 : See `tramp-methods' for possibilities.
310 : Also see `tramp-default-method-alist'."
311 : :group 'tramp
312 : :type 'string
313 : :require 'tramp)
314 :
315 : ;;;###tramp-autoload
316 : (defcustom tramp-default-method-alist nil
317 : "Default method to use for specific host/user pairs.
318 : This is an alist of items (HOST USER METHOD). The first matching item
319 : specifies the method to use for a file name which does not specify a
320 : method. HOST and USER are regular expressions or nil, which is
321 : interpreted as a regular expression which always matches. If no entry
322 : matches, the variable `tramp-default-method' takes effect.
323 :
324 : If the file name does not specify the user, lookup is done using the
325 : empty string for the user name.
326 :
327 : See `tramp-methods' for a list of possibilities for METHOD."
328 : :group 'tramp
329 : :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
330 : (choice :tag "User regexp" regexp sexp)
331 : (choice :tag "Method name" string (const nil))))
332 : :require 'tramp)
333 :
334 : (defconst tramp-default-method-marker "-"
335 : "Marker for default method in remote file names.")
336 :
337 : (defcustom tramp-default-user nil
338 : "Default user to use for transferring files.
339 : It is nil by default; otherwise settings in configuration files like
340 : \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
341 :
342 : This variable is regarded as obsolete, and will be removed soon."
343 : :group 'tramp
344 : :type '(choice (const nil) string)
345 : :require 'tramp)
346 :
347 : ;;;###tramp-autoload
348 : (defcustom tramp-default-user-alist nil
349 : "Default user to use for specific method/host pairs.
350 : This is an alist of items (METHOD HOST USER). The first matching item
351 : specifies the user to use for a file name which does not specify a
352 : user. METHOD and USER are regular expressions or nil, which is
353 : interpreted as a regular expression which always matches. If no entry
354 : matches, the variable `tramp-default-user' takes effect.
355 :
356 : If the file name does not specify the method, lookup is done using the
357 : empty string for the method name."
358 : :group 'tramp
359 : :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
360 : (choice :tag " Host regexp" regexp sexp)
361 : (choice :tag " User name" string (const nil))))
362 : :require 'tramp)
363 :
364 : (defcustom tramp-default-host (system-name)
365 : "Default host to use for transferring files.
366 : Useful for su and sudo methods mostly."
367 : :group 'tramp
368 : :type 'string
369 : :require 'tramp)
370 :
371 : ;;;###tramp-autoload
372 : (defcustom tramp-default-host-alist nil
373 : "Default host to use for specific method/user pairs.
374 : This is an alist of items (METHOD USER HOST). The first matching item
375 : specifies the host to use for a file name which does not specify a
376 : host. METHOD and HOST are regular expressions or nil, which is
377 : interpreted as a regular expression which always matches. If no entry
378 : matches, the variable `tramp-default-host' takes effect.
379 :
380 : If the file name does not specify the method, lookup is done using the
381 : empty string for the method name."
382 : :group 'tramp
383 : :version "24.4"
384 : :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
385 : (choice :tag " User regexp" regexp sexp)
386 : (choice :tag " Host name" string (const nil))))
387 : :require 'tramp)
388 :
389 : (defcustom tramp-default-proxies-alist nil
390 : "Route to be followed for specific host/user pairs.
391 : This is an alist of items (HOST USER PROXY). The first matching
392 : item specifies the proxy to be passed for a file name located on
393 : a remote target matching USER@HOST. HOST and USER are regular
394 : expressions. PROXY must be a Tramp filename without a localname
395 : part. Method and user name on PROXY are optional, which is
396 : interpreted with the default values. PROXY can contain the
397 : patterns %h and %u, which are replaced by the strings matching
398 : HOST or USER, respectively.
399 :
400 : HOST, USER or PROXY could also be Lisp forms, which will be
401 : evaluated. The result must be a string or nil, which is
402 : interpreted as a regular expression which always matches."
403 : :group 'tramp
404 : :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
405 : (choice :tag "User regexp" regexp sexp)
406 : (choice :tag " Proxy name" string (const nil))))
407 : :require 'tramp)
408 :
409 : (defcustom tramp-save-ad-hoc-proxies nil
410 : "Whether to save ad-hoc proxies persistently."
411 : :group 'tramp
412 : :version "24.3"
413 : :type 'boolean
414 : :require 'tramp)
415 :
416 : (defcustom tramp-restricted-shell-hosts-alist
417 : (when (memq system-type '(windows-nt))
418 : (list (concat "\\`" (regexp-quote (system-name)) "\\'")))
419 : "List of hosts, which run a restricted shell.
420 : This is a list of regular expressions, which denote hosts running
421 : a registered shell like \"rbash\". Those hosts can be used as
422 : proxies only, see `tramp-default-proxies-alist'. If the local
423 : host runs a registered shell, it shall be added to this list, too."
424 : :version "24.3"
425 : :group 'tramp
426 : :type '(repeat (regexp :tag "Host regexp"))
427 : :require 'tramp)
428 :
429 : ;;;###tramp-autoload
430 : (defconst tramp-local-host-regexp
431 : (concat
432 : "\\`"
433 : (regexp-opt
434 : (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t)
435 : "\\'")
436 : "Host names which are regarded as local host.")
437 :
438 : (defvar tramp-completion-function-alist nil
439 : "Alist of methods for remote files.
440 : This is a list of entries of the form \(NAME PAIR1 PAIR2 ...).
441 : Each NAME stands for a remote access method. Each PAIR is of the form
442 : \(FUNCTION FILE). FUNCTION is responsible to extract user names and host
443 : names from FILE for completion. The following predefined FUNCTIONs exists:
444 :
445 : * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
446 : * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
447 : * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
448 : * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
449 : * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
450 : * `tramp-parse-hosts' for \"/etc/hosts\" like files,
451 : * `tramp-parse-passwd' for \"/etc/passwd\" like files.
452 : * `tramp-parse-etc-group' for \"/etc/group\" like files.
453 : * `tramp-parse-netrc' for \"~/.netrc\" like files.
454 : * `tramp-parse-putty' for PuTTY registered sessions.
455 :
456 : FUNCTION can also be a user defined function. For more details see
457 : the info pages.")
458 :
459 : (defconst tramp-echo-mark-marker "_echo"
460 : "String marker to surround echoed commands.")
461 :
462 : (defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
463 : "String length of `tramp-echo-mark-marker'.")
464 :
465 : (defconst tramp-echo-mark
466 : (concat tramp-echo-mark-marker
467 : (make-string tramp-echo-mark-marker-length ?\b))
468 : "String mark to be transmitted around shell commands.
469 : Used to separate their echo from the output they produce. This
470 : will only be used if we cannot disable remote echo via stty.
471 : This string must have no effect on the remote shell except for
472 : producing some echo which can later be detected by
473 : `tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
474 : followed by an equal number of backspaces to erase them will
475 : usually suffice.")
476 :
477 : (defconst tramp-echoed-echo-mark-regexp
478 : (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
479 : tramp-echo-mark-marker tramp-echo-mark-marker-length)
480 : "Regexp which matches `tramp-echo-mark' as it gets echoed by
481 : the remote shell.")
482 :
483 : (defcustom tramp-local-end-of-line
484 : (if (memq system-type '(windows-nt)) "\r\n" "\n")
485 : "String used for end of line in local processes."
486 : :version "24.1"
487 : :group 'tramp
488 : :type 'string
489 : :require 'tramp)
490 :
491 : (defcustom tramp-rsh-end-of-line "\n"
492 : "String used for end of line in rsh connections.
493 : I don't think this ever needs to be changed, so please tell me about it
494 : if you need to change this."
495 : :group 'tramp
496 : :type 'string
497 : :require 'tramp)
498 :
499 : (defcustom tramp-login-prompt-regexp
500 : ".*\\(user\\|login\\)\\( .*\\)?: *"
501 : "Regexp matching login-like prompts.
502 : The regexp should match at end of buffer.
503 :
504 : Sometimes the prompt is reported to look like \"login as:\"."
505 : :group 'tramp
506 : :type 'regexp
507 : :require 'tramp)
508 :
509 : (defcustom tramp-shell-prompt-pattern
510 : ;; Allow a prompt to start right after a ^M since it indeed would be
511 : ;; displayed at the beginning of the line (and Zsh uses it). This
512 : ;; regexp works only for GNU Emacs.
513 : ;; Allow also [] style prompts. They can appear only during
514 : ;; connection initialization; Tramp redefines the prompt afterwards.
515 : (concat "\\(?:^\\|\r\\)"
516 : "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
517 : "Regexp to match prompts from remote shell.
518 : Normally, Tramp expects you to configure `shell-prompt-pattern'
519 : correctly, but sometimes it happens that you are connecting to a
520 : remote host which sends a different kind of shell prompt. Therefore,
521 : Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
522 : and also things matched by this variable. The default value of this
523 : variable is similar to the default value of `shell-prompt-pattern',
524 : which should work well in many cases.
525 :
526 : This regexp must match both `tramp-initial-end-of-output' and
527 : `tramp-end-of-output'."
528 : :group 'tramp
529 : :type 'regexp
530 : :require 'tramp)
531 :
532 : (defcustom tramp-password-prompt-regexp
533 : (format "^.*\\(%s\\).*:\^@? *"
534 : ;; `password-word-equivalents' has been introduced with Emacs 24.4.
535 : (regexp-opt (or (bound-and-true-p password-word-equivalents)
536 : '("password" "passphrase"))))
537 : "Regexp matching password-like prompts.
538 : The regexp should match at end of buffer.
539 :
540 : The `sudo' program appears to insert a `^@' character into the prompt."
541 : :version "24.4"
542 : :group 'tramp
543 : :type 'regexp
544 : :require 'tramp)
545 :
546 : (defcustom tramp-wrong-passwd-regexp
547 : (concat "^.*"
548 : ;; These strings should be on the last line
549 : (regexp-opt '("Permission denied"
550 : "Login incorrect"
551 : "Login Incorrect"
552 : "Connection refused"
553 : "Connection closed"
554 : "Timeout, server not responding."
555 : "Sorry, try again."
556 : "Name or service not known"
557 : "Host key verification failed."
558 : "No supported authentication methods left to try!")
559 : t)
560 : ".*"
561 : "\\|"
562 : "^.*\\("
563 : ;; Here comes a list of regexes, separated by \\|
564 : "Received signal [0-9]+"
565 : "\\).*")
566 : "Regexp matching a `login failed' message.
567 : The regexp should match at end of buffer."
568 : :group 'tramp
569 : :type 'regexp
570 : :require 'tramp)
571 :
572 : (defcustom tramp-yesno-prompt-regexp
573 : (concat
574 : (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
575 : "\\s-*")
576 : "Regular expression matching all yes/no queries which need to be confirmed.
577 : The confirmation should be done with yes or no.
578 : The regexp should match at end of buffer.
579 : See also `tramp-yn-prompt-regexp'."
580 : :group 'tramp
581 : :type 'regexp
582 : :require 'tramp)
583 :
584 : (defcustom tramp-yn-prompt-regexp
585 : (concat
586 : (regexp-opt '("Store key in cache? (y/n)"
587 : "Update cached key? (y/n, Return cancels connection)")
588 : t)
589 : "\\s-*")
590 : "Regular expression matching all y/n queries which need to be confirmed.
591 : The confirmation should be done with y or n.
592 : The regexp should match at end of buffer.
593 : See also `tramp-yesno-prompt-regexp'."
594 : :group 'tramp
595 : :type 'regexp
596 : :require 'tramp)
597 :
598 : (defcustom tramp-terminal-prompt-regexp
599 : (concat "\\("
600 : "TERM = (.*)"
601 : "\\|"
602 : "Terminal type\\? \\[.*\\]"
603 : "\\)\\s-*")
604 : "Regular expression matching all terminal setting prompts.
605 : The regexp should match at end of buffer.
606 : The answer will be provided by `tramp-action-terminal', which see."
607 : :group 'tramp
608 : :type 'regexp
609 : :require 'tramp)
610 :
611 : (defcustom tramp-operation-not-permitted-regexp
612 : (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
613 : (regexp-opt '("Operation not permitted") t))
614 : "Regular expression matching keep-date problems in (s)cp operations.
615 : Copying has been performed successfully already, so this message can
616 : be ignored safely."
617 : :group 'tramp
618 : :type 'regexp
619 : :require 'tramp)
620 :
621 : (defcustom tramp-copy-failed-regexp
622 : (concat "\\(.+: "
623 : (regexp-opt '("Permission denied"
624 : "not a regular file"
625 : "is a directory"
626 : "No such file or directory")
627 : t)
628 : "\\)\\s-*")
629 : "Regular expression matching copy problems in (s)cp operations."
630 : :group 'tramp
631 : :type 'regexp
632 : :require 'tramp)
633 :
634 : (defcustom tramp-process-alive-regexp
635 : ""
636 : "Regular expression indicating a process has finished.
637 : In fact this expression is empty by intention, it will be used only to
638 : check regularly the status of the associated process.
639 : The answer will be provided by `tramp-action-process-alive',
640 : `tramp-action-out-of-band', which see."
641 : :group 'tramp
642 : :type 'regexp
643 : :require 'tramp)
644 :
645 : (defconst tramp-temp-name-prefix "tramp."
646 : "Prefix to use for temporary files.
647 : If this is a relative file name (such as \"tramp.\"), it is considered
648 : relative to the directory name returned by the function
649 : `tramp-compat-temporary-file-directory' (which see). It may also be an
650 : absolute file name; don't forget to include a prefix for the filename
651 : part, though.")
652 :
653 : (defconst tramp-temp-buffer-name " *tramp temp*"
654 : "Buffer name for a temporary buffer.
655 : It shall be used in combination with `generate-new-buffer-name'.")
656 :
657 : (defvar tramp-temp-buffer-file-name nil
658 : "File name of a persistent local temporary file.
659 : Useful for \"rsync\" like methods.")
660 : (make-variable-buffer-local 'tramp-temp-buffer-file-name)
661 : (put 'tramp-temp-buffer-file-name 'permanent-local t)
662 :
663 : ;;;###autoload
664 : (defcustom tramp-syntax 'default
665 : "Tramp filename syntax to be used.
666 :
667 : It can have the following values:
668 :
669 : `default' -- Default syntax
670 : `simplified' -- Ange-FTP like syntax
671 : `separate' -- Syntax as defined for XEmacs originally
672 :
673 : Do not change the value by `setq', it must be changed only by
674 : `custom-set-variables'. See also `tramp-change-syntax'."
675 : :group 'tramp
676 : :version "26.1"
677 : :package-version '(Tramp . "2.3.2")
678 : :type '(choice (const :tag "Default" default)
679 : (const :tag "Ange-FTP" simplified)
680 : (const :tag "XEmacs" separate))
681 : :require 'tramp
682 : :initialize 'custom-initialize-set
683 : :set (lambda (symbol value)
684 : ;; Check allowed values.
685 : (unless (memq value (tramp-syntax-values))
686 : (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax))
687 : ;; Cleanup existing buffers.
688 : (unless (eq (symbol-value symbol) value)
689 : (tramp-cleanup-all-buffers))
690 : ;; Set the value:
691 : (set-default symbol value)
692 : ;; Reset `tramp-file-name-regexp'.
693 : (setq tramp-file-name-regexp (tramp-file-name-regexp))
694 : ;; Rearrange file name handlers.
695 : (tramp-register-file-name-handlers)))
696 :
697 : (defun tramp-syntax-values ()
698 : "Return possible values of `tramp-syntax', a list"
699 17 : (let ((values (cdr (get 'tramp-syntax 'custom-type))))
700 17 : (setq values (mapcar 'last values)
701 17 : values (mapcar 'car values))))
702 :
703 : (defmacro tramp-lookup-syntax (alist)
704 : "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax.'
705 : Raise an error if `tramp-syntax' is invalid."
706 13 : `(let ((result (cdr (assq (tramp-compat-tramp-syntax) ,alist))))
707 : (or result
708 13 : (error "Wrong `tramp-syntax' %s" tramp-syntax))))
709 :
710 : (defconst tramp-prefix-format-alist
711 : '((default . "/")
712 : (simplified . "/")
713 : (separate . "/["))
714 : "Alist mapping Tramp syntax to strings beginning Tramp file names.")
715 :
716 : (defun tramp-prefix-format ()
717 : "String matching the very beginning of Tramp file names.
718 : Used in `tramp-make-tramp-file-name'."
719 36412 : (tramp-lookup-syntax tramp-prefix-format-alist))
720 :
721 : (defconst tramp-prefix-regexp-alist
722 : `((default . ,(concat "^" (regexp-quote "/")))
723 : (simplified . ,(concat "^" (regexp-quote "/")))
724 : (separate . ,(concat "^" (regexp-quote "/["))))
725 : "Alist of regexps matching the beginnings of Tramp file names.
726 : Keyed by Tramp syntax. Derived from `tramp-prefix-format-alist'.")
727 :
728 : (defun tramp-prefix-regexp ()
729 : "Regexp matching the very beginning of Tramp file names.
730 : Should always start with \"^\". Derived from `tramp-prefix-format'."
731 63 : (tramp-lookup-syntax tramp-prefix-regexp-alist))
732 :
733 : (defconst tramp-prefix-method-regexp-alist
734 : '((default . "[a-zA-Z0-9-]+")
735 : (simplified . "")
736 : (separate . "[a-zA-Z0-9-]*"))
737 : "Alist mapping Tramp syntax to regexps matching methods identifiers.")
738 :
739 : (defun tramp-method-regexp ()
740 : "Regexp matching methods identifiers.
741 : The `ftp' syntax does not support methods."
742 54 : (tramp-lookup-syntax tramp-prefix-method-regexp-alist))
743 :
744 : (defconst tramp-postfix-method-format-alist
745 : '((default . ":")
746 : (simplified . "")
747 : (separate . "/"))
748 : "Alist mapping Tramp syntax to the delimiter after the method.")
749 :
750 : (defun tramp-postfix-method-format ()
751 : "String matching delimiter between method and user or host names.
752 : The `ftp' syntax does not support methods.
753 : Used in `tramp-make-tramp-file-name'."
754 72792 : (tramp-lookup-syntax tramp-postfix-method-format-alist))
755 :
756 : (defconst tramp-postfix-method-regexp-alist
757 : `((default . ,(regexp-quote ":"))
758 : (simplified . ,(regexp-quote ""))
759 : (separate . ,(regexp-quote "/")))
760 : "Alist mapping Tramp syntax to regexp matching delimiter after method.
761 : Derived from `tramp-postfix-method-format-alist'.")
762 :
763 : (defun tramp-postfix-method-regexp ()
764 : "Regexp matching delimiter between method and user or host names.
765 : Derived from `tramp-postfix-method-format'."
766 38 : (tramp-lookup-syntax tramp-postfix-method-regexp-alist))
767 :
768 : (defconst tramp-user-regexp "[^/|: \t]+"
769 : "Regexp matching user names.")
770 :
771 : ;;;###tramp-autoload
772 : (defconst tramp-prefix-domain-format "%"
773 : "String matching delimiter between user and domain names.")
774 :
775 : ;;;###tramp-autoload
776 : (defconst tramp-prefix-domain-regexp
777 : (regexp-quote tramp-prefix-domain-format)
778 : "Regexp matching delimiter between user and domain names.
779 : Derived from `tramp-prefix-domain-format'.")
780 :
781 : (defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
782 : "Regexp matching domain names.")
783 :
784 : (defconst tramp-user-with-domain-regexp
785 : (concat "\\(" tramp-user-regexp "\\)"
786 : tramp-prefix-domain-regexp
787 : "\\(" tramp-domain-regexp "\\)")
788 : "Regexp matching user names with domain names.")
789 :
790 : (defconst tramp-postfix-user-format "@"
791 : "String matching delimiter between user and host names.
792 : Used in `tramp-make-tramp-file-name'.")
793 :
794 : (defconst tramp-postfix-user-regexp
795 : (regexp-quote tramp-postfix-user-format)
796 : "Regexp matching delimiter between user and host names.
797 : Derived from `tramp-postfix-user-format'.")
798 :
799 : (defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
800 : "Regexp matching host names.")
801 :
802 : (defconst tramp-prefix-ipv6-format-alist
803 : '((default . "[")
804 : (simplified . "[")
805 : (separate . ""))
806 : "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.")
807 :
808 : (defun tramp-prefix-ipv6-format ()
809 : "String matching left hand side of IPv6 addresses.
810 : Used in `tramp-make-tramp-file-name'."
811 16 : (tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
812 :
813 : (defconst tramp-prefix-ipv6-regexp-alist
814 : `((default . ,(regexp-quote "["))
815 : (simplified . ,(regexp-quote "["))
816 : (separate . ,(regexp-quote "")))
817 : "Alist mapping Tramp syntax to regexp matching prefix of IPv6 addresses.
818 : Derived from `tramp-prefix-ipv6-format-alist'")
819 :
820 : (defun tramp-prefix-ipv6-regexp ()
821 : "Regexp matching left hand side of IPv6 addresses.
822 : Derived from `tramp-prefix-ipv6-format'."
823 282273 : (tramp-lookup-syntax tramp-prefix-ipv6-regexp-alist))
824 :
825 : ;; The following regexp is a bit sloppy. But it shall serve our
826 : ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
827 : ;; "::ffff:192.168.0.1".
828 : (defconst tramp-ipv6-regexp
829 : "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
830 : "Regexp matching IPv6 addresses.")
831 :
832 : (defconst tramp-postfix-ipv6-format-alist
833 : '((default . "]")
834 : (simplified . "]")
835 : (separate . ""))
836 : "Alist mapping Tramp syntax to suffix for IPv6 addresses.")
837 :
838 : (defun tramp-postfix-ipv6-format ()
839 : "String matching right hand side of IPv6 addresses.
840 : Used in `tramp-make-tramp-file-name'."
841 27 : (tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
842 :
843 : (defconst tramp-postfix-ipv6-regexp-alist
844 : `((default . ,(regexp-quote "]"))
845 : (simplified . ,(regexp-quote "]"))
846 : (separate . ,(regexp-quote "")))
847 : "Alist mapping Tramp syntax to regexps matching IPv6 suffixes.
848 : Derived from `tramp-postfix-ipv6-format-alist'.")
849 :
850 : (defun tramp-postfix-ipv6-regexp ()
851 : "Regexp matching right hand side of IPv6 addresses.
852 : Derived from `tramp-postfix-ipv6-format'."
853 282259 : (tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
854 :
855 : (defconst tramp-prefix-port-format "#"
856 : "String matching delimiter between host names and port numbers.")
857 :
858 : (defconst tramp-prefix-port-regexp
859 : (regexp-quote tramp-prefix-port-format)
860 : "Regexp matching delimiter between host names and port numbers.
861 : Derived from `tramp-prefix-port-format'.")
862 :
863 : (defconst tramp-port-regexp "[0-9]+"
864 : "Regexp matching port numbers.")
865 :
866 : (defconst tramp-host-with-port-regexp
867 : (concat "\\(" tramp-host-regexp "\\)"
868 : tramp-prefix-port-regexp
869 : "\\(" tramp-port-regexp "\\)")
870 : "Regexp matching host names with port numbers.")
871 :
872 : (defconst tramp-postfix-hop-format "|"
873 : "String matching delimiter after ad-hoc hop definitions.")
874 :
875 : (defconst tramp-postfix-hop-regexp
876 : (regexp-quote tramp-postfix-hop-format)
877 : "Regexp matching delimiter after ad-hoc hop definitions.
878 : Derived from `tramp-postfix-hop-format'.")
879 :
880 : (defconst tramp-postfix-host-format-alist
881 : '((default . ":")
882 : (simplified . ":")
883 : (separate . "]"))
884 : "Alist mapping Tramp syntax to strings between host and local names.")
885 :
886 : (defun tramp-postfix-host-format ()
887 : "String matching delimiter between host names and localnames.
888 : Used in `tramp-make-tramp-file-name'."
889 36404 : (tramp-lookup-syntax tramp-postfix-host-format-alist))
890 :
891 : (defconst tramp-postfix-host-regexp-alist
892 : `((default . ,(regexp-quote ":"))
893 : (simplified . ,(regexp-quote ":"))
894 : (separate . ,(regexp-quote "]")))
895 : "Alist mapping Tramp syntax to regexp matching name delimiters.
896 : Derived from `tramp-postfix-host-format-alist'.")
897 :
898 : (defun tramp-postfix-host-regexp ()
899 : "Regexp matching delimiter between host names and localnames.
900 : Derived from `tramp-postfix-host-format'."
901 3 : (tramp-lookup-syntax tramp-postfix-host-regexp-alist))
902 :
903 : (defconst tramp-localname-regexp ".*$"
904 : "Regexp matching localnames.")
905 :
906 : (defconst tramp-unknown-id-string "UNKNOWN"
907 : "String used to denote an unknown user or group")
908 :
909 : (defconst tramp-unknown-id-integer -1
910 : "Integer used to denote an unknown user or group")
911 :
912 : ;;; File name format:
913 :
914 : (defun tramp-build-remote-file-name-spec-regexp (syntax)
915 : "Construct a regexp matching a Tramp file name for a Tramp SYNTAX."
916 3 : (let ((tramp-syntax syntax))
917 3 : (concat
918 3 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
919 3 : "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
920 3 : "\\(" "\\(?:" tramp-host-regexp "\\|"
921 3 : (tramp-prefix-ipv6-regexp)
922 3 : "\\(?:" tramp-ipv6-regexp "\\)?"
923 3 : (tramp-postfix-ipv6-regexp) "\\)?"
924 3 : "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")))
925 :
926 : (defconst tramp-remote-file-name-spec-regexp-alist
927 : `((default . ,(tramp-build-remote-file-name-spec-regexp 'default))
928 : (simplified . ,(tramp-build-remote-file-name-spec-regexp 'simplified))
929 : (separate . ,(tramp-build-remote-file-name-spec-regexp 'separate)))
930 : "Alist mapping Tramp syntax to regexps matching Tramp file names.")
931 :
932 : (defun tramp-remote-file-name-spec-regexp ()
933 : "Regular expression matching a Tramp file name between prefix and postfix."
934 13 : (tramp-lookup-syntax tramp-remote-file-name-spec-regexp-alist))
935 :
936 : (defun tramp-build-file-name-structure (syntax)
937 : "Construct the Tramp file name structure for SYNTAX.
938 : See `tramp-file-name-structure'."
939 3 : (let ((tramp-syntax syntax))
940 3 : (list
941 3 : (concat
942 3 : (tramp-prefix-regexp)
943 3 : "\\(" "\\(?:" (tramp-remote-file-name-spec-regexp)
944 3 : tramp-postfix-hop-regexp "\\)+" "\\)?"
945 3 : (tramp-remote-file-name-spec-regexp) (tramp-postfix-host-regexp)
946 3 : "\\(" tramp-localname-regexp "\\)")
947 3 : 5 6 7 8 1)))
948 :
949 : (defconst tramp-file-name-structure-alist
950 : `((default . ,(tramp-build-file-name-structure 'default))
951 : (simplified . ,(tramp-build-file-name-structure 'simplified))
952 : (separate . ,(tramp-build-file-name-structure 'separate)))
953 : "Alist mapping Tramp syntax to the file name structure for that syntax.")
954 :
955 : (defun tramp-file-name-structure ()
956 : "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
957 : the Tramp file name structure.
958 :
959 : The first element REGEXP is a regular expression matching a Tramp file
960 : name. The regex should contain parentheses around the method name,
961 : the user name, the host name, and the file name parts.
962 :
963 : The second element METHOD is a number, saying which pair of
964 : parentheses matches the method name. The third element USER is
965 : similar, but for the user name. The fourth element HOST is similar,
966 : but for the host name. The fifth element FILE is for the file name.
967 : The last element HOP is the ad-hoc hop definition, which could be a
968 : cascade of several hops.
969 :
970 : These numbers are passed directly to `match-string', which see. That
971 : means the opening parentheses are counted to identify the pair.
972 :
973 : See also `tramp-file-name-regexp'."
974 2172225 : (tramp-lookup-syntax tramp-file-name-structure-alist))
975 :
976 : (defun tramp-file-name-regexp ()
977 : "Regular expression matching file names handled by Tramp.
978 : This regexp should match Tramp file names but no other file names."
979 478677 : (car (tramp-file-name-structure)))
980 :
981 : ;;;###autoload
982 : (defconst tramp-initial-file-name-regexp "\\`/.+:.*:"
983 : "Value for `tramp-file-name-regexp' for autoload.
984 : It must match the initial `tramp-syntax' settings.")
985 :
986 : ;; External packages use constant `tramp-file-name-regexp'. In order
987 : ;; not to break them, we still provide it. It is a variable now.
988 : ;;;###autoload
989 : (defvar tramp-file-name-regexp tramp-initial-file-name-regexp
990 : "Value for `tramp-file-name-regexp' for autoload.
991 : It must match the initial `tramp-syntax' settings.")
992 :
993 : ;;;###autoload
994 : (defconst tramp-completion-file-name-regexp-default
995 : (concat
996 : "\\`/\\("
997 : ;; Optional multi hop.
998 : "\\([^/|:]+:[^/|:]*|\\)*"
999 : ;; Last hop.
1000 : (if (memq system-type '(cygwin windows-nt))
1001 : ;; The method is either "-", or at least two characters.
1002 : "\\(-\\|[^/|:]\\{2,\\}\\)"
1003 : ;; At least one character for method.
1004 : "[^/|:]+")
1005 : ;; Method separator, user name and host name.
1006 : "\\(:[^/|:]*\\)?"
1007 : "\\)?\\'")
1008 : "Value for `tramp-completion-file-name-regexp' for default remoting.
1009 : See `tramp-file-name-structure' for more explanations.
1010 :
1011 : On W32 systems, the volume letter must be ignored.")
1012 :
1013 : (defconst tramp-completion-file-name-regexp-simplified
1014 : (concat
1015 : "\\`/\\("
1016 : ;; Optional multi hop.
1017 : "\\([^/|:]*|\\)*"
1018 : ;; Last hop.
1019 : (if (memq system-type '(cygwin windows-nt))
1020 : ;; At least two characters.
1021 : "[^/|:]\\{2,\\}"
1022 : ;; At least one character.
1023 : "[^/|:]+")
1024 : "\\)?\\'")
1025 : "Value for `tramp-completion-file-name-regexp' for simplified style remoting.
1026 : See `tramp-file-name-structure' for more explanations.
1027 :
1028 : On W32 systems, the volume letter must be ignored.")
1029 :
1030 : (defconst tramp-completion-file-name-regexp-separate
1031 : "\\`/\\(\\[[^]]*\\)?\\'"
1032 : "Value for `tramp-completion-file-name-regexp' for separate remoting.
1033 : See `tramp-file-name-structure' for more explanations.")
1034 :
1035 : (defun tramp-completion-file-name-regexp ()
1036 : "Regular expression matching file names handled by Tramp completion.
1037 : This regexp should match partial Tramp file names only.
1038 :
1039 : Please note that the entry in `file-name-handler-alist' is made when
1040 : this file \(tramp.el) is loaded. This means that this variable must be set
1041 : before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1042 : updated after changing this variable.
1043 :
1044 : Also see `tramp-file-name-structure'."
1045 13 : (cond ((eq (tramp-compat-tramp-syntax) 'default)
1046 7 : tramp-completion-file-name-regexp-default)
1047 6 : ((eq (tramp-compat-tramp-syntax) 'simplified)
1048 3 : tramp-completion-file-name-regexp-simplified)
1049 3 : ((eq (tramp-compat-tramp-syntax) 'separate)
1050 3 : tramp-completion-file-name-regexp-separate)
1051 13 : (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
1052 :
1053 : ;;;###autoload
1054 : (defconst tramp-initial-completion-file-name-regexp
1055 : tramp-completion-file-name-regexp-default
1056 : "Value for `tramp-completion-file-name-regexp' for autoload.
1057 : It must match the initial `tramp-syntax' settings.")
1058 :
1059 : ;; Chunked sending kludge. We set this to 500 for black-listed constellations
1060 : ;; known to have a bug in `process-send-string'; some ssh connections appear
1061 : ;; to drop bytes when data is sent too quickly. There is also a connection
1062 : ;; buffer local variable, which is computed depending on remote host properties
1063 : ;; when `tramp-chunksize' is zero or nil.
1064 : (defcustom tramp-chunksize (when (memq system-type '(hpux)) 500)
1065 : ;; Parentheses in docstring starting at beginning of line are escaped.
1066 : ;; Fontification is messed up when
1067 : ;; `open-paren-in-column-0-is-defun-start' set to t.
1068 : "If non-nil, chunksize for sending input to local process.
1069 : It is necessary only on systems which have a buggy `process-send-string'
1070 : implementation. The necessity, whether this variable must be set, can be
1071 : checked via the following code:
1072 :
1073 : (with-temp-buffer
1074 : (let* ((user \"xxx\") (host \"yyy\")
1075 : (init 0) (step 50)
1076 : (sent init) (received init))
1077 : (while (= sent received)
1078 : (setq sent (+ sent step))
1079 : (erase-buffer)
1080 : (let ((proc (start-process (buffer-name) (current-buffer)
1081 : \"ssh\" \"-l\" user host \"wc\" \"-c\")))
1082 : (when (process-live-p proc)
1083 : (process-send-string proc (make-string sent ?\\ ))
1084 : (process-send-eof proc)
1085 : (process-send-eof proc))
1086 : (while (not (progn (goto-char (point-min))
1087 : (re-search-forward \"\\\\w+\" (point-max) t)))
1088 : (accept-process-output proc 1))
1089 : (when (process-live-p proc)
1090 : (setq received (string-to-number (match-string 0)))
1091 : (delete-process proc)
1092 : (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
1093 : (sit-for 0))))
1094 : (if (> sent (+ init step))
1095 : (message \"You should set `tramp-chunksize' to a maximum of %s\"
1096 : (- sent step))
1097 : (message \"Test does not work\")
1098 : (display-buffer (current-buffer))
1099 : (sit-for 30))))
1100 :
1101 : In the Emacs normally running Tramp, evaluate the above code
1102 : \(replace \"xxx\" and \"yyy\" by the remote user and host name,
1103 : respectively). You can do this, for example, by pasting it into
1104 : the `*scratch*' buffer and then hitting C-j with the cursor after the
1105 : last closing parenthesis. Note that it works only if you have configured
1106 : \"ssh\" to run without password query, see ssh-agent(1).
1107 :
1108 : You will see the number of bytes sent successfully to the remote host.
1109 : If that number exceeds 1000, you can stop the execution by hitting
1110 : C-g, because your Emacs is likely clean.
1111 :
1112 : When it is necessary to set `tramp-chunksize', you might consider to
1113 : use an out-of-the-band method \(like \"scp\") instead of an internal one
1114 : \(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
1115 : performance.
1116 :
1117 : If your Emacs is buggy, the code stops and gives you an indication
1118 : about the value `tramp-chunksize' should be set. Maybe you could just
1119 : experiment a bit, e.g. changing the values of `init' and `step'
1120 : in the third line of the code.
1121 :
1122 : Please raise a bug report via \"M-x tramp-bug\" if your system needs
1123 : this variable to be set as well."
1124 : :group 'tramp
1125 : :type '(choice (const nil) integer)
1126 : :require 'tramp)
1127 :
1128 : ;; Logging in to a remote host normally requires obtaining a pty. But
1129 : ;; Emacs on macOS has process-connection-type set to nil by default,
1130 : ;; so on those systems Tramp doesn't obtain a pty. Here, we allow
1131 : ;; for an override of the system default.
1132 : (defcustom tramp-process-connection-type t
1133 : "Overrides `process-connection-type' for connections from Tramp.
1134 : Tramp binds `process-connection-type' to the value given here before
1135 : opening a connection to a remote host."
1136 : :group 'tramp
1137 : :type '(choice (const nil) (const t) (const pty))
1138 : :require 'tramp)
1139 :
1140 : (defcustom tramp-connection-timeout 60
1141 : "Defines the max time to wait for establishing a connection (in seconds).
1142 : This can be overwritten for different connection types in `tramp-methods'.
1143 :
1144 : The timeout does not include the time reading a password."
1145 : :group 'tramp
1146 : :version "24.4"
1147 : :type 'integer
1148 : :require 'tramp)
1149 :
1150 : (defcustom tramp-connection-min-time-diff 5
1151 : "Defines seconds between two consecutive connection attempts.
1152 : This is necessary as self defense mechanism, in order to avoid
1153 : yo-yo connection attempts when the remote host is unavailable.
1154 :
1155 : A value of 0 or nil suppresses this check. This might be
1156 : necessary, when several out-of-order copy operations are
1157 : performed, or when several asynchronous processes will be started
1158 : in a short time frame. In those cases it is recommended to
1159 : let-bind this variable."
1160 : :group 'tramp
1161 : :version "24.4"
1162 : :type '(choice (const nil) integer)
1163 : :require 'tramp)
1164 :
1165 : (defcustom tramp-completion-reread-directory-timeout 10
1166 : "Defines seconds since last remote command before rereading a directory.
1167 : A remote directory might have changed its contents. In order to
1168 : make it visible during file name completion in the minibuffer,
1169 : Tramp flushes its cache and rereads the directory contents when
1170 : more than `tramp-completion-reread-directory-timeout' seconds
1171 : have been gone since last remote command execution. A value of t
1172 : would require an immediate reread during filename completion, nil
1173 : means to use always cached values for the directory contents."
1174 : :group 'tramp
1175 : :type '(choice (const nil) (const t) integer)
1176 : :require 'tramp)
1177 :
1178 : ;;; Internal Variables:
1179 :
1180 : (defvar tramp-current-method nil
1181 : "Connection method for this *tramp* buffer.")
1182 :
1183 : (defvar tramp-current-user nil
1184 : "Remote login name for this *tramp* buffer.")
1185 :
1186 : (defvar tramp-current-domain nil
1187 : "Remote domain name for this *tramp* buffer.")
1188 :
1189 : (defvar tramp-current-host nil
1190 : "Remote host for this *tramp* buffer.")
1191 :
1192 : (defvar tramp-current-port nil
1193 : "Remote port for this *tramp* buffer.")
1194 :
1195 : (defvar tramp-current-connection nil
1196 : "Last connection timestamp.")
1197 :
1198 : ;;;###autoload
1199 : (defconst tramp-completion-file-name-handler-alist
1200 : '((file-name-all-completions
1201 : . tramp-completion-handle-file-name-all-completions)
1202 : (file-name-completion . tramp-completion-handle-file-name-completion))
1203 : "Alist of completion handler functions.
1204 : Used for file names matching `tramp-completion-file-name-regexp'.
1205 : Operations not mentioned here will be handled by Tramp's file
1206 : name handler functions, or the normal Emacs functions.")
1207 :
1208 : ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
1209 : ;;;###tramp-autoload
1210 : (defvar tramp-foreign-file-name-handler-alist nil
1211 : "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
1212 : If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
1213 : calling HANDLER.")
1214 :
1215 : ;;; Internal functions which must come first:
1216 :
1217 : ;; Conversion functions between external representation and
1218 : ;; internal data structure. Convenience functions for internal
1219 : ;; data structure.
1220 :
1221 : ;; The basic structure for remote file names. We use a list :type,
1222 : ;; in order to be compatible with Emacs 24 and 25.
1223 : (cl-defstruct (tramp-file-name (:type list) :named)
1224 : method user domain host port localname hop)
1225 :
1226 : (defun tramp-file-name-user-domain (vec)
1227 : "Return user and domain components of VEC."
1228 71697 : (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
1229 550 : (concat (tramp-file-name-user vec)
1230 550 : (and (tramp-file-name-domain vec)
1231 550 : tramp-prefix-domain-format)
1232 71697 : (tramp-file-name-domain vec))))
1233 :
1234 : (defun tramp-file-name-host-port (vec)
1235 : "Return host and port components of VEC."
1236 71691 : (when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
1237 71691 : (concat (tramp-file-name-host vec)
1238 71691 : (and (tramp-file-name-port vec)
1239 71691 : tramp-prefix-port-format)
1240 71691 : (tramp-file-name-port vec))))
1241 :
1242 : (defun tramp-file-name-port-or-default (vec)
1243 : "Return port component of VEC.
1244 : If nil, return `tramp-default-port'."
1245 0 : (or (tramp-file-name-port vec)
1246 0 : (tramp-get-method-parameter vec 'tramp-default-port)))
1247 :
1248 : (defun tramp-file-name-equal-p (vec1 vec2)
1249 : "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
1250 71 : (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
1251 1 : (string-equal (tramp-file-name-method vec1)
1252 1 : (tramp-file-name-method vec2))
1253 1 : (string-equal (tramp-file-name-user-domain vec1)
1254 1 : (tramp-file-name-user-domain vec2))
1255 1 : (string-equal (tramp-file-name-host-port vec1)
1256 71 : (tramp-file-name-host-port vec2))))
1257 :
1258 : (defun tramp-get-method-parameter (vec param)
1259 : "Return the method parameter PARAM.
1260 : If VEC is a vector, check first in connection properties.
1261 : Afterwards, check in `tramp-methods'. If the `tramp-methods'
1262 : entry does not exist, return nil."
1263 3403 : (let ((hash-entry
1264 3403 : (replace-regexp-in-string "^tramp-" "" (symbol-name param))))
1265 3403 : (if (tramp-connection-property-p vec hash-entry)
1266 : ;; We use the cached property.
1267 173 : (tramp-get-connection-property vec hash-entry nil)
1268 : ;; Use the static value from `tramp-methods'.
1269 3230 : (let ((methods-entry
1270 3230 : (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
1271 3403 : (when methods-entry (cadr methods-entry))))))
1272 :
1273 : ;; The localname can be quoted with "/:". Extract this.
1274 : (defun tramp-file-name-unquote-localname (vec)
1275 : "Return unquoted localname component of VEC."
1276 0 : (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
1277 :
1278 : ;;;###tramp-autoload
1279 : (defun tramp-tramp-file-p (name)
1280 : "Return t if NAME is a string with Tramp file name syntax."
1281 478669 : (save-match-data
1282 478669 : (and (stringp name)
1283 : ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
1284 478663 : (not (string-match
1285 478663 : (if (memq system-type '(cygwin windows-nt))
1286 478663 : "^/[[:alpha:]]?:" "^/:")
1287 478663 : name))
1288 478669 : (string-match (tramp-file-name-regexp) name))))
1289 :
1290 : (defun tramp-find-method (method user host)
1291 : "Return the right method string to use.
1292 : This is METHOD, if non-nil. Otherwise, do a lookup in
1293 : `tramp-default-method-alist'."
1294 279800 : (when (and method
1295 279800 : (or (string-equal method "")
1296 279800 : (string-equal method tramp-default-method-marker)))
1297 279800 : (setq method nil))
1298 279800 : (let ((result
1299 279800 : (or method
1300 2130 : (let ((choices tramp-default-method-alist)
1301 : lmethod item)
1302 8442 : (while choices
1303 12624 : (setq item (pop choices))
1304 6312 : (when (and (string-match (or (nth 0 item) "") (or host ""))
1305 6312 : (string-match (or (nth 1 item) "") (or user "")))
1306 47 : (setq lmethod (nth 2 item))
1307 6312 : (setq choices nil)))
1308 2130 : lmethod)
1309 279800 : tramp-default-method)))
1310 : ;; We must mark, whether a default value has been used.
1311 279800 : (if (or method (null result))
1312 277715 : result
1313 279800 : (propertize result 'tramp-default t))))
1314 :
1315 : (defun tramp-find-user (method user host)
1316 : "Return the right user string to use.
1317 : This is USER, if non-nil. Otherwise, do a lookup in
1318 : `tramp-default-user-alist'."
1319 279798 : (let ((result
1320 279798 : (or user
1321 278117 : (let ((choices tramp-default-user-alist)
1322 : luser item)
1323 1390468 : (while choices
1324 2224702 : (setq item (pop choices))
1325 1112351 : (when (and (string-match (or (nth 0 item) "") (or method ""))
1326 1112351 : (string-match (or (nth 1 item) "") (or host "")))
1327 67 : (setq luser (nth 2 item))
1328 1112351 : (setq choices nil)))
1329 278117 : luser)
1330 279798 : tramp-default-user)))
1331 : ;; We must mark, whether a default value has been used.
1332 279798 : (if (or user (null result))
1333 278195 : result
1334 279798 : (propertize result 'tramp-default t))))
1335 :
1336 : (defun tramp-find-host (method user host)
1337 : "Return the right host string to use.
1338 : This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
1339 279798 : (or (and (> (length host) 0) host)
1340 4407 : (let ((choices tramp-default-host-alist)
1341 : lhost item)
1342 9624 : (while choices
1343 10434 : (setq item (pop choices))
1344 5217 : (when (and (string-match (or (nth 0 item) "") (or method ""))
1345 5217 : (string-match (or (nth 1 item) "") (or user "")))
1346 3604 : (setq lhost (nth 2 item))
1347 5217 : (setq choices nil)))
1348 4407 : lhost)
1349 279798 : tramp-default-host))
1350 :
1351 : (defun tramp-dissect-file-name (name &optional nodefault)
1352 : "Return a `tramp-file-name' structure.
1353 : The structure consists of remote method, remote user, remote host,
1354 : localname (file name on remote host) and hop. If NODEFAULT is
1355 : non-nil, the file name parts are not expanded to their default
1356 : values."
1357 282258 : (save-match-data
1358 282258 : (unless (tramp-tramp-file-p name)
1359 282256 : (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name))
1360 282256 : (if (not (string-match (nth 0 (tramp-file-name-structure)) name))
1361 0 : (error "`tramp-file-name-structure' didn't match!")
1362 282256 : (let ((method (match-string (nth 1 (tramp-file-name-structure)) name))
1363 282256 : (user (match-string (nth 2 (tramp-file-name-structure)) name))
1364 282256 : (host (match-string (nth 3 (tramp-file-name-structure)) name))
1365 282256 : (localname (match-string (nth 4 (tramp-file-name-structure)) name))
1366 282256 : (hop (match-string (nth 5 (tramp-file-name-structure)) name))
1367 : domain port)
1368 282256 : (when user
1369 1681 : (when (string-match tramp-user-with-domain-regexp user)
1370 0 : (setq domain (match-string 2 user)
1371 282256 : user (match-string 1 user))))
1372 :
1373 282256 : (when host
1374 282256 : (when (string-match tramp-host-with-port-regexp host)
1375 936 : (setq port (match-string 2 host)
1376 282256 : host (match-string 1 host)))
1377 282256 : (when (string-match (tramp-prefix-ipv6-regexp) host)
1378 282256 : (setq host (replace-match "" nil t host)))
1379 282256 : (when (string-match (tramp-postfix-ipv6-regexp) host)
1380 282256 : (setq host (replace-match "" nil t host))))
1381 :
1382 282256 : (unless nodefault
1383 279786 : (setq method (tramp-find-method method user host)
1384 279786 : user (tramp-find-user method user host)
1385 282256 : host (tramp-find-host method user host)))
1386 :
1387 282256 : (make-tramp-file-name
1388 282256 : :method method :user user :domain domain :host host :port port
1389 282256 : :localname (or localname "") :hop hop)))))
1390 :
1391 : (defun tramp-buffer-name (vec)
1392 : "A name for the connection buffer VEC."
1393 71492 : (let ((method (tramp-file-name-method vec))
1394 71492 : (user-domain (tramp-file-name-user-domain vec))
1395 71492 : (host-port (tramp-file-name-host-port vec)))
1396 71492 : (if (not (zerop (length user-domain)))
1397 468 : (format "*tramp/%s %s@%s*" method user-domain host-port)
1398 71492 : (format "*tramp/%s %s*" method host-port))))
1399 :
1400 : (defun tramp-make-tramp-file-name
1401 : (method user domain host port localname &optional hop)
1402 : "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
1403 : When not nil, optional DOMAIN, PORT and HOP are used."
1404 36387 : (concat (tramp-prefix-format) hop
1405 36387 : (unless (or (zerop (length method))
1406 36387 : (zerop (length (tramp-postfix-method-format))))
1407 36387 : (concat method (tramp-postfix-method-format)))
1408 36387 : user
1409 36387 : (unless (zerop (length domain))
1410 36387 : (concat tramp-prefix-domain-format domain))
1411 36387 : (unless (zerop (length user))
1412 36387 : tramp-postfix-user-format)
1413 36387 : (when host
1414 36387 : (if (string-match tramp-ipv6-regexp host)
1415 16 : (concat
1416 16 : (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
1417 36387 : host))
1418 36387 : (unless (zerop (length port))
1419 36387 : (concat tramp-prefix-port-format port))
1420 36387 : (tramp-postfix-host-format)
1421 36387 : (when localname localname)))
1422 :
1423 : (defun tramp-completion-make-tramp-file-name (method user host localname)
1424 : "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
1425 : It must not be a complete Tramp file name, but as long as there are
1426 : necessary only. This function will be used in file name completion."
1427 11 : (concat (tramp-prefix-format)
1428 11 : (unless (or (zerop (length method))
1429 11 : (zerop (length (tramp-postfix-method-format))))
1430 11 : (concat method (tramp-postfix-method-format)))
1431 11 : (unless (zerop (length user))
1432 11 : (concat user tramp-postfix-user-format))
1433 11 : (unless (zerop (length host))
1434 9 : (concat
1435 9 : (if (string-match tramp-ipv6-regexp host)
1436 0 : (concat
1437 0 : (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
1438 9 : host)
1439 11 : (tramp-postfix-host-format)))
1440 11 : (when localname localname)))
1441 :
1442 : (defun tramp-get-buffer (vec)
1443 : "Get the connection buffer to be used for VEC."
1444 33796 : (or (get-buffer (tramp-buffer-name vec))
1445 44 : (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
1446 : ;; We use the existence of connection property "process-buffer"
1447 : ;; as indication, whether a connection is active.
1448 44 : (tramp-set-connection-property
1449 44 : vec "process-buffer"
1450 44 : (tramp-get-connection-property vec "process-buffer" nil))
1451 44 : (setq buffer-undo-list t)
1452 44 : (setq default-directory
1453 44 : (tramp-make-tramp-file-name
1454 44 : (tramp-file-name-method vec)
1455 44 : (tramp-file-name-user vec)
1456 44 : (tramp-file-name-domain vec)
1457 44 : (tramp-file-name-host vec)
1458 44 : (tramp-file-name-port vec)
1459 44 : "/"))
1460 33796 : (current-buffer))))
1461 :
1462 : (defun tramp-get-connection-buffer (vec)
1463 : "Get the connection buffer to be used for VEC.
1464 : In case a second asynchronous communication has been started, it is different
1465 : from `tramp-get-buffer'."
1466 33987 : (or (tramp-get-connection-property vec "process-buffer" nil)
1467 33987 : (tramp-get-buffer vec)))
1468 :
1469 : (defun tramp-get-connection-name (vec)
1470 : "Get the connection name to be used for VEC.
1471 : In case a second asynchronous communication has been started, it is different
1472 : from the default one."
1473 38765 : (or (tramp-get-connection-property vec "process-name" nil)
1474 38765 : (tramp-buffer-name vec)))
1475 :
1476 : (defun tramp-get-connection-process (vec)
1477 : "Get the connection process to be used for VEC.
1478 : In case a second asynchronous communication has been started, it is different
1479 : from the default one."
1480 38694 : (and (tramp-file-name-p vec) (get-process (tramp-get-connection-name vec))))
1481 :
1482 : (defun tramp-set-connection-local-variables (vec)
1483 : "Set connection-local variables in the connection buffer used for VEC.
1484 : If connection-local variables are not supported by this Emacs
1485 : version, the function does nothing."
1486 71 : (with-current-buffer (tramp-get-connection-buffer vec)
1487 : ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
1488 71 : (tramp-compat-funcall
1489 : 'hack-connection-local-variables-apply
1490 : `(:application tramp
1491 : :protocol ,(tramp-file-name-method vec)
1492 : :user ,(tramp-file-name-user-domain vec)
1493 71 : :machine ,(tramp-file-name-host-port vec)))))
1494 :
1495 : (defun tramp-set-connection-local-variables-for-buffer ()
1496 : "Set connection-local variables in the current buffer.
1497 : If connection-local variables are not supported by this Emacs
1498 : version, the function does nothing."
1499 0 : (when (file-remote-p default-directory)
1500 : ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
1501 0 : (tramp-compat-funcall
1502 : 'hack-connection-local-variables-apply
1503 : `(:application tramp
1504 : :protocol ,(file-remote-p default-directory 'method)
1505 : :user ,(file-remote-p default-directory 'user)
1506 0 : :machine ,(file-remote-p default-directory 'host)))))
1507 :
1508 : (defun tramp-debug-buffer-name (vec)
1509 : "A name for the debug buffer for VEC."
1510 45 : (let ((method (tramp-file-name-method vec))
1511 45 : (user-domain (tramp-file-name-user-domain vec))
1512 45 : (host-port (tramp-file-name-host-port vec)))
1513 45 : (if (not (zerop (length user-domain)))
1514 0 : (format "*debug tramp/%s %s@%s*" method user-domain host-port)
1515 45 : (format "*debug tramp/%s %s*" method host-port))))
1516 :
1517 : (defconst tramp-debug-outline-regexp
1518 : "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #"
1519 : "Used for highlighting Tramp debug buffers in `outline-mode'.")
1520 :
1521 : (defun tramp-debug-outline-level ()
1522 : "Return the depth to which a statement is nested in the outline.
1523 : Point must be at the beginning of a header line.
1524 :
1525 : The outline level is equal to the verbosity of the Tramp message."
1526 0 : (1+ (string-to-number (match-string 1))))
1527 :
1528 : (defun tramp-get-debug-buffer (vec)
1529 : "Get the debug buffer for VEC."
1530 0 : (with-current-buffer
1531 0 : (get-buffer-create (tramp-debug-buffer-name vec))
1532 0 : (when (bobp)
1533 0 : (setq buffer-undo-list t)
1534 : ;; So it does not get loaded while `outline-regexp' is let-bound.
1535 0 : (require 'outline)
1536 : ;; Activate `outline-mode'. This runs `text-mode-hook' and
1537 : ;; `outline-mode-hook'. We must prevent that local processes
1538 : ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
1539 : ;; Furthermore, `outline-regexp' must have the correct value
1540 : ;; already, because it is used by `font-lock-compile-keywords'.
1541 0 : (let ((default-directory (tramp-compat-temporary-file-directory))
1542 0 : (outline-regexp tramp-debug-outline-regexp))
1543 0 : (outline-mode))
1544 0 : (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
1545 0 : (set (make-local-variable 'outline-level) 'tramp-debug-outline-level))
1546 0 : (current-buffer)))
1547 :
1548 : (defsubst tramp-debug-message (vec fmt-string &rest arguments)
1549 : "Append message to debug buffer.
1550 : Message is formatted with FMT-STRING as control string and the remaining
1551 : ARGUMENTS to actually emit the message (if applicable)."
1552 0 : (with-current-buffer (tramp-get-debug-buffer vec)
1553 0 : (goto-char (point-max))
1554 : ;; Headline.
1555 0 : (when (bobp)
1556 0 : (insert
1557 0 : (format
1558 : ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
1559 0 : emacs-version tramp-version))
1560 0 : (when (>= tramp-verbose 10)
1561 0 : (insert
1562 0 : (format
1563 : "\n;; Location: %s Git: %s"
1564 0 : (locate-library "tramp") (tramp-repository-get-version)))))
1565 0 : (unless (bolp)
1566 0 : (insert "\n"))
1567 : ;; Timestamp.
1568 0 : (let ((now (current-time)))
1569 0 : (insert (format-time-string "%T." now))
1570 0 : (insert (format "%06d " (nth 2 now))))
1571 : ;; Calling Tramp function. We suppress compat and trace functions
1572 : ;; from being displayed.
1573 0 : (let ((btn 1) btf fn)
1574 0 : (while (not fn)
1575 0 : (setq btf (nth 1 (backtrace-frame btn)))
1576 0 : (if (not btf)
1577 0 : (setq fn "")
1578 0 : (when (symbolp btf)
1579 0 : (setq fn (symbol-name btf))
1580 0 : (unless
1581 0 : (and
1582 0 : (string-match "^tramp" fn)
1583 0 : (not
1584 0 : (string-match
1585 0 : (concat
1586 : "^"
1587 0 : (regexp-opt
1588 : '("tramp-backtrace"
1589 : "tramp-compat-funcall"
1590 : "tramp-compat-user-error"
1591 : "tramp-condition-case-unless-debug"
1592 : "tramp-debug-message"
1593 : "tramp-error"
1594 : "tramp-error-with-buffer"
1595 : "tramp-message")
1596 0 : t)
1597 0 : "$")
1598 0 : fn)))
1599 0 : (setq fn nil)))
1600 0 : (setq btn (1+ btn))))
1601 : ;; The following code inserts filename and line number. Should
1602 : ;; be inactive by default, because it is time consuming.
1603 : ; (let ((ffn (find-function-noselect (intern fn))))
1604 : ; (insert
1605 : ; (format
1606 : ; "%s:%d: "
1607 : ; (file-name-nondirectory (buffer-file-name (car ffn)))
1608 : ; (with-current-buffer (car ffn)
1609 : ; (1+ (count-lines (point-min) (cdr ffn)))))))
1610 0 : (insert (format "%s " fn)))
1611 : ;; The message.
1612 0 : (insert (apply #'format-message fmt-string arguments))))
1613 :
1614 : (defvar tramp-message-show-message t
1615 : "Show Tramp message in the minibuffer.
1616 : This variable is used to disable messages from `tramp-error'.
1617 : The messages are visible anyway, because an error is raised.")
1618 :
1619 : (defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
1620 : "Emit a message depending on verbosity level.
1621 : VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
1622 : vector or a process. LEVEL says to be quiet if `tramp-verbose' is
1623 : less than LEVEL. The message is emitted only if `tramp-verbose' is
1624 : greater than or equal to LEVEL.
1625 :
1626 : The message is also logged into the debug buffer when `tramp-verbose'
1627 : is greater than or equal 4.
1628 :
1629 : Calls functions `message' and `tramp-debug-message' with FMT-STRING as
1630 : control string and the remaining ARGUMENTS to actually emit the message (if
1631 : applicable)."
1632 302802 : (ignore-errors
1633 302802 : (when (<= level tramp-verbose)
1634 : ;; Match data must be preserved!
1635 787 : (save-match-data
1636 : ;; Display only when there is a minimum level.
1637 787 : (when (and tramp-message-show-message (<= level 3))
1638 97 : (apply 'message
1639 97 : (concat
1640 97 : (cond
1641 97 : ((= level 0) "")
1642 0 : ((= level 1) "")
1643 0 : ((= level 2) "Warning: ")
1644 97 : (t "Tramp: "))
1645 97 : fmt-string)
1646 787 : arguments))
1647 : ;; Log only when there is a minimum level.
1648 787 : (when (>= tramp-verbose 4)
1649 : ;; Translate proc to vec.
1650 0 : (when (processp vec-or-proc)
1651 0 : (let ((tramp-verbose 0))
1652 0 : (setq vec-or-proc
1653 0 : (tramp-get-connection-property vec-or-proc "vector" nil))))
1654 : ;; Append connection buffer for error messages.
1655 0 : (when (= level 1)
1656 0 : (let ((tramp-verbose 0))
1657 0 : (with-current-buffer (tramp-get-connection-buffer vec-or-proc)
1658 0 : (setq fmt-string (concat fmt-string "\n%s")
1659 0 : arguments (append arguments (list (buffer-string)))))))
1660 : ;; Do it.
1661 0 : (when (tramp-file-name-p vec-or-proc)
1662 0 : (apply 'tramp-debug-message
1663 0 : vec-or-proc
1664 0 : (concat (format "(%d) # " level) fmt-string)
1665 302802 : arguments)))))))
1666 :
1667 : (defsubst tramp-backtrace (&optional vec-or-proc)
1668 : "Dump a backtrace into the debug buffer.
1669 : If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
1670 : function is meant for debugging purposes."
1671 22 : (if vec-or-proc
1672 20 : (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
1673 2 : (if (>= tramp-verbose 10)
1674 22 : (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
1675 :
1676 : (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
1677 : "Emit an error.
1678 : VEC-OR-PROC identifies the connection to use, SIGNAL is the
1679 : signal identifier to be raised, remaining arguments passed to
1680 : `tramp-message'. Finally, signal SIGNAL is raised."
1681 22 : (let (tramp-message-show-message)
1682 22 : (tramp-backtrace vec-or-proc)
1683 22 : (when vec-or-proc
1684 20 : (tramp-message
1685 20 : vec-or-proc 1 "%s"
1686 20 : (error-message-string
1687 20 : (list signal
1688 20 : (get signal 'error-message)
1689 22 : (apply #'format-message fmt-string arguments)))))
1690 22 : (signal signal (list (apply #'format-message fmt-string arguments)))))
1691 :
1692 : (defsubst tramp-error-with-buffer
1693 : (buf vec-or-proc signal fmt-string &rest arguments)
1694 : "Emit an error, and show BUF.
1695 : If BUF is nil, show the connection buf. Wait for 30\", or until
1696 : an input event arrives. The other arguments are passed to `tramp-error'."
1697 0 : (save-window-excursion
1698 0 : (let* ((buf (or (and (bufferp buf) buf)
1699 0 : (and (processp vec-or-proc) (process-buffer vec-or-proc))
1700 0 : (and (tramp-file-name-p vec-or-proc)
1701 0 : (tramp-get-connection-buffer vec-or-proc))))
1702 0 : (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
1703 0 : (and buf (with-current-buffer buf
1704 0 : (tramp-dissect-file-name default-directory))))))
1705 0 : (unwind-protect
1706 0 : (apply 'tramp-error vec-or-proc signal fmt-string arguments)
1707 : ;; Save exit.
1708 0 : (when (and buf
1709 0 : tramp-message-show-message
1710 0 : (not (zerop tramp-verbose))
1711 : ;; Do not show when flagged from outside.
1712 0 : (not (tramp-completion-mode-p))
1713 : ;; Show only when Emacs has started already.
1714 0 : (current-message))
1715 0 : (let ((enable-recursive-minibuffers t))
1716 : ;; `tramp-error' does not show messages. So we must do it
1717 : ;; ourselves.
1718 0 : (apply 'message fmt-string arguments)
1719 : ;; Show buffer.
1720 0 : (pop-to-buffer buf)
1721 0 : (discard-input)
1722 0 : (sit-for 30)))
1723 : ;; Reset timestamp. It would be wrong after waiting for a while.
1724 0 : (when (tramp-file-name-equal-p vec (car tramp-current-connection))
1725 0 : (setcdr tramp-current-connection (current-time)))))))
1726 :
1727 : (defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
1728 : "Execute BODY while redirecting the error message to `tramp-message'.
1729 : BODY is executed like wrapped by `with-demoted-errors'. FORMAT
1730 : is a format-string containing a %-sequence meaning to substitute
1731 : the resulting error message."
1732 : (declare (debug (symbolp body))
1733 : (indent 2))
1734 2 : (let ((err (make-symbol "err")))
1735 2 : `(condition-case-unless-debug ,err
1736 2 : (progn ,@body)
1737 2 : (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
1738 :
1739 : (defmacro with-parsed-tramp-file-name (filename var &rest body)
1740 : "Parse a Tramp filename and make components available in the body.
1741 :
1742 : First arg FILENAME is evaluated and dissected into its components.
1743 : Second arg VAR is a symbol. It is used as a variable name to hold
1744 : the filename structure. It is also used as a prefix for the variables
1745 : holding the components. For example, if VAR is the symbol `foo', then
1746 : `foo' will be bound to the whole structure, `foo-method' will be bound to
1747 : the method component, and so on for `foo-user', `foo-host', `foo-localname',
1748 : `foo-hop'.
1749 :
1750 : Remaining args are Lisp expressions to be evaluated (inside an implicit
1751 : `progn').
1752 :
1753 : If VAR is nil, then we bind `v' to the structure and `method', `user',
1754 : `host', `localname', `hop' to the components."
1755 165 : (let ((bindings
1756 165 : (mapcar (lambda (elem)
1757 1155 : `(,(if var (intern (format "%s-%s" var elem)) elem)
1758 1155 : (,(intern (format "tramp-file-name-%s" elem))
1759 1155 : ,(or var 'v))))
1760 165 : '(method user domain host port localname hop))))
1761 165 : `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1762 165 : ,@bindings)
1763 : ;; We don't know which of those vars will be used, so we bind them all,
1764 : ;; and then add here a dummy use of all those variables, so we don't get
1765 : ;; flooded by warnings about those vars `body' didn't use.
1766 165 : (ignore ,@(mapcar #'car bindings))
1767 165 : ,@body)))
1768 :
1769 : (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
1770 : (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
1771 : (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
1772 :
1773 : (defun tramp-progress-reporter-update (reporter &optional value)
1774 : "Report progress of an operation for Tramp."
1775 0 : (let* ((parameters (cdr reporter))
1776 0 : (message (aref parameters 3)))
1777 0 : (when (string-match message (or (current-message) ""))
1778 0 : (progress-reporter-update reporter value))))
1779 :
1780 : (defmacro with-tramp-progress-reporter (vec level message &rest body)
1781 : "Executes BODY, spinning a progress reporter with MESSAGE.
1782 : If LEVEL does not fit for visible messages, there are only traces
1783 : without a visible progress reporter."
1784 : (declare (indent 3) (debug t))
1785 31 : `(progn
1786 31 : (tramp-message ,vec ,level "%s..." ,message)
1787 : (let ((cookie "failed")
1788 : (tm
1789 : ;; We start a pulsing progress reporter after 3 seconds.
1790 : (when (and tramp-message-show-message
1791 : ;; Display only when there is a minimum level.
1792 31 : (<= ,level (min tramp-verbose 3)))
1793 31 : (let ((pr (make-progress-reporter ,message nil nil)))
1794 : (when pr
1795 : (run-at-time
1796 : 3 0.1 #'tramp-progress-reporter-update pr))))))
1797 : (unwind-protect
1798 : ;; Execute the body.
1799 31 : (prog1 (progn ,@body) (setq cookie "done"))
1800 : ;; Stop progress reporter.
1801 : (if tm (cancel-timer tm))
1802 31 : (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
1803 :
1804 : (font-lock-add-keywords
1805 : 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
1806 :
1807 : (defmacro with-tramp-file-property (vec file property &rest body)
1808 : "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
1809 : FILE must be a local file name on a connection identified via VEC."
1810 29 : `(if (file-name-absolute-p ,file)
1811 29 : (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
1812 : (when (eq value 'undef)
1813 : ;; We cannot pass @body as parameter to
1814 : ;; `tramp-set-file-property' because it mangles our
1815 : ;; debug messages.
1816 29 : (setq value (progn ,@body))
1817 29 : (tramp-set-file-property ,vec ,file ,property value))
1818 : value)
1819 29 : ,@body))
1820 :
1821 : (put 'with-tramp-file-property 'lisp-indent-function 3)
1822 : (put 'with-tramp-file-property 'edebug-form-spec t)
1823 : (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
1824 :
1825 : (defmacro with-tramp-connection-property (key property &rest body)
1826 : "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
1827 52 : `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
1828 : (when (eq value 'undef)
1829 : ;; We cannot pass ,@body as parameter to
1830 : ;; `tramp-set-connection-property' because it mangles our debug
1831 : ;; messages.
1832 52 : (setq value (progn ,@body))
1833 52 : (tramp-set-connection-property ,key ,property value))
1834 52 : value))
1835 :
1836 : (put 'with-tramp-connection-property 'lisp-indent-function 2)
1837 : (put 'with-tramp-connection-property 'edebug-form-spec t)
1838 : (font-lock-add-keywords
1839 : 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
1840 :
1841 : (defun tramp-drop-volume-letter (name)
1842 : "Cut off unnecessary drive letter from file NAME.
1843 : The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
1844 : locally on a remote file name. When the local system is a W32 system
1845 : but the remote system is Unix, this introduces a superfluous drive
1846 : letter into the file name. This function removes it."
1847 24156 : (save-match-data
1848 24156 : (funcall
1849 24156 : (if (tramp-compat-file-name-quoted-p name)
1850 24156 : 'tramp-compat-file-name-quote 'identity)
1851 24156 : (let ((name (tramp-compat-file-name-unquote name)))
1852 24156 : (if (string-match "\\`[a-zA-Z]:/" name)
1853 0 : (replace-match "/" nil t name)
1854 24156 : name)))))
1855 :
1856 : ;;; Config Manipulation Functions:
1857 :
1858 : ;;;###tramp-autoload
1859 : (defun tramp-set-completion-function (method function-list)
1860 : "Sets the list of completion functions for METHOD.
1861 : FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
1862 : The FUNCTION is intended to parse FILE according its syntax.
1863 : It might be a predefined FUNCTION, or a user defined FUNCTION.
1864 : For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
1865 :
1866 : Example:
1867 :
1868 : (tramp-set-completion-function
1869 : \"ssh\"
1870 : \\='((tramp-parse-sconfig \"/etc/ssh_config\")
1871 : (tramp-parse-sconfig \"~/.ssh/config\")))"
1872 :
1873 100 : (let ((r function-list)
1874 100 : (v function-list))
1875 100 : (setq tramp-completion-function-alist
1876 100 : (delete (assoc method tramp-completion-function-alist)
1877 100 : tramp-completion-function-alist))
1878 :
1879 616 : (while v
1880 : ;; Remove double entries.
1881 516 : (when (member (car v) (cdr v))
1882 516 : (setcdr v (delete (car v) (cdr v))))
1883 : ;; Check for function and file or registry key.
1884 516 : (unless (and (functionp (nth 0 (car v)))
1885 516 : (cond
1886 : ;; Windows registry.
1887 516 : ((string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
1888 0 : (and (memq system-type '(cygwin windows-nt))
1889 0 : (zerop
1890 0 : (tramp-call-process
1891 0 : v "reg" nil nil nil "query" (nth 1 (car v))))))
1892 : ;; Zeroconf service type.
1893 516 : ((string-match
1894 516 : "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
1895 : ;; Configuration file.
1896 516 : (t (file-exists-p (nth 1 (car v))))))
1897 516 : (setq r (delete (car v) r)))
1898 516 : (setq v (cdr v)))
1899 :
1900 100 : (when r
1901 32 : (add-to-list 'tramp-completion-function-alist
1902 100 : (cons method r)))))
1903 :
1904 : (defun tramp-get-completion-function (method)
1905 : "Returns a list of completion functions for METHOD.
1906 : For definition of that list see `tramp-set-completion-function'."
1907 12 : (append
1908 12 : `(;; Default settings are taken into account.
1909 12 : (tramp-parse-default-user-host ,method)
1910 : ;; Hosts visited once shall be remembered.
1911 12 : (tramp-parse-connection-properties ,method))
1912 : ;; The method related defaults.
1913 12 : (cdr (assoc method tramp-completion-function-alist))))
1914 :
1915 :
1916 : ;;; Fontification of `read-file-name':
1917 :
1918 : (defvar tramp-rfn-eshadow-overlay)
1919 : (make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
1920 :
1921 : (defun tramp-rfn-eshadow-setup-minibuffer ()
1922 : "Set up a minibuffer for `file-name-shadow-mode'.
1923 : Adds another overlay hiding filename parts according to Tramp's
1924 : special handling of `substitute-in-file-name'."
1925 0 : (when (symbol-value 'minibuffer-completing-file-name)
1926 0 : (setq tramp-rfn-eshadow-overlay
1927 0 : (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
1928 : ;; Copy rfn-eshadow-overlay properties.
1929 0 : (let ((props (overlay-properties (symbol-value 'rfn-eshadow-overlay))))
1930 0 : (while props
1931 : ;; The `field' property prevents correct minibuffer
1932 : ;; completion; we exclude it.
1933 0 : (if (not (eq (car props) 'field))
1934 0 : (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))
1935 0 : (pop props) (pop props))))))
1936 :
1937 : (add-hook 'rfn-eshadow-setup-minibuffer-hook
1938 : 'tramp-rfn-eshadow-setup-minibuffer)
1939 : (add-hook 'tramp-unload-hook
1940 : (lambda ()
1941 : (remove-hook 'rfn-eshadow-setup-minibuffer-hook
1942 : 'tramp-rfn-eshadow-setup-minibuffer)))
1943 :
1944 : (defun tramp-rfn-eshadow-update-overlay-regexp ()
1945 0 : (format "[^%s/~]*\\(/\\|~\\)" (tramp-postfix-host-format)))
1946 :
1947 : (defun tramp-rfn-eshadow-update-overlay ()
1948 : "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
1949 : This is intended to be used as a minibuffer `post-command-hook' for
1950 : `file-name-shadow-mode'; the minibuffer should have already
1951 : been set up by `rfn-eshadow-setup-minibuffer'."
1952 : ;; In remote files name, there is a shadowing just for the local part.
1953 0 : (ignore-errors
1954 0 : (let ((end (or (overlay-end (symbol-value 'rfn-eshadow-overlay))
1955 0 : (minibuffer-prompt-end)))
1956 : ;; We do not want to send any remote command.
1957 : (non-essential t))
1958 0 : (when
1959 0 : (tramp-tramp-file-p
1960 0 : (buffer-substring-no-properties end (point-max)))
1961 0 : (save-excursion
1962 0 : (save-restriction
1963 0 : (narrow-to-region
1964 0 : (1+ (or (string-match
1965 0 : (tramp-rfn-eshadow-update-overlay-regexp)
1966 0 : (buffer-string) end)
1967 0 : end))
1968 0 : (point-max))
1969 0 : (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
1970 : (rfn-eshadow-update-overlay-hook nil)
1971 : file-name-handler-alist)
1972 0 : (move-overlay rfn-eshadow-overlay (point-max) (point-max))
1973 0 : (rfn-eshadow-update-overlay))))))))
1974 :
1975 : (add-hook 'rfn-eshadow-update-overlay-hook
1976 : 'tramp-rfn-eshadow-update-overlay)
1977 : (add-hook 'tramp-unload-hook
1978 : (lambda ()
1979 : (remove-hook 'rfn-eshadow-update-overlay-hook
1980 : 'tramp-rfn-eshadow-update-overlay)))
1981 :
1982 : ;; Inodes don't exist for some file systems. Therefore we must
1983 : ;; generate virtual ones. Used in `find-buffer-visiting'. The method
1984 : ;; applied might be not so efficient (Ange-FTP uses hashes). But
1985 : ;; performance isn't the major issue given that file transfer will
1986 : ;; take time.
1987 : (defvar tramp-inodes 0
1988 : "Keeps virtual inodes numbers.")
1989 :
1990 : ;; Devices must distinguish physical file systems. The device numbers
1991 : ;; provided by "lstat" aren't unique, because we operate on different hosts.
1992 : ;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
1993 : ;; EFS use device number "-1". In order to be different, we use device number
1994 : ;; (-1 . x), whereby "x" is unique for a given (method user host).
1995 : (defvar tramp-devices 0
1996 : "Keeps virtual device numbers.")
1997 :
1998 : (defun tramp-default-file-modes (filename)
1999 : "Return file modes of FILENAME as integer.
2000 : If the file modes of FILENAME cannot be determined, return the
2001 : value of `default-file-modes', without execute permissions."
2002 857 : (or (file-modes filename)
2003 857 : (logand (default-file-modes) (string-to-number "0666" 8))))
2004 :
2005 : (defun tramp-replace-environment-variables (filename)
2006 : "Replace environment variables in FILENAME.
2007 : Return the string with the replaced variables."
2008 46630 : (or (ignore-errors
2009 : ;; Optional arg has been introduced with Emacs 24.4.
2010 46630 : (tramp-compat-funcall 'substitute-env-vars filename 'only-defined))
2011 : ;; We need an own implementation.
2012 0 : (save-match-data
2013 0 : (let ((idx (string-match "$\\(\\w+\\)" filename)))
2014 : ;; `$' is coded as `$$'.
2015 0 : (when (and idx
2016 0 : (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
2017 0 : (getenv (match-string 1 filename)))
2018 0 : (setq filename
2019 0 : (replace-match
2020 0 : (substitute-in-file-name (match-string 0 filename))
2021 0 : t nil filename)))
2022 46630 : filename))))
2023 :
2024 : (defun tramp-find-file-name-coding-system-alist (filename tmpname)
2025 : "Like `find-operation-coding-system' for Tramp filenames.
2026 : Tramp's `insert-file-contents' and `write-region' work over
2027 : temporary file names. If `file-coding-system-alist' contains an
2028 : expression, which matches more than the file name suffix, the
2029 : coding system might not be determined. This function repairs it."
2030 669 : (let (result)
2031 669 : (dolist (elt file-coding-system-alist (nreverse result))
2032 14049 : (when (and (consp elt) (string-match (car elt) filename))
2033 : ;; We found a matching entry in `file-coding-system-alist'.
2034 : ;; So we add a similar entry, but with the temporary file name
2035 : ;; as regexp.
2036 14049 : (push (cons (regexp-quote tmpname) (cdr elt)) result)))))
2037 :
2038 : (defun tramp-run-real-handler (operation args)
2039 : "Invoke normal file name handler for OPERATION.
2040 : First arg specifies the OPERATION, second arg is a list of arguments to
2041 : pass to the OPERATION."
2042 82279 : (let* ((inhibit-file-name-handlers
2043 82279 : `(tramp-file-name-handler
2044 : tramp-vc-file-name-handler
2045 : tramp-completion-file-name-handler
2046 : cygwin-mount-name-hook-function
2047 : cygwin-mount-map-drive-hook-function
2048 : .
2049 82279 : ,(and (eq inhibit-file-name-operation operation)
2050 82279 : inhibit-file-name-handlers)))
2051 82279 : (inhibit-file-name-operation operation))
2052 82279 : (apply operation args)))
2053 :
2054 : ;; We handle here all file primitives. Most of them have the file
2055 : ;; name as first parameter; nevertheless we check for them explicitly
2056 : ;; in order to be signaled if a new primitive appears. This
2057 : ;; scenario is needed because there isn't a way to decide by
2058 : ;; syntactical means whether a foreign method must be called. It would
2059 : ;; ease the life if `file-name-handler-alist' would support a decision
2060 : ;; function as well but regexp only.
2061 : (defun tramp-file-name-for-operation (operation &rest args)
2062 : "Return file name related to OPERATION file primitive.
2063 : ARGS are the arguments OPERATION has been called with."
2064 46544 : (cond
2065 : ;; FILE resp DIRECTORY.
2066 46544 : ((member operation
2067 : '(access-file byte-compiler-base-file-name delete-directory
2068 : delete-file diff-latest-backup-file directory-file-name
2069 : directory-files directory-files-and-attributes
2070 : dired-compress-file dired-uncache file-acl
2071 : file-accessible-directory-p file-attributes
2072 : file-directory-p file-executable-p file-exists-p
2073 : file-local-copy file-modes file-name-as-directory
2074 : file-name-directory file-name-nondirectory
2075 : file-name-sans-versions file-notify-add-watch
2076 : file-ownership-preserved-p file-readable-p
2077 : file-regular-p file-remote-p file-selinux-context
2078 : file-symlink-p file-truename file-writable-p
2079 : find-backup-file-name find-file-noselect get-file-buffer
2080 : insert-directory insert-file-contents load
2081 : make-directory make-directory-internal set-file-acl
2082 : set-file-modes set-file-selinux-context set-file-times
2083 : substitute-in-file-name unhandled-file-name-directory
2084 : vc-registered
2085 : ;; Emacs 26+ only.
2086 46544 : file-name-case-insensitive-p))
2087 20948 : (if (file-name-absolute-p (nth 0 args))
2088 20948 : (nth 0 args)
2089 20948 : default-directory))
2090 : ;; FILE DIRECTORY resp FILE1 FILE2.
2091 25596 : ((member operation
2092 : '(add-name-to-file copy-directory copy-file expand-file-name
2093 : file-equal-p file-in-directory-p
2094 : file-name-all-completions file-name-completion
2095 25596 : file-newer-than-file-p make-symbolic-link rename-file))
2096 25036 : (save-match-data
2097 25036 : (cond
2098 25036 : ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
2099 2276 : ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
2100 25036 : (t default-directory))))
2101 : ;; START END FILE.
2102 560 : ((eq operation 'write-region)
2103 409 : (if (file-name-absolute-p (nth 2 args))
2104 409 : (nth 2 args)
2105 409 : default-directory))
2106 : ;; BUFFER.
2107 151 : ((member operation
2108 : '(make-auto-save-file-name
2109 151 : set-visited-file-modtime verify-visited-file-modtime))
2110 4 : (buffer-file-name
2111 4 : (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
2112 : ;; COMMAND.
2113 147 : ((member operation
2114 : '(process-file shell-command start-file-process
2115 : ;; Emacs 26+ only.
2116 147 : make-nearby-temp-file temporary-file-directory))
2117 147 : default-directory)
2118 : ;; PROC.
2119 0 : ((member operation
2120 : '(file-notify-rm-watch
2121 : ;; Emacs 25+ only.
2122 0 : file-notify-valid-p))
2123 0 : (when (processp (nth 0 args))
2124 0 : (with-current-buffer (process-buffer (nth 0 args))
2125 0 : default-directory)))
2126 : ;; Unknown file primitive.
2127 46544 : (t (error "unknown file I/O primitive: %s" operation))))
2128 :
2129 : (defun tramp-find-foreign-file-name-handler (filename &optional _operation)
2130 : "Return foreign file name handler if exists."
2131 46580 : (when (tramp-tramp-file-p filename)
2132 46580 : (let ((handler tramp-foreign-file-name-handler-alist)
2133 : elt res)
2134 279469 : (while handler
2135 232889 : (setq elt (car handler)
2136 232889 : handler (cdr handler))
2137 232889 : (when (funcall (car elt) filename)
2138 46580 : (setq handler nil
2139 232889 : res (cdr elt))))
2140 46580 : res)))
2141 :
2142 : (defvar tramp-debug-on-error nil
2143 : "Like `debug-on-error' but used Tramp internal.")
2144 :
2145 : (defmacro tramp-condition-case-unless-debug
2146 : (var bodyform &rest handlers)
2147 : "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
2148 1 : `(let ((debug-on-error tramp-debug-on-error))
2149 1 : (condition-case-unless-debug ,var ,bodyform ,@handlers)))
2150 :
2151 : ;; In Emacs, there is some concurrency due to timers. If a timer
2152 : ;; interrupts Tramp and wishes to use the same connection buffer as
2153 : ;; the "main" Emacs, then garbage might occur in the connection
2154 : ;; buffer. Therefore, we need to make sure that a timer does not use
2155 : ;; the same connection buffer as the "main" Emacs. We implement a
2156 : ;; cheap global lock, instead of locking each connection buffer
2157 : ;; separately. The global lock is based on two variables,
2158 : ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
2159 : ;; (with setq) to indicate a lock. But Tramp also calls itself during
2160 : ;; processing of a single file operation, so we need to allow
2161 : ;; recursive calls. That's where the `tramp-locker' variable comes in
2162 : ;; -- it is let-bound to t during the execution of the current
2163 : ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
2164 : ;; then we should just proceed because we have been called
2165 : ;; recursively. But if `tramp-locker' is nil, then we are a timer
2166 : ;; interrupting the "main" Emacs, and then we signal an error.
2167 :
2168 : (defvar tramp-locked nil
2169 : "If non-nil, then Tramp is currently busy.
2170 : Together with `tramp-locker', this implements a locking mechanism
2171 : preventing reentrant calls of Tramp.")
2172 :
2173 : (defvar tramp-locker nil
2174 : "If non-nil, then a caller has locked Tramp.
2175 : Together with `tramp-locked', this implements a locking mechanism
2176 : preventing reentrant calls of Tramp.")
2177 :
2178 : ;; Main function.
2179 : (defun tramp-file-name-handler (operation &rest args)
2180 : "Invoke Tramp file name handler.
2181 : Falls back to normal file name handler if no Tramp file name handler exists."
2182 46544 : (let ((filename (apply 'tramp-file-name-for-operation operation args)))
2183 46544 : (if (and tramp-mode (tramp-tramp-file-p filename))
2184 46544 : (save-match-data
2185 46544 : (setq filename (tramp-replace-environment-variables filename))
2186 46544 : (with-parsed-tramp-file-name filename nil
2187 46544 : (let ((completion (tramp-completion-mode-p))
2188 : (foreign
2189 46544 : (tramp-find-foreign-file-name-handler filename operation))
2190 : result)
2191 : ;; Call the backend function.
2192 46544 : (if foreign
2193 46544 : (tramp-condition-case-unless-debug err
2194 : (let ((sf (symbol-function foreign)))
2195 : ;; Some packages set the default directory to a
2196 : ;; remote path, before respective Tramp packages
2197 : ;; are already loaded. This results in
2198 : ;; recursive loading. Therefore, we load the
2199 : ;; Tramp packages locally.
2200 : (when (autoloadp sf)
2201 : (let ((default-directory
2202 : (tramp-compat-temporary-file-directory)))
2203 : (load (cadr sf) 'noerror 'nomessage)))
2204 : ;; If `non-essential' is non-nil, Tramp shall
2205 : ;; not open a new connection.
2206 : ;; If Tramp detects that it shouldn't continue
2207 : ;; to work, it throws the `suppress' event.
2208 : ;; This could happen for example, when Tramp
2209 : ;; tries to open the same connection twice in a
2210 : ;; short time frame.
2211 : ;; In both cases, we try the default handler then.
2212 : (setq result
2213 : (catch 'non-essential
2214 : (catch 'suppress
2215 : (when (and tramp-locked (not tramp-locker))
2216 : (setq tramp-locked nil)
2217 : (tramp-error
2218 : (car-safe tramp-current-connection)
2219 : 'file-error
2220 : "Forbidden reentrant call of Tramp"))
2221 : (let ((tl tramp-locked))
2222 : (setq tramp-locked t)
2223 : (unwind-protect
2224 : (let ((tramp-locker t))
2225 : (apply foreign operation args))
2226 : (setq tramp-locked tl))))))
2227 : (cond
2228 : ((eq result 'non-essential)
2229 : (tramp-message
2230 : v 5 "Non-essential received in operation %s"
2231 : (cons operation args))
2232 : (tramp-run-real-handler operation args))
2233 : ((eq result 'suppress)
2234 : (let (tramp-message-show-message)
2235 : (tramp-message
2236 : v 1 "Suppress received in operation %s"
2237 : (cons operation args))
2238 : (tramp-cleanup-connection v t)
2239 : (tramp-run-real-handler operation args)))
2240 : (t result)))
2241 :
2242 : ;; Trace that somebody has interrupted the operation.
2243 : ((debug quit)
2244 : (let (tramp-message-show-message)
2245 : (tramp-message
2246 : v 1 "Interrupt received in operation %s"
2247 : (cons operation args)))
2248 : ;; Propagate the quit signal.
2249 : (signal (car err) (cdr err)))
2250 :
2251 : ;; When we are in completion mode, some failed
2252 : ;; operations shall return at least a default
2253 : ;; value in order to give the user a chance to
2254 : ;; correct the file name in the minibuffer.
2255 : ;; In order to get a full backtrace, one could apply
2256 : ;; (setq tramp-debug-on-error t)
2257 : (error
2258 : (cond
2259 : ((and completion (zerop (length localname))
2260 : (memq operation '(file-exists-p file-directory-p)))
2261 : t)
2262 : ((and completion (zerop (length localname))
2263 : (memq operation
2264 : '(expand-file-name file-name-as-directory)))
2265 : filename)
2266 : ;; Propagate the error.
2267 46522 : (t (signal (car err) (cdr err))))))
2268 :
2269 : ;; Nothing to do for us. However, since we are in
2270 : ;; `tramp-mode', we must suppress the volume letter on
2271 : ;; MS Windows.
2272 0 : (setq result (tramp-run-real-handler operation args))
2273 0 : (if (stringp result)
2274 0 : (tramp-drop-volume-letter result)
2275 46522 : result)))))
2276 :
2277 : ;; When `tramp-mode' is not enabled, or the file name is quoted,
2278 : ;; we don't do anything.
2279 46522 : (tramp-run-real-handler operation args))))
2280 :
2281 : ;;;###autoload
2282 : (defun tramp-completion-file-name-handler (operation &rest args)
2283 : "Invoke Tramp file name completion handler.
2284 : Falls back to normal file name handler if no Tramp file name handler exists."
2285 7 : (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
2286 7 : (if (and fn tramp-mode)
2287 7 : (save-match-data (apply (cdr fn) args))
2288 7 : (tramp-run-real-handler operation args))))
2289 :
2290 : ;;;###autoload
2291 : (progn (defun tramp-autoload-file-name-handler (operation &rest args)
2292 : "Load Tramp file name handler, and perform OPERATION."
2293 : (let ((default-directory temporary-file-directory))
2294 : (load "tramp" 'noerror 'nomessage))
2295 : (apply operation args)))
2296 :
2297 : ;; `tramp-autoload-file-name-handler' must be registered before
2298 : ;; evaluation of site-start and init files, because there might exist
2299 : ;; remote files already, f.e. files kept via recentf-mode.
2300 : ;;;###autoload
2301 : (progn (defun tramp-register-autoload-file-name-handlers ()
2302 : "Add Tramp file name handlers to `file-name-handler-alist' during autoload."
2303 : (add-to-list 'file-name-handler-alist
2304 : (cons tramp-initial-file-name-regexp
2305 : 'tramp-autoload-file-name-handler))
2306 : (put 'tramp-autoload-file-name-handler 'safe-magic t)
2307 :
2308 : (add-to-list 'file-name-handler-alist
2309 : (cons tramp-initial-completion-file-name-regexp
2310 : 'tramp-completion-file-name-handler))
2311 : (put 'tramp-completion-file-name-handler 'safe-magic t)
2312 : ;; Mark `operations' the handler is responsible for.
2313 : (put 'tramp-completion-file-name-handler 'operations
2314 : (mapcar 'car tramp-completion-file-name-handler-alist))))
2315 :
2316 : ;;;###autoload
2317 : (tramp-register-autoload-file-name-handlers)
2318 :
2319 : (defun tramp-use-absolute-autoload-file-names ()
2320 : "Change Tramp autoload objects to use absolute file names.
2321 : This avoids problems during autoload, when `load-path' contains
2322 : remote file names."
2323 : ;; We expect all other Tramp files in the same directory as tramp.el.
2324 1 : (let* ((dir (expand-file-name (file-name-directory (locate-library "tramp"))))
2325 : (files-regexp
2326 1 : (format
2327 : "^%s$"
2328 1 : (regexp-opt
2329 1 : (mapcar
2330 : 'file-name-sans-extension
2331 1 : (directory-files dir nil "^tramp.+\\.elc?$"))
2332 1 : 'paren))))
2333 1 : (mapatoms
2334 : (lambda (atom)
2335 24984 : (when (and (functionp atom)
2336 10086 : (autoloadp (symbol-function atom))
2337 24984 : (string-match files-regexp (cadr (symbol-function atom))))
2338 0 : (ignore-errors
2339 0 : (setf (cadr (symbol-function atom))
2340 24985 : (expand-file-name (cadr (symbol-function atom)) dir))))))))
2341 :
2342 : (eval-after-load 'tramp (tramp-use-absolute-autoload-file-names))
2343 :
2344 : (defun tramp-register-file-name-handlers ()
2345 : "Add Tramp file name handlers to `file-name-handler-alist'."
2346 : ;; Remove autoloaded handlers from file name handler alist. Useful,
2347 : ;; if `tramp-syntax' has been changed.
2348 13 : (dolist (fnh '(tramp-file-name-handler
2349 : tramp-completion-file-name-handler
2350 : tramp-autoload-file-name-handler))
2351 39 : (let ((a1 (rassq fnh file-name-handler-alist)))
2352 39 : (setq file-name-handler-alist (delq a1 file-name-handler-alist))))
2353 :
2354 : ;; Add the handlers. We do not add anything to the `operations'
2355 : ;; property of `tramp-file-name-handler', this shall be done by the
2356 : ;; respective foreign handlers.
2357 13 : (add-to-list 'file-name-handler-alist
2358 13 : (cons (tramp-file-name-regexp) 'tramp-file-name-handler))
2359 13 : (put 'tramp-file-name-handler 'safe-magic t)
2360 :
2361 13 : (add-to-list 'file-name-handler-alist
2362 13 : (cons (tramp-completion-file-name-regexp)
2363 13 : 'tramp-completion-file-name-handler))
2364 13 : (put 'tramp-completion-file-name-handler 'safe-magic t)
2365 : ;; Mark `operations' the handler is responsible for.
2366 13 : (put 'tramp-completion-file-name-handler 'operations
2367 13 : (mapcar 'car tramp-completion-file-name-handler-alist))
2368 :
2369 : ;; If jka-compr or epa-file are already loaded, move them to the
2370 : ;; front of `file-name-handler-alist'.
2371 13 : (dolist (fnh '(epa-file-handler jka-compr-handler))
2372 26 : (let ((entry (rassoc fnh file-name-handler-alist)))
2373 26 : (when entry
2374 26 : (setq file-name-handler-alist
2375 26 : (cons entry (delete entry file-name-handler-alist)))))))
2376 :
2377 : (eval-after-load 'tramp (tramp-register-file-name-handlers))
2378 :
2379 : ;;;###tramp-autoload
2380 : (progn (defun tramp-register-foreign-file-name-handler
2381 : (func handler &optional append)
2382 : "Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'.
2383 : FUNC is the function, which determines whether HANDLER is to be called.
2384 : Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
2385 : (add-to-list
2386 : 'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
2387 : ;; Mark `operations' the handler is responsible for.
2388 : (put 'tramp-file-name-handler
2389 : 'operations
2390 : (delete-dups
2391 : (append
2392 : (get 'tramp-file-name-handler 'operations)
2393 : (mapcar
2394 : 'car
2395 : (symbol-value (intern (concat (symbol-name handler) "-alist")))))))))
2396 :
2397 : (defun tramp-exists-file-name-handler (operation &rest args)
2398 : "Check, whether OPERATION runs a file name handler."
2399 : ;; The file name handler is determined on base of either an
2400 : ;; argument, `buffer-file-name', or `default-directory'.
2401 0 : (ignore-errors
2402 0 : (let* ((buffer-file-name "/")
2403 : (default-directory "/")
2404 0 : (fnha file-name-handler-alist)
2405 0 : (check-file-name-operation operation)
2406 : (file-name-handler-alist
2407 0 : (list
2408 0 : (cons "/"
2409 : (lambda (operation &rest args)
2410 : "Returns OPERATION if it is the one to be checked."
2411 0 : (if (equal check-file-name-operation operation)
2412 0 : operation
2413 0 : (let ((file-name-handler-alist fnha))
2414 0 : (apply operation args))))))))
2415 0 : (equal (apply operation args) operation))))
2416 :
2417 : ;;;###autoload
2418 : (defun tramp-unload-file-name-handlers ()
2419 : "Unload Tramp file name handlers from `file-name-handler-alist'."
2420 0 : (dolist (fnh '(tramp-file-name-handler
2421 : tramp-completion-file-name-handler))
2422 0 : (let ((a1 (rassq fnh file-name-handler-alist)))
2423 0 : (setq file-name-handler-alist (delq a1 file-name-handler-alist)))))
2424 :
2425 : (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
2426 :
2427 : ;;; File name handler functions for completion mode:
2428 :
2429 : ;;;###autoload
2430 : (defvar tramp-completion-mode nil
2431 : "If non-nil, external packages signal that they are in file name completion.")
2432 : (make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1")
2433 :
2434 : (defun tramp-completion-mode-p ()
2435 : "Check, whether method / user name / host name completion is active."
2436 70761 : (or
2437 : ;; Signal from outside.
2438 70761 : non-essential
2439 : ;; This variable has been obsoleted in Emacs 26.
2440 70761 : tramp-completion-mode))
2441 :
2442 : (defun tramp-connectable-p (filename)
2443 : "Check, whether it is possible to connect the remote host w/o side-effects.
2444 : This is true, if either the remote host is already connected, or if we are
2445 : not in completion mode."
2446 24382 : (let (tramp-verbose)
2447 24382 : (and (tramp-tramp-file-p filename)
2448 24142 : (or (not (tramp-completion-mode-p))
2449 228 : (process-live-p
2450 228 : (tramp-get-connection-process
2451 24382 : (tramp-dissect-file-name filename)))))))
2452 :
2453 : ;; Method, host name and user name completion.
2454 : ;; `tramp-completion-dissect-file-name' returns a list of
2455 : ;; tramp-file-name structures. For all of them we return possible completions.
2456 : (defun tramp-completion-handle-file-name-all-completions (filename directory)
2457 : "Like `file-name-all-completions' for partial Tramp files."
2458 :
2459 7 : (let ((fullname
2460 7 : (tramp-drop-volume-letter (expand-file-name filename directory)))
2461 : hop result result1)
2462 :
2463 : ;; Suppress hop from completion.
2464 7 : (when (string-match
2465 7 : (concat
2466 7 : (tramp-prefix-regexp)
2467 7 : "\\(" "\\(" (tramp-remote-file-name-spec-regexp)
2468 7 : tramp-postfix-hop-regexp
2469 7 : "\\)+" "\\)")
2470 7 : fullname)
2471 0 : (setq hop (match-string 1 fullname)
2472 7 : fullname (replace-match "" nil nil fullname 1)))
2473 :
2474 : ;; Possible completion structures.
2475 7 : (dolist (elt (tramp-completion-dissect-file-name fullname))
2476 14 : (let* ((method (tramp-file-name-method elt))
2477 14 : (user (tramp-file-name-user elt))
2478 14 : (host (tramp-file-name-host elt))
2479 14 : (localname (tramp-file-name-localname elt))
2480 14 : (m (tramp-find-method method user host))
2481 14 : (tramp-current-user user) ; see `tramp-parse-passwd'
2482 : all-user-hosts)
2483 :
2484 14 : (unless localname ;; Nothing to complete.
2485 :
2486 14 : (if (or user host)
2487 :
2488 : ;; Method dependent user / host combinations.
2489 12 : (progn
2490 12 : (mapc
2491 : (lambda (x)
2492 24 : (setq all-user-hosts
2493 24 : (append all-user-hosts
2494 24 : (funcall (nth 0 x) (nth 1 x)))))
2495 12 : (tramp-get-completion-function m))
2496 :
2497 12 : (setq result
2498 12 : (append result
2499 12 : (mapcar
2500 : (lambda (x)
2501 16 : (tramp-get-completion-user-host
2502 16 : method user host (nth 0 x) (nth 1 x)))
2503 12 : (delq nil all-user-hosts)))))
2504 :
2505 : ;; Possible methods.
2506 2 : (setq result
2507 14 : (append result (tramp-get-completion-methods m)))))))
2508 :
2509 : ;; Unify list, add hop, remove nil elements.
2510 7 : (dolist (elt result)
2511 82 : (when elt
2512 11 : (string-match (tramp-prefix-regexp) elt)
2513 11 : (setq elt
2514 11 : (replace-match (concat (tramp-prefix-format) hop) nil nil elt))
2515 11 : (push
2516 11 : (substring elt (length (tramp-drop-volume-letter directory)))
2517 82 : result1)))
2518 :
2519 : ;; Complete local parts.
2520 7 : (append
2521 7 : result1
2522 7 : (ignore-errors
2523 7 : (tramp-run-real-handler
2524 7 : 'file-name-all-completions (list filename directory))))))
2525 :
2526 : ;; Method, host name and user name completion for a file.
2527 : (defun tramp-completion-handle-file-name-completion
2528 : (filename directory &optional predicate)
2529 : "Like `file-name-completion' for Tramp files."
2530 0 : (try-completion
2531 0 : filename
2532 0 : (mapcar 'list (file-name-all-completions filename directory))
2533 0 : (when (and predicate
2534 0 : (tramp-connectable-p (expand-file-name filename directory)))
2535 0 : (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
2536 :
2537 : ;; I misuse a little bit the tramp-file-name structure in order to
2538 : ;; handle completion possibilities for partial methods / user names /
2539 : ;; host names. Return value is a list of tramp-file-name structures
2540 : ;; according to possible completions. If "localname" is non-nil it
2541 : ;; means there shouldn't be a completion anymore.
2542 :
2543 : ;; Expected results:
2544 :
2545 : ;; "/x" "/[x"
2546 : ;; ["x" nil nil nil]
2547 :
2548 : ;; "/x:" "/[x/" "/x:y" "/[x/y" "/x:y:" "/[x/y]"
2549 : ;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""]
2550 : ;; ["x" "" nil nil] ["x" "y" nil nil]
2551 :
2552 : ;; "/x:y@""/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]"
2553 : ;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
2554 : (defun tramp-completion-dissect-file-name (name)
2555 : "Returns a list of `tramp-file-name' structures.
2556 : They are collected by `tramp-completion-dissect-file-name1'."
2557 :
2558 7 : (let* ((x-nil "\\|\\(\\)")
2559 : (tramp-completion-ipv6-regexp
2560 7 : (format
2561 : "[^%s]*"
2562 7 : (if (zerop (length (tramp-postfix-ipv6-format)))
2563 3 : (tramp-postfix-host-format)
2564 7 : (tramp-postfix-ipv6-format))))
2565 : ;; "/method" "/[method"
2566 : (tramp-completion-file-name-structure1
2567 7 : (list
2568 7 : (concat
2569 7 : (tramp-prefix-regexp)
2570 7 : "\\(" (tramp-method-regexp) x-nil "\\)$")
2571 7 : 1 nil nil nil))
2572 : ;; "/method:user" "/[method/user"
2573 : (tramp-completion-file-name-structure2
2574 7 : (list
2575 7 : (concat
2576 7 : (tramp-prefix-regexp)
2577 7 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
2578 7 : "\\(" tramp-user-regexp x-nil "\\)$")
2579 7 : 1 2 nil nil))
2580 : ;; "/method:host" "/[method/host"
2581 : (tramp-completion-file-name-structure3
2582 7 : (list
2583 7 : (concat
2584 7 : (tramp-prefix-regexp)
2585 7 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
2586 7 : "\\(" tramp-host-regexp x-nil "\\)$")
2587 7 : 1 nil 2 nil))
2588 : ;; "/method:[ipv6" "/[method/ipv6"
2589 : (tramp-completion-file-name-structure4
2590 7 : (list
2591 7 : (concat
2592 7 : (tramp-prefix-regexp)
2593 7 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
2594 7 : (tramp-prefix-ipv6-regexp)
2595 7 : "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2596 7 : 1 nil 2 nil))
2597 : ;; "/method:user@host" "/[method/user@host"
2598 : (tramp-completion-file-name-structure5
2599 7 : (list
2600 7 : (concat
2601 7 : (tramp-prefix-regexp)
2602 7 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
2603 7 : "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2604 7 : "\\(" tramp-host-regexp x-nil "\\)$")
2605 7 : 1 2 3 nil))
2606 : ;; "/method:user@[ipv6" "/[method/user@ipv6"
2607 : (tramp-completion-file-name-structure6
2608 7 : (list
2609 7 : (concat
2610 7 : (tramp-prefix-regexp)
2611 7 : "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
2612 7 : "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2613 7 : (tramp-prefix-ipv6-regexp)
2614 7 : "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2615 7 : 1 2 3 nil)))
2616 7 : (delq
2617 : nil
2618 7 : (mapcar
2619 42 : (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
2620 7 : (list
2621 7 : tramp-completion-file-name-structure1
2622 7 : tramp-completion-file-name-structure2
2623 7 : tramp-completion-file-name-structure3
2624 7 : tramp-completion-file-name-structure4
2625 7 : tramp-completion-file-name-structure5
2626 7 : tramp-completion-file-name-structure6)))))
2627 :
2628 : (defun tramp-completion-dissect-file-name1 (structure name)
2629 : "Returns a `tramp-file-name' structure matching STRUCTURE.
2630 : The structure consists of remote method, remote user,
2631 : remote host and localname (filename on remote host)."
2632 :
2633 42 : (save-match-data
2634 42 : (when (string-match (nth 0 structure) name)
2635 14 : (make-tramp-file-name
2636 14 : :method (and (nth 1 structure)
2637 14 : (match-string (nth 1 structure) name))
2638 14 : :user (and (nth 2 structure)
2639 14 : (match-string (nth 2 structure) name))
2640 14 : :host (and (nth 3 structure)
2641 42 : (match-string (nth 3 structure) name))))))
2642 :
2643 : ;; This function returns all possible method completions, adding the
2644 : ;; trailing method delimiter.
2645 : (defun tramp-get-completion-methods (partial-method)
2646 : "Returns all method completions for PARTIAL-METHOD."
2647 2 : (mapcar
2648 : (lambda (method)
2649 66 : (and method
2650 66 : (string-match (concat "^" (regexp-quote partial-method)) method)
2651 66 : (tramp-completion-make-tramp-file-name method nil nil nil)))
2652 2 : (mapcar 'car tramp-methods)))
2653 :
2654 : ;; Compares partial user and host names with possible completions.
2655 : (defun tramp-get-completion-user-host
2656 : (method partial-user partial-host user host)
2657 : "Returns the most expanded string for user and host name completion.
2658 : PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
2659 16 : (cond
2660 :
2661 16 : ((and partial-user partial-host)
2662 0 : (if (and host
2663 0 : (string-match (concat "^" (regexp-quote partial-host)) host)
2664 0 : (string-equal partial-user (or user partial-user)))
2665 0 : (setq user partial-user)
2666 0 : (setq user nil
2667 0 : host nil)))
2668 :
2669 16 : (partial-user
2670 7 : (setq host nil)
2671 7 : (unless
2672 7 : (and user (string-match (concat "^" (regexp-quote partial-user)) user))
2673 7 : (setq user nil)))
2674 :
2675 9 : (partial-host
2676 9 : (setq user nil)
2677 9 : (unless
2678 9 : (and host (string-match (concat "^" (regexp-quote partial-host)) host))
2679 9 : (setq host nil)))
2680 :
2681 0 : (t (setq user nil
2682 16 : host nil)))
2683 :
2684 16 : (unless (zerop (+ (length user) (length host)))
2685 16 : (tramp-completion-make-tramp-file-name method user host nil)))
2686 :
2687 : (defun tramp-parse-default-user-host (method)
2688 : "Return a list of (user host) tuples allowed to access for METHOD.
2689 : This function is added always in `tramp-get-completion-function'
2690 : for all methods. Resulting data are derived from default settings."
2691 12 : `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil))))
2692 :
2693 : ;; Generic function.
2694 : (defun tramp-parse-group (regexp match-level skip-regexp)
2695 : "Return a (user host) tuple allowed to access.
2696 : User is always nil."
2697 0 : (let (result)
2698 0 : (when (re-search-forward regexp (point-at-eol) t)
2699 0 : (setq result (list nil (match-string match-level))))
2700 0 : (or
2701 0 : (> (skip-chars-forward skip-regexp) 0)
2702 0 : (forward-line 1))
2703 0 : result))
2704 :
2705 : ;; Generic function.
2706 : (defun tramp-parse-file (filename function)
2707 : "Return a list of (user host) tuples allowed to access.
2708 : User is always nil."
2709 : ;; On Windows, there are problems in completion when
2710 : ;; `default-directory' is remote.
2711 0 : (let ((default-directory (tramp-compat-temporary-file-directory)))
2712 0 : (when (file-readable-p filename)
2713 0 : (with-temp-buffer
2714 0 : (insert-file-contents filename)
2715 0 : (goto-char (point-min))
2716 0 : (cl-loop while (not (eobp)) collect (funcall function))))))
2717 :
2718 : ;;;###tramp-autoload
2719 : (defun tramp-parse-rhosts (filename)
2720 : "Return a list of (user host) tuples allowed to access.
2721 : Either user or host may be nil."
2722 0 : (tramp-parse-file filename 'tramp-parse-rhosts-group))
2723 :
2724 : (defun tramp-parse-rhosts-group ()
2725 : "Return a (user host) tuple allowed to access.
2726 : Either user or host may be nil."
2727 0 : (let ((result)
2728 : (regexp
2729 0 : (concat
2730 0 : "^\\(" tramp-host-regexp "\\)"
2731 0 : "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2732 0 : (when (re-search-forward regexp (point-at-eol) t)
2733 0 : (setq result (append (list (match-string 3) (match-string 1)))))
2734 0 : (forward-line 1)
2735 0 : result))
2736 :
2737 : ;;;###tramp-autoload
2738 : (defun tramp-parse-shosts (filename)
2739 : "Return a list of (user host) tuples allowed to access.
2740 : User is always nil."
2741 0 : (tramp-parse-file filename 'tramp-parse-shosts-group))
2742 :
2743 : (defun tramp-parse-shosts-group ()
2744 : "Return a (user host) tuple allowed to access.
2745 : User is always nil."
2746 0 : (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
2747 :
2748 : ;;;###tramp-autoload
2749 : (defun tramp-parse-sconfig (filename)
2750 : "Return a list of (user host) tuples allowed to access.
2751 : User is always nil."
2752 0 : (tramp-parse-file filename 'tramp-parse-sconfig-group))
2753 :
2754 : (defun tramp-parse-sconfig-group ()
2755 : "Return a (user host) tuple allowed to access.
2756 : User is always nil."
2757 0 : (tramp-parse-group
2758 0 : (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)") 1 ","))
2759 :
2760 : ;; Generic function.
2761 : (defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
2762 : "Return a list of (user host) tuples allowed to access.
2763 : User is always nil."
2764 : ;; On Windows, there are problems in completion when
2765 : ;; `default-directory' is remote.
2766 0 : (let* ((default-directory (tramp-compat-temporary-file-directory))
2767 0 : (files (and (file-directory-p dirname) (directory-files dirname))))
2768 0 : (cl-loop
2769 0 : for f in files
2770 0 : when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
2771 0 : collect (list nil (match-string 1 f)))))
2772 :
2773 : ;;;###tramp-autoload
2774 : (defun tramp-parse-shostkeys (dirname)
2775 : "Return a list of (user host) tuples allowed to access.
2776 : User is always nil."
2777 0 : (tramp-parse-shostkeys-sknownhosts
2778 0 : dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
2779 :
2780 : ;;;###tramp-autoload
2781 : (defun tramp-parse-sknownhosts (dirname)
2782 : "Return a list of (user host) tuples allowed to access.
2783 : User is always nil."
2784 0 : (tramp-parse-shostkeys-sknownhosts
2785 0 : dirname
2786 0 : (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
2787 :
2788 : ;;;###tramp-autoload
2789 : (defun tramp-parse-hosts (filename)
2790 : "Return a list of (user host) tuples allowed to access.
2791 : User is always nil."
2792 0 : (tramp-parse-file filename 'tramp-parse-hosts-group))
2793 :
2794 : (defun tramp-parse-hosts-group ()
2795 : "Return a (user host) tuple allowed to access.
2796 : User is always nil."
2797 0 : (tramp-parse-group
2798 0 : (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
2799 :
2800 : ;;;###tramp-autoload
2801 : (defun tramp-parse-passwd (filename)
2802 : "Return a list of (user host) tuples allowed to access.
2803 : Host is always \"localhost\"."
2804 0 : (with-tramp-connection-property nil "parse-passwd"
2805 0 : (if (executable-find "getent")
2806 0 : (with-temp-buffer
2807 0 : (when (zerop (tramp-call-process nil "getent" nil t nil "passwd"))
2808 0 : (goto-char (point-min))
2809 0 : (cl-loop while (not (eobp)) collect
2810 0 : (tramp-parse-etc-group-group))))
2811 0 : (tramp-parse-file filename 'tramp-parse-passwd-group))))
2812 :
2813 : (defun tramp-parse-passwd-group ()
2814 : "Return a (user host) tuple allowed to access.
2815 : Host is always \"localhost\"."
2816 0 : (let ((result)
2817 0 : (regexp (concat "^\\(" tramp-user-regexp "\\):")))
2818 0 : (when (re-search-forward regexp (point-at-eol) t)
2819 0 : (setq result (list (match-string 1) "localhost")))
2820 0 : (forward-line 1)
2821 0 : result))
2822 :
2823 : ;;;###tramp-autoload
2824 : (defun tramp-parse-etc-group (filename)
2825 : "Return a list of (group host) tuples allowed to access.
2826 : Host is always \"localhost\"."
2827 0 : (with-tramp-connection-property nil "parse-group"
2828 0 : (if (executable-find "getent")
2829 0 : (with-temp-buffer
2830 0 : (when (zerop (tramp-call-process nil "getent" nil t nil "group"))
2831 0 : (goto-char (point-min))
2832 0 : (cl-loop while (not (eobp)) collect
2833 0 : (tramp-parse-etc-group-group))))
2834 0 : (tramp-parse-file filename 'tramp-parse-etc-group-group))))
2835 :
2836 : (defun tramp-parse-etc-group-group ()
2837 : "Return a (group host) tuple allowed to access.
2838 : Host is always \"localhost\"."
2839 0 : (let ((result)
2840 0 : (split (split-string (buffer-substring (point) (point-at-eol)) ":")))
2841 0 : (when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
2842 0 : (setq result (list (nth 0 split) "localhost")))
2843 0 : (forward-line 1)
2844 0 : result))
2845 :
2846 : ;;;###tramp-autoload
2847 : (defun tramp-parse-netrc (filename)
2848 : "Return a list of (user host) tuples allowed to access.
2849 : User may be nil."
2850 0 : (tramp-parse-file filename 'tramp-parse-netrc-group))
2851 :
2852 : (defun tramp-parse-netrc-group ()
2853 : "Return a (user host) tuple allowed to access.
2854 : User may be nil."
2855 0 : (let ((result)
2856 : (regexp
2857 0 : (concat
2858 0 : "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
2859 0 : "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2860 0 : (when (re-search-forward regexp (point-at-eol) t)
2861 0 : (setq result (list (match-string 3) (match-string 1))))
2862 0 : (forward-line 1)
2863 0 : result))
2864 :
2865 : ;;;###tramp-autoload
2866 : (defun tramp-parse-putty (registry-or-dirname)
2867 : "Return a list of (user host) tuples allowed to access.
2868 : User is always nil."
2869 0 : (if (memq system-type '(windows-nt))
2870 0 : (with-tramp-connection-property nil "parse-putty"
2871 0 : (with-temp-buffer
2872 0 : (when (zerop (tramp-call-process
2873 0 : nil "reg" nil t nil "query" registry-or-dirname))
2874 0 : (goto-char (point-min))
2875 0 : (cl-loop while (not (eobp)) collect
2876 0 : (tramp-parse-putty-group registry-or-dirname)))))
2877 : ;; UNIX case.
2878 0 : (tramp-parse-shostkeys-sknownhosts
2879 0 : registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
2880 :
2881 : (defun tramp-parse-putty-group (registry)
2882 : "Return a (user host) tuple allowed to access.
2883 : User is always nil."
2884 0 : (let ((result)
2885 0 : (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
2886 0 : (when (re-search-forward regexp (point-at-eol) t)
2887 0 : (setq result (list nil (match-string 1))))
2888 0 : (forward-line 1)
2889 0 : result))
2890 :
2891 : ;;; Common file name handler functions for different backends:
2892 :
2893 : (defvar tramp-handle-file-local-copy-hook nil
2894 : "Normal hook to be run at the end of `tramp-*-handle-file-local-copy'.")
2895 :
2896 : (defvar tramp-handle-write-region-hook nil
2897 : "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
2898 :
2899 : (defun tramp-handle-directory-file-name (directory)
2900 : "Like `directory-file-name' for Tramp files."
2901 : ;; If localname component of filename is "/", leave it unchanged.
2902 : ;; Otherwise, remove any trailing slash from localname component.
2903 : ;; Method, host, etc, are unchanged. Does it make sense to try
2904 : ;; to avoid parsing the filename?
2905 728 : (with-parsed-tramp-file-name directory nil
2906 728 : (if (and (not (zerop (length localname)))
2907 724 : (eq (aref localname (1- (length localname))) ?/)
2908 728 : (not (string= localname "/")))
2909 376 : (substring directory 0 -1)
2910 728 : directory)))
2911 :
2912 : (defun tramp-handle-directory-files (directory &optional full match nosort)
2913 : "Like `directory-files' for Tramp files."
2914 166 : (when (file-directory-p directory)
2915 166 : (setq directory (file-name-as-directory (expand-file-name directory)))
2916 166 : (let ((temp (nreverse (file-name-all-completions "" directory)))
2917 : result item)
2918 :
2919 849 : (while temp
2920 1366 : (setq item (directory-file-name (pop temp)))
2921 683 : (when (or (null match) (string-match match item))
2922 321 : (push (if full (concat directory item) item)
2923 683 : result)))
2924 166 : (if nosort result (sort result 'string<)))))
2925 :
2926 : (defun tramp-handle-directory-files-and-attributes
2927 : (directory &optional full match nosort id-format)
2928 : "Like `directory-files-and-attributes' for Tramp files."
2929 57 : (mapcar
2930 : (lambda (x)
2931 57 : (cons x (file-attributes
2932 57 : (if full x (expand-file-name x directory)) id-format)))
2933 57 : (directory-files directory full match nosort)))
2934 :
2935 : (defun tramp-handle-dired-uncache (dir)
2936 : "Like `dired-uncache' for Tramp files."
2937 0 : (with-parsed-tramp-file-name
2938 0 : (if (file-directory-p dir) dir (file-name-directory dir)) nil
2939 0 : (tramp-flush-directory-property v localname)))
2940 :
2941 : (defun tramp-handle-file-accessible-directory-p (filename)
2942 : "Like `file-accessible-directory-p' for Tramp files."
2943 5 : (and (file-directory-p filename)
2944 5 : (file-readable-p filename)))
2945 :
2946 : (defun tramp-handle-file-equal-p (filename1 filename2)
2947 : "Like `file-equalp-p' for Tramp files."
2948 : ;; Native `file-equalp-p' calls `file-truename', which requires a
2949 : ;; remote connection. This can be avoided, if FILENAME1 and
2950 : ;; FILENAME2 are not located on the same remote host.
2951 2 : (when (string-equal
2952 2 : (file-remote-p (expand-file-name filename1))
2953 2 : (file-remote-p (expand-file-name filename2)))
2954 2 : (tramp-run-real-handler 'file-equal-p (list filename1 filename2))))
2955 :
2956 : (defun tramp-handle-file-exists-p (filename)
2957 : "Like `file-exists-p' for Tramp files."
2958 0 : (not (null (file-attributes filename))))
2959 :
2960 : (defun tramp-handle-file-in-directory-p (filename directory)
2961 : "Like `file-in-directory-p' for Tramp files."
2962 : ;; Native `file-in-directory-p' calls `file-truename', which
2963 : ;; requires a remote connection. This can be avoided, if FILENAME
2964 : ;; and DIRECTORY are not located on the same remote host.
2965 16 : (when (string-equal
2966 16 : (file-remote-p (expand-file-name filename))
2967 16 : (file-remote-p (expand-file-name directory)))
2968 16 : (tramp-run-real-handler 'file-in-directory-p (list filename directory))))
2969 :
2970 : (defun tramp-handle-file-modes (filename)
2971 : "Like `file-modes' for Tramp files."
2972 787 : (let ((truename (or (file-truename filename) filename)))
2973 787 : (when (file-exists-p truename)
2974 466 : (tramp-mode-string-to-int
2975 787 : (tramp-compat-file-attribute-modes (file-attributes truename))))))
2976 :
2977 : ;; Localname manipulation functions that grok Tramp localnames...
2978 : (defun tramp-handle-file-name-as-directory (file)
2979 : "Like `file-name-as-directory' but aware of Tramp files."
2980 : ;; `file-name-as-directory' would be sufficient except localname is
2981 : ;; the empty string.
2982 1906 : (let ((v (tramp-dissect-file-name file t)))
2983 : ;; Run the command on the localname portion only unless we are in
2984 : ;; completion mode.
2985 1906 : (tramp-make-tramp-file-name
2986 1906 : (tramp-file-name-method v)
2987 1906 : (tramp-file-name-user v)
2988 1906 : (tramp-file-name-domain v)
2989 1906 : (tramp-file-name-host v)
2990 1906 : (tramp-file-name-port v)
2991 1906 : (if (and (zerop (length (tramp-file-name-localname v)))
2992 1906 : (not (tramp-connectable-p file)))
2993 : ""
2994 1904 : (tramp-run-real-handler
2995 1906 : 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))
2996 1906 : (tramp-file-name-hop v))))
2997 :
2998 : (defun tramp-handle-file-name-case-insensitive-p (filename)
2999 : "Like `file-name-case-insensitive-p' for Tramp files."
3000 : ;; We make it a connection property, assuming that all file systems
3001 : ;; on the remote host behave similar. This might be wrong for
3002 : ;; mounted NFS directories or SMB/AFP shares; such more granular
3003 : ;; tests will be added in case they are needed.
3004 109 : (setq filename (expand-file-name filename))
3005 109 : (with-parsed-tramp-file-name filename nil
3006 109 : (or ;; Maybe there is a default value.
3007 109 : (tramp-get-method-parameter v 'tramp-case-insensitive)
3008 :
3009 : ;; There isn't. So we must check, in case there's a connection already.
3010 109 : (and (file-remote-p filename nil 'connected)
3011 112 : (with-tramp-connection-property v "case-insensitive"
3012 3 : (ignore-errors
3013 6 : (with-tramp-progress-reporter v 5 "Checking case-insensitive"
3014 : ;; The idea is to compare a file with lower case
3015 : ;; letters with the same file with upper case letters.
3016 3 : (let ((candidate
3017 3 : (tramp-compat-file-name-unquote
3018 3 : (directory-file-name filename)))
3019 : tmpfile)
3020 : ;; Check, whether we find an existing file with
3021 : ;; lower case letters. This avoids us to create a
3022 : ;; temporary file.
3023 5 : (while (and (string-match
3024 5 : "[a-z]" (file-remote-p candidate 'localname))
3025 5 : (not (file-exists-p candidate)))
3026 2 : (setq candidate
3027 2 : (directory-file-name
3028 3 : (file-name-directory candidate))))
3029 : ;; Nothing found, so we must use a temporary file
3030 : ;; for comparison. `make-nearby-temp-file' is added
3031 : ;; to Emacs 26+ like `file-name-case-insensitive-p',
3032 : ;; so there is no compatibility problem calling it.
3033 3 : (unless
3034 3 : (string-match
3035 3 : "[a-z]" (file-remote-p candidate 'localname))
3036 0 : (setq tmpfile
3037 0 : (let ((default-directory
3038 0 : (file-name-directory filename)))
3039 0 : (tramp-compat-funcall
3040 0 : 'make-nearby-temp-file "tramp."))
3041 3 : candidate tmpfile))
3042 : ;; Check for the existence of the same file with
3043 : ;; upper case letters.
3044 3 : (unwind-protect
3045 3 : (file-exists-p
3046 3 : (concat
3047 3 : (file-remote-p candidate)
3048 3 : (upcase (file-remote-p candidate 'localname))))
3049 : ;; Cleanup.
3050 109 : (when tmpfile (delete-file tmpfile)))))))))))
3051 :
3052 : (defun tramp-handle-file-name-completion
3053 : (filename directory &optional predicate)
3054 : "Like `file-name-completion' for Tramp files."
3055 40 : (unless (tramp-tramp-file-p directory)
3056 0 : (error
3057 : "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
3058 40 : directory))
3059 40 : (let (hits-ignored-extensions)
3060 40 : (or
3061 40 : (try-completion
3062 40 : filename (file-name-all-completions filename directory)
3063 : (lambda (x)
3064 56 : (when (funcall (or predicate 'identity) (expand-file-name x directory))
3065 52 : (not
3066 52 : (and
3067 52 : completion-ignored-extensions
3068 52 : (string-match
3069 52 : (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
3070 : ;; We remember the hit.
3071 96 : (push x hits-ignored-extensions))))))
3072 : ;; No match. So we try again for ignored files.
3073 40 : (try-completion filename hits-ignored-extensions))))
3074 :
3075 : (defun tramp-handle-file-name-directory (file)
3076 : "Like `file-name-directory' but aware of Tramp files."
3077 : ;; Everything except the last filename thing is the directory. We
3078 : ;; cannot apply `with-parsed-tramp-file-name', because this expands
3079 : ;; the remote file name parts. This is a problem when we are in
3080 : ;; file name completion.
3081 564 : (let ((v (tramp-dissect-file-name file t)))
3082 : ;; Run the command on the localname portion only.
3083 564 : (tramp-make-tramp-file-name
3084 564 : (tramp-file-name-method v)
3085 564 : (tramp-file-name-user v)
3086 564 : (tramp-file-name-domain v)
3087 564 : (tramp-file-name-host v)
3088 564 : (tramp-file-name-port v)
3089 564 : (tramp-run-real-handler
3090 564 : 'file-name-directory (list (or (tramp-file-name-localname v) "")))
3091 564 : (tramp-file-name-hop v))))
3092 :
3093 : (defun tramp-handle-file-name-nondirectory (file)
3094 : "Like `file-name-nondirectory' but aware of Tramp files."
3095 1715 : (with-parsed-tramp-file-name file nil
3096 1715 : (tramp-run-real-handler 'file-name-nondirectory (list localname))))
3097 :
3098 : (defun tramp-handle-file-newer-than-file-p (file1 file2)
3099 : "Like `file-newer-than-file-p' for Tramp files."
3100 0 : (cond
3101 0 : ((not (file-exists-p file1)) nil)
3102 0 : ((not (file-exists-p file2)) t)
3103 0 : (t (time-less-p (tramp-compat-file-attribute-modification-time
3104 0 : (file-attributes file2))
3105 0 : (tramp-compat-file-attribute-modification-time
3106 0 : (file-attributes file1))))))
3107 :
3108 : (defun tramp-handle-file-regular-p (filename)
3109 : "Like `file-regular-p' for Tramp files."
3110 5 : (and (file-exists-p filename)
3111 5 : (eq ?-
3112 5 : (aref (tramp-compat-file-attribute-modes (file-attributes filename))
3113 5 : 0))))
3114 :
3115 : (defun tramp-handle-file-remote-p (filename &optional identification connected)
3116 : "Like `file-remote-p' for Tramp files."
3117 : ;; We do not want traces in the debug buffer.
3118 1223 : (let ((tramp-verbose (min tramp-verbose 3)))
3119 1223 : (when (tramp-tramp-file-p filename)
3120 1223 : (let* ((v (tramp-dissect-file-name filename))
3121 1223 : (p (tramp-get-connection-process v))
3122 1223 : (c (and (process-live-p p)
3123 1223 : (tramp-get-connection-property p "connected" nil))))
3124 : ;; We expand the file name only, if there is already a connection.
3125 1223 : (with-parsed-tramp-file-name
3126 1223 : (if c (expand-file-name filename) filename) nil
3127 1223 : (and (or (not connected) c)
3128 1223 : (cond
3129 1223 : ((eq identification 'method) method)
3130 : ;; Domain and port are appended.
3131 1110 : ((eq identification 'user) (tramp-file-name-user-domain v))
3132 1025 : ((eq identification 'host) (tramp-file-name-host-port v))
3133 946 : ((eq identification 'localname) localname)
3134 492 : ((eq identification 'hop) hop)
3135 419 : (t (tramp-make-tramp-file-name
3136 1223 : method user domain host port "" hop)))))))))
3137 :
3138 : (defun tramp-handle-file-symlink-p (filename)
3139 : "Like `file-symlink-p' for Tramp files."
3140 174 : (with-parsed-tramp-file-name filename nil
3141 174 : (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
3142 174 : (when (stringp x)
3143 161 : (if (file-name-absolute-p x)
3144 161 : (tramp-make-tramp-file-name method user domain host port x)
3145 174 : x)))))
3146 :
3147 : (defun tramp-handle-find-backup-file-name (filename)
3148 : "Like `find-backup-file-name' for Tramp files."
3149 0 : (with-parsed-tramp-file-name filename nil
3150 0 : (let ((backup-directory-alist
3151 0 : (if tramp-backup-directory-alist
3152 0 : (mapcar
3153 : (lambda (x)
3154 0 : (cons
3155 0 : (car x)
3156 0 : (if (and (stringp (cdr x))
3157 0 : (file-name-absolute-p (cdr x))
3158 0 : (not (tramp-file-name-p (cdr x))))
3159 0 : (tramp-make-tramp-file-name
3160 0 : method user domain host port (cdr x))
3161 0 : (cdr x))))
3162 0 : tramp-backup-directory-alist)
3163 0 : backup-directory-alist)))
3164 0 : (tramp-run-real-handler 'find-backup-file-name (list filename)))))
3165 :
3166 : (defun tramp-handle-insert-directory
3167 : (filename switches &optional wildcard full-directory-p)
3168 : "Like `insert-directory' for Tramp files."
3169 0 : (unless switches (setq switches ""))
3170 : ;; Mark trailing "/".
3171 0 : (when (and (zerop (length (file-name-nondirectory filename)))
3172 0 : (not full-directory-p))
3173 0 : (setq switches (concat switches "F")))
3174 0 : (with-parsed-tramp-file-name (expand-file-name filename) nil
3175 0 : (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
3176 0 : (require 'ls-lisp)
3177 0 : (let (ls-lisp-use-insert-directory-program start)
3178 0 : (tramp-run-real-handler
3179 : 'insert-directory
3180 0 : (list filename switches wildcard full-directory-p))
3181 : ;; `ls-lisp' always returns full listings. We must remove
3182 : ;; superfluous parts.
3183 0 : (unless (string-match "l" switches)
3184 0 : (save-excursion
3185 0 : (goto-char (point-min))
3186 0 : (while (setq start
3187 0 : (text-property-not-all
3188 0 : (point) (point-at-eol) 'dired-filename t))
3189 0 : (delete-region
3190 0 : start
3191 0 : (or (text-property-any start (point-at-eol) 'dired-filename t)
3192 0 : (point-at-eol)))
3193 0 : (if (= (point-at-bol) (point-at-eol))
3194 : ;; Empty line.
3195 0 : (delete-region (point) (progn (forward-line) (point)))
3196 0 : (forward-line)))))))))
3197 :
3198 : (defun tramp-handle-insert-file-contents
3199 : (filename &optional visit beg end replace)
3200 : "Like `insert-file-contents' for Tramp files."
3201 264 : (barf-if-buffer-read-only)
3202 264 : (setq filename (expand-file-name filename))
3203 264 : (let (result local-copy remote-copy)
3204 264 : (with-parsed-tramp-file-name filename nil
3205 264 : (unwind-protect
3206 264 : (if (not (file-exists-p filename))
3207 0 : (tramp-error
3208 0 : v tramp-file-missing
3209 0 : "File `%s' not found on remote host" filename)
3210 :
3211 264 : (with-tramp-progress-reporter
3212 528 : v 3 (format-message "Inserting `%s'" filename)
3213 264 : (condition-case err
3214 264 : (if (and (tramp-local-host-p v)
3215 0 : (let (file-name-handler-alist)
3216 264 : (file-readable-p localname)))
3217 : ;; Short track: if we are on the local host, we can
3218 : ;; run directly.
3219 0 : (setq result
3220 0 : (tramp-run-real-handler
3221 : 'insert-file-contents
3222 0 : (list localname visit beg end replace)))
3223 :
3224 : ;; When we shall insert only a part of the file, we
3225 : ;; copy this part. This works only for the shell file
3226 : ;; name handlers.
3227 264 : (when (and (or beg end)
3228 2 : (tramp-get-method-parameter
3229 264 : v 'tramp-login-program))
3230 2 : (setq remote-copy (tramp-make-tramp-temp-file v))
3231 : ;; This is defined in tramp-sh.el. Let's assume
3232 : ;; this is loaded already.
3233 2 : (tramp-compat-funcall
3234 : 'tramp-send-command
3235 : v
3236 : (cond
3237 : ((and beg end)
3238 : (format "dd bs=1 skip=%d if=%s count=%d of=%s"
3239 : beg (tramp-shell-quote-argument localname)
3240 : (- end beg) remote-copy))
3241 : (beg
3242 : (format "dd bs=1 skip=%d if=%s of=%s"
3243 : beg (tramp-shell-quote-argument localname)
3244 : remote-copy))
3245 : (end
3246 : (format "dd bs=1 count=%d if=%s of=%s"
3247 : end (tramp-shell-quote-argument localname)
3248 2 : remote-copy))))
3249 264 : (setq tramp-temp-buffer-file-name nil beg nil end nil))
3250 :
3251 : ;; `insert-file-contents-literally' takes care to
3252 : ;; avoid calling jka-compr.el and epa.el. By
3253 : ;; let-binding `inhibit-file-name-operation', we
3254 : ;; propagate that care to the `file-local-copy'
3255 : ;; operation.
3256 264 : (setq local-copy
3257 264 : (let ((inhibit-file-name-operation
3258 264 : (when (eq inhibit-file-name-operation
3259 264 : 'insert-file-contents)
3260 264 : 'file-local-copy)))
3261 264 : (cond
3262 264 : ((stringp remote-copy)
3263 2 : (file-local-copy
3264 2 : (tramp-make-tramp-file-name
3265 2 : method user domain host port remote-copy)))
3266 262 : ((stringp tramp-temp-buffer-file-name)
3267 0 : (copy-file
3268 0 : filename tramp-temp-buffer-file-name 'ok)
3269 0 : tramp-temp-buffer-file-name)
3270 264 : (t (file-local-copy filename)))))
3271 :
3272 : ;; When the file is not readable for the owner, it
3273 : ;; cannot be inserted, even if it is readable for the
3274 : ;; group or for everybody.
3275 264 : (set-file-modes local-copy (string-to-number "0600" 8))
3276 :
3277 264 : (when (and (null remote-copy)
3278 262 : (tramp-get-method-parameter
3279 264 : v 'tramp-copy-keep-tmpfile))
3280 : ;; We keep the local file for performance reasons,
3281 : ;; useful for "rsync".
3282 264 : (setq tramp-temp-buffer-file-name local-copy))
3283 :
3284 : ;; We must ensure that `file-coding-system-alist'
3285 : ;; matches `local-copy'.
3286 264 : (let ((file-coding-system-alist
3287 264 : (tramp-find-file-name-coding-system-alist
3288 264 : filename local-copy)))
3289 264 : (setq result
3290 264 : (insert-file-contents
3291 264 : local-copy visit beg end replace))))
3292 : (error
3293 0 : (add-hook 'find-file-not-found-functions
3294 0 : `(lambda () (signal ',(car err) ',(cdr err)))
3295 0 : nil t)
3296 264 : (signal (car err) (cdr err))))))
3297 :
3298 : ;; Save exit.
3299 264 : (progn
3300 264 : (when visit
3301 0 : (setq buffer-file-name filename)
3302 0 : (setq buffer-read-only (not (file-writable-p filename)))
3303 0 : (set-visited-file-modtime)
3304 264 : (set-buffer-modified-p nil))
3305 264 : (when (and (stringp local-copy)
3306 264 : (or remote-copy (null tramp-temp-buffer-file-name)))
3307 264 : (delete-file local-copy))
3308 264 : (when (stringp remote-copy)
3309 2 : (delete-file
3310 2 : (tramp-make-tramp-file-name
3311 264 : method user domain host port remote-copy)))))
3312 :
3313 : ;; Result.
3314 264 : (list (expand-file-name filename)
3315 264 : (cadr result)))))
3316 :
3317 : (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
3318 : "Like `load' for Tramp files."
3319 2 : (with-parsed-tramp-file-name (expand-file-name file) nil
3320 2 : (unless nosuffix
3321 0 : (cond ((file-exists-p (concat file ".elc"))
3322 0 : (setq file (concat file ".elc")))
3323 0 : ((file-exists-p (concat file ".el"))
3324 2 : (setq file (concat file ".el")))))
3325 2 : (when must-suffix
3326 : ;; The first condition is always true for absolute file names.
3327 : ;; Included for safety's sake.
3328 0 : (unless (or (file-name-directory file)
3329 0 : (string-match "\\.elc?\\'" file))
3330 0 : (tramp-error
3331 0 : v 'file-error
3332 2 : "File `%s' does not include a `.el' or `.elc' suffix" file)))
3333 2 : (unless noerror
3334 2 : (when (not (file-exists-p file))
3335 0 : (tramp-error
3336 2 : v tramp-file-missing "Cannot load nonexistent file `%s'" file)))
3337 2 : (if (not (file-exists-p file))
3338 : nil
3339 2 : (let ((tramp-message-show-message (not nomessage)))
3340 4 : (with-tramp-progress-reporter v 0 (format "Loading %s" file)
3341 2 : (let ((local-copy (file-local-copy file)))
3342 2 : (unwind-protect
3343 2 : (load local-copy noerror t nosuffix must-suffix)
3344 2 : (delete-file local-copy)))))
3345 2 : t)))
3346 :
3347 : (defun tramp-handle-make-symbolic-link
3348 : (filename linkname &optional _ok-if-already-exists)
3349 : "Like `make-symbolic-link' for Tramp files."
3350 0 : (with-parsed-tramp-file-name
3351 0 : (if (tramp-tramp-file-p filename) filename linkname) nil
3352 0 : (tramp-error v 'file-error "make-symbolic-link not supported")))
3353 :
3354 : (defun tramp-handle-shell-command
3355 : (command &optional output-buffer error-buffer)
3356 : "Like `shell-command' for Tramp files."
3357 14 : (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
3358 : ;; We cannot use `shell-file-name' and `shell-command-switch',
3359 : ;; they are variables of the local host.
3360 14 : (args (append
3361 14 : (cons
3362 14 : (tramp-get-method-parameter
3363 14 : (tramp-dissect-file-name default-directory)
3364 14 : 'tramp-remote-shell)
3365 14 : (tramp-get-method-parameter
3366 14 : (tramp-dissect-file-name default-directory)
3367 14 : 'tramp-remote-shell-args))
3368 14 : (list (substring command 0 asynchronous))))
3369 : current-buffer-p
3370 : (output-buffer
3371 14 : (cond
3372 14 : ((bufferp output-buffer) output-buffer)
3373 2 : ((stringp output-buffer) (get-buffer-create output-buffer))
3374 2 : (output-buffer
3375 2 : (setq current-buffer-p t)
3376 2 : (current-buffer))
3377 0 : (t (get-buffer-create
3378 0 : (if asynchronous
3379 : "*Async Shell Command*"
3380 14 : "*Shell Command Output*")))))
3381 : (error-buffer
3382 14 : (cond
3383 14 : ((bufferp error-buffer) error-buffer)
3384 14 : ((stringp error-buffer) (get-buffer-create error-buffer))))
3385 : (buffer
3386 14 : (if (and (not asynchronous) error-buffer)
3387 0 : (with-parsed-tramp-file-name default-directory nil
3388 0 : (list output-buffer (tramp-make-tramp-temp-file v)))
3389 14 : output-buffer))
3390 14 : (p (get-buffer-process output-buffer)))
3391 :
3392 : ;; Check whether there is another process running. Tramp does not
3393 : ;; support 2 (asynchronous) processes in parallel.
3394 14 : (when p
3395 0 : (if (yes-or-no-p "A command is running. Kill it? ")
3396 0 : (ignore-errors (kill-process p))
3397 14 : (tramp-compat-user-error p "Shell command in progress")))
3398 :
3399 14 : (if current-buffer-p
3400 2 : (progn
3401 2 : (barf-if-buffer-read-only)
3402 2 : (push-mark nil t))
3403 12 : (with-current-buffer output-buffer
3404 12 : (setq buffer-read-only nil)
3405 14 : (erase-buffer)))
3406 :
3407 14 : (if (and (not current-buffer-p) (integerp asynchronous))
3408 10 : (prog1
3409 : ;; Run the process.
3410 10 : (setq p (apply 'start-file-process "*Async Shell*" buffer args))
3411 : ;; Display output.
3412 10 : (with-current-buffer output-buffer
3413 10 : (display-buffer output-buffer '(nil (allow-no-window . t)))
3414 10 : (setq mode-line-process '(":%s"))
3415 10 : (shell-mode)
3416 10 : (set-process-sentinel p 'shell-command-sentinel)
3417 10 : (set-process-filter p 'comint-output-filter)))
3418 :
3419 4 : (prog1
3420 : ;; Run the process.
3421 4 : (apply 'process-file (car args) nil buffer nil (cdr args))
3422 : ;; Insert error messages if they were separated.
3423 4 : (when (listp buffer)
3424 0 : (with-current-buffer error-buffer
3425 0 : (insert-file-contents (cadr buffer)))
3426 4 : (delete-file (cadr buffer)))
3427 4 : (if current-buffer-p
3428 : ;; This is like exchange-point-and-mark, but doesn't
3429 : ;; activate the mark. It is cleaner to avoid activation,
3430 : ;; even though the command loop would deactivate the mark
3431 : ;; because we inserted text.
3432 2 : (goto-char (prog1 (mark t)
3433 2 : (set-marker (mark-marker) (point)
3434 2 : (current-buffer))))
3435 : ;; There's some output, display it.
3436 2 : (when (with-current-buffer output-buffer (> (point-max) (point-min)))
3437 14 : (display-message-or-buffer output-buffer)))))))
3438 :
3439 : (defun tramp-handle-substitute-in-file-name (filename)
3440 : "Like `substitute-in-file-name' for Tramp files.
3441 : \"//\" and \"/~\" substitute only in the local filename part."
3442 : ;; Check, whether the local part is a quoted file name.
3443 96 : (if (tramp-compat-file-name-quoted-p filename)
3444 10 : filename
3445 : ;; First, we must replace environment variables.
3446 86 : (setq filename (tramp-replace-environment-variables filename))
3447 86 : (with-parsed-tramp-file-name filename nil
3448 : ;; Ignore in LOCALNAME everything before "//" or "/~".
3449 86 : (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
3450 4 : (setq filename
3451 4 : (concat (file-remote-p filename)
3452 4 : (replace-match "\\1" nil nil localname)))
3453 : ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
3454 4 : (when (string-match "~$" filename)
3455 86 : (setq filename (concat filename "/"))))
3456 : ;; We do not want to replace environment variables, again.
3457 86 : (let (process-environment)
3458 96 : (tramp-run-real-handler 'substitute-in-file-name (list filename))))))
3459 :
3460 : (defun tramp-handle-set-visited-file-modtime (&optional time-list)
3461 : "Like `set-visited-file-modtime' for Tramp files."
3462 0 : (unless (buffer-file-name)
3463 0 : (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
3464 0 : (buffer-name)))
3465 0 : (unless time-list
3466 0 : (let ((remote-file-name-inhibit-cache t))
3467 : ;; '(-1 65535) means file doesn't exists yet.
3468 0 : (setq time-list
3469 0 : (or (tramp-compat-file-attribute-modification-time
3470 0 : (file-attributes (buffer-file-name)))
3471 0 : '(-1 65535)))))
3472 : ;; We use '(0 0) as a don't-know value.
3473 0 : (unless (equal time-list '(0 0))
3474 0 : (tramp-run-real-handler 'set-visited-file-modtime (list time-list))))
3475 :
3476 : (defun tramp-handle-verify-visited-file-modtime (&optional buf)
3477 : "Like `verify-visited-file-modtime' for Tramp files.
3478 : At the time `verify-visited-file-modtime' calls this function, we
3479 : already know that the buffer is visiting a file and that
3480 : `visited-file-modtime' does not return 0. Do not call this
3481 : function directly, unless those two cases are already taken care
3482 : of."
3483 0 : (with-current-buffer (or buf (current-buffer))
3484 0 : (let ((f (buffer-file-name)))
3485 : ;; There is no file visiting the buffer, or the buffer has no
3486 : ;; recorded last modification time, or there is no established
3487 : ;; connection.
3488 0 : (if (or (not f)
3489 0 : (eq (visited-file-modtime) 0)
3490 0 : (not (file-remote-p f nil 'connected)))
3491 : t
3492 0 : (with-parsed-tramp-file-name f nil
3493 0 : (let* ((remote-file-name-inhibit-cache t)
3494 0 : (attr (file-attributes f))
3495 0 : (modtime (tramp-compat-file-attribute-modification-time attr))
3496 0 : (mt (visited-file-modtime)))
3497 :
3498 0 : (cond
3499 : ;; File exists, and has a known modtime.
3500 0 : ((and attr (not (equal modtime '(0 0))))
3501 0 : (< (abs (tramp-time-diff
3502 0 : modtime
3503 : ;; For compatibility, deal with both the old
3504 : ;; (HIGH . LOW) and the new (HIGH LOW) return
3505 : ;; values of `visited-file-modtime'.
3506 0 : (if (atom (cdr mt))
3507 0 : (list (car mt) (cdr mt))
3508 0 : mt)))
3509 0 : 2))
3510 : ;; Modtime has the don't know value.
3511 0 : (attr t)
3512 : ;; If file does not exist, say it is not modified if and
3513 : ;; only if that agrees with the buffer's record.
3514 0 : (t (equal mt '(-1 65535))))))))))
3515 :
3516 : (defun tramp-handle-file-notify-add-watch (filename _flags _callback)
3517 : "Like `file-notify-add-watch' for Tramp files."
3518 : ;; This is the default handler. tramp-gvfs.el and tramp-sh.el have
3519 : ;; their own one.
3520 0 : (setq filename (expand-file-name filename))
3521 0 : (with-parsed-tramp-file-name filename nil
3522 0 : (tramp-error
3523 0 : v 'file-notify-error "File notification not supported for `%s'" filename)))
3524 :
3525 : (defun tramp-handle-file-notify-rm-watch (proc)
3526 : "Like `file-notify-rm-watch' for Tramp files."
3527 : ;; The descriptor must be a process object.
3528 0 : (unless (processp proc)
3529 0 : (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
3530 0 : (tramp-message proc 6 "Kill %S" proc)
3531 0 : (delete-process proc))
3532 :
3533 : (defun tramp-handle-file-notify-valid-p (proc)
3534 : "Like `file-notify-valid-p' for Tramp files."
3535 0 : (and (process-live-p proc)
3536 : ;; Sometimes, the process is still in status `run' when the
3537 : ;; file or directory to be watched is deleted already.
3538 0 : (with-current-buffer (process-buffer proc)
3539 0 : (file-exists-p
3540 0 : (concat (file-remote-p default-directory)
3541 0 : (process-get proc 'watch-name))))))
3542 :
3543 : ;;; Functions for establishing connection:
3544 :
3545 : ;; The following functions are actions to be taken when seeing certain
3546 : ;; prompts from the remote host. See the variable
3547 : ;; `tramp-actions-before-shell' for usage of these functions.
3548 :
3549 : (defun tramp-action-login (_proc vec)
3550 : "Send the login name."
3551 0 : (when (not (stringp tramp-current-user))
3552 0 : (setq tramp-current-user
3553 0 : (with-tramp-connection-property vec "login-as"
3554 0 : (save-window-excursion
3555 0 : (let ((enable-recursive-minibuffers t))
3556 0 : (pop-to-buffer (tramp-get-connection-buffer vec))
3557 0 : (read-string (match-string 0)))))))
3558 0 : (with-current-buffer (tramp-get-connection-buffer vec)
3559 0 : (tramp-message vec 6 "\n%s" (buffer-string)))
3560 0 : (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
3561 0 : (tramp-send-string vec (concat tramp-current-user tramp-local-end-of-line)))
3562 :
3563 : (defun tramp-action-password (proc vec)
3564 : "Query the user for a password."
3565 0 : (with-current-buffer (process-buffer proc)
3566 0 : (let ((enable-recursive-minibuffers t)
3567 : (case-fold-search t))
3568 : ;; Let's check whether a wrong password has been sent already.
3569 : ;; Sometimes, the process returns a new password request
3570 : ;; immediately after rejecting the previous (wrong) one.
3571 0 : (unless (tramp-get-connection-property vec "first-password-request" nil)
3572 0 : (tramp-clear-passwd vec))
3573 0 : (goto-char (point-min))
3574 0 : (tramp-check-for-regexp proc tramp-password-prompt-regexp)
3575 0 : (tramp-message vec 3 "Sending %s" (match-string 1))
3576 : ;; We don't call `tramp-send-string' in order to hide the
3577 : ;; password from the debug buffer.
3578 0 : (process-send-string
3579 0 : proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
3580 : ;; Hide password prompt.
3581 0 : (narrow-to-region (point-max) (point-max)))))
3582 :
3583 : (defun tramp-action-succeed (_proc _vec)
3584 : "Signal success in finding shell prompt."
3585 71 : (throw 'tramp-action 'ok))
3586 :
3587 : (defun tramp-action-permission-denied (proc _vec)
3588 : "Signal permission denied."
3589 0 : (kill-process proc)
3590 0 : (throw 'tramp-action 'permission-denied))
3591 :
3592 : (defun tramp-action-yesno (proc vec)
3593 : "Ask the user for confirmation using `yes-or-no-p'.
3594 : Send \"yes\" to remote process on confirmation, abort otherwise.
3595 : See also `tramp-action-yn'."
3596 0 : (save-window-excursion
3597 0 : (let ((enable-recursive-minibuffers t))
3598 0 : (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
3599 0 : (unless (yes-or-no-p (match-string 0))
3600 0 : (kill-process proc)
3601 0 : (throw 'tramp-action 'permission-denied))
3602 0 : (with-current-buffer (tramp-get-connection-buffer vec)
3603 0 : (tramp-message vec 6 "\n%s" (buffer-string)))
3604 0 : (tramp-send-string vec (concat "yes" tramp-local-end-of-line)))))
3605 :
3606 : (defun tramp-action-yn (proc vec)
3607 : "Ask the user for confirmation using `y-or-n-p'.
3608 : Send \"y\" to remote process on confirmation, abort otherwise.
3609 : See also `tramp-action-yesno'."
3610 0 : (save-window-excursion
3611 0 : (let ((enable-recursive-minibuffers t))
3612 0 : (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
3613 0 : (unless (y-or-n-p (match-string 0))
3614 0 : (kill-process proc)
3615 0 : (throw 'tramp-action 'permission-denied))
3616 0 : (with-current-buffer (tramp-get-connection-buffer vec)
3617 0 : (tramp-message vec 6 "\n%s" (buffer-string)))
3618 0 : (tramp-send-string vec (concat "y" tramp-local-end-of-line)))))
3619 :
3620 : (defun tramp-action-terminal (_proc vec)
3621 : "Tell the remote host which terminal type to use.
3622 : The terminal type can be configured with `tramp-terminal-type'."
3623 0 : (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
3624 0 : (with-current-buffer (tramp-get-connection-buffer vec)
3625 0 : (tramp-message vec 6 "\n%s" (buffer-string)))
3626 0 : (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line)))
3627 :
3628 : (defun tramp-action-process-alive (proc _vec)
3629 : "Check, whether a process has finished."
3630 0 : (unless (process-live-p proc)
3631 0 : (throw 'tramp-action 'process-died)))
3632 :
3633 : (defun tramp-action-out-of-band (proc vec)
3634 : "Check, whether an out-of-band copy has finished."
3635 : ;; There might be pending output for the exit status.
3636 0 : (tramp-accept-process-output proc 0.1)
3637 0 : (cond ((and (not (process-live-p proc))
3638 0 : (zerop (process-exit-status proc)))
3639 0 : (tramp-message vec 3 "Process has finished.")
3640 0 : (throw 'tramp-action 'ok))
3641 0 : ((or (and (memq (process-status proc) '(stop exit))
3642 0 : (not (zerop (process-exit-status proc))))
3643 0 : (memq (process-status proc) '(signal)))
3644 : ;; `scp' could have copied correctly, but set modes could have failed.
3645 : ;; This can be ignored.
3646 0 : (with-current-buffer (process-buffer proc)
3647 0 : (goto-char (point-min))
3648 0 : (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
3649 0 : (progn
3650 0 : (tramp-message vec 5 "'set mode' error ignored.")
3651 0 : (tramp-message vec 3 "Process has finished.")
3652 0 : (throw 'tramp-action 'ok))
3653 0 : (tramp-message vec 3 "Process has died.")
3654 0 : (throw 'tramp-action 'out-of-band-failed))))
3655 0 : (t nil)))
3656 :
3657 : ;;; Functions for processing the actions:
3658 :
3659 : (defun tramp-process-one-action (proc vec actions)
3660 : "Wait for output from the shell and perform one action."
3661 71 : (let ((case-fold-search t)
3662 : found todo item pattern action)
3663 71 : (while (not found)
3664 : ;; Reread output once all actions have been performed.
3665 : ;; Obviously, the output was not complete.
3666 71 : (tramp-accept-process-output proc 1)
3667 71 : (setq todo actions)
3668 355 : (while todo
3669 710 : (setq item (pop todo))
3670 355 : (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
3671 355 : (setq action (nth 1 item))
3672 355 : (tramp-message
3673 355 : vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
3674 355 : (when (tramp-check-for-regexp proc pattern)
3675 71 : (tramp-message vec 5 "Call `%s'" (symbol-name action))
3676 284 : (setq found (funcall action proc vec)))))
3677 0 : found))
3678 :
3679 : (defun tramp-process-actions (proc vec pos actions &optional timeout)
3680 : "Perform ACTIONS until success or TIMEOUT.
3681 : PROC and VEC indicate the remote connection to be used. POS, if
3682 : set, is the starting point of the region to be deleted in the
3683 : connection buffer."
3684 : ;; Enable `auth-source', unless "emacs -Q" has been called. We must
3685 : ;; use `tramp-current-*' variables in case we have several hops.
3686 71 : (tramp-set-connection-property
3687 71 : (make-tramp-file-name
3688 71 : :method tramp-current-method :user tramp-current-user
3689 71 : :domain tramp-current-domain :host tramp-current-host
3690 71 : :port tramp-current-port)
3691 71 : "first-password-request" tramp-cache-read-persistent-data)
3692 71 : (save-restriction
3693 71 : (with-tramp-progress-reporter
3694 142 : proc 3 "Waiting for prompts from remote shell"
3695 71 : (let (exit)
3696 71 : (if timeout
3697 71 : (with-timeout (timeout (setq exit 'timeout))
3698 142 : (while (not exit)
3699 71 : (setq exit
3700 71 : (catch 'tramp-action
3701 71 : (tramp-process-one-action proc vec actions)))))
3702 0 : (while (not exit)
3703 0 : (setq exit
3704 0 : (catch 'tramp-action
3705 71 : (tramp-process-one-action proc vec actions)))))
3706 71 : (with-current-buffer (tramp-get-connection-buffer vec)
3707 71 : (widen)
3708 71 : (tramp-message vec 6 "\n%s" (buffer-string)))
3709 71 : (unless (eq exit 'ok)
3710 0 : (tramp-clear-passwd vec)
3711 0 : (delete-process proc)
3712 0 : (tramp-error-with-buffer
3713 0 : (tramp-get-connection-buffer vec) vec 'file-error
3714 0 : (cond
3715 0 : ((eq exit 'permission-denied) "Permission denied")
3716 0 : ((eq exit 'out-of-band-failed)
3717 0 : (format-message
3718 : "Copy failed, see buffer `%s' for details"
3719 0 : (tramp-get-connection-buffer vec)))
3720 0 : ((eq exit 'process-died)
3721 0 : (substitute-command-keys
3722 0 : (concat
3723 : "Tramp failed to connect. If this happens repeatedly, try\n"
3724 0 : " `\\[tramp-cleanup-this-connection]'")))
3725 0 : ((eq exit 'timeout)
3726 0 : (format-message
3727 : "Timeout reached, see buffer `%s' for details"
3728 0 : (tramp-get-connection-buffer vec)))
3729 71 : (t "Login failed")))))
3730 71 : (when (numberp pos)
3731 71 : (with-current-buffer (tramp-get-connection-buffer vec)
3732 71 : (let (buffer-read-only) (delete-region pos (point))))))))
3733 :
3734 : ;;; Utility functions:
3735 :
3736 : (defun tramp-accept-process-output (proc timeout)
3737 : "Like `accept-process-output' for Tramp processes.
3738 : This is needed in order to hide `last-coding-system-used', which is set
3739 : for process communication also."
3740 14936 : (with-current-buffer (process-buffer proc)
3741 14936 : (let (buffer-read-only last-coding-system-used)
3742 : ;; Under Windows XP, `accept-process-output' doesn't return
3743 : ;; sometimes. So we add an additional timeout. JUST-THIS-ONE
3744 : ;; is set due to Bug#12145. It is an integer, in order to avoid
3745 : ;; running timers as well.
3746 14936 : (tramp-message
3747 14936 : proc 10 "%s %s %s\n%s"
3748 14936 : proc (process-status proc)
3749 14936 : (with-timeout (timeout)
3750 14936 : (accept-process-output proc timeout nil 0))
3751 14936 : (buffer-string)))))
3752 :
3753 : (defun tramp-check-for-regexp (proc regexp)
3754 : "Check, whether REGEXP is contained in process buffer of PROC.
3755 : Erase echoed commands if exists."
3756 26723 : (with-current-buffer (process-buffer proc)
3757 26723 : (goto-char (point-min))
3758 :
3759 : ;; Check whether we need to remove echo output.
3760 26723 : (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
3761 26723 : (re-search-forward tramp-echoed-echo-mark-regexp nil t))
3762 0 : (let ((begin (match-beginning 0)))
3763 0 : (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
3764 : ;; Discard echo from remote output.
3765 0 : (tramp-set-connection-property proc "check-remote-echo" nil)
3766 0 : (tramp-message proc 5 "echo-mark found")
3767 0 : (forward-line 1)
3768 0 : (delete-region begin (point))
3769 26723 : (goto-char (point-min)))))
3770 :
3771 26723 : (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
3772 : ;; Sometimes, the echo string is suppressed on the remote side.
3773 0 : (not (string-equal
3774 0 : (substring-no-properties
3775 0 : tramp-echo-mark-marker
3776 0 : 0 (min tramp-echo-mark-marker-length (1- (point-max))))
3777 0 : (buffer-substring-no-properties
3778 0 : (point-min)
3779 0 : (min (+ (point-min) tramp-echo-mark-marker-length)
3780 26723 : (point-max))))))
3781 : ;; No echo to be handled, now we can look for the regexp.
3782 : ;; Sometimes, lines are much to long, and we run into a "Stack
3783 : ;; overflow in regexp matcher". For example, //DIRED// lines of
3784 : ;; directory listings with some thousand files. Therefore, we
3785 : ;; look from the end.
3786 26723 : (goto-char (point-max))
3787 26723 : (ignore-errors (re-search-backward regexp nil t)))))
3788 :
3789 : (defun tramp-wait-for-regexp (proc timeout regexp)
3790 : "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
3791 : Expects the output of PROC to be sent to the current buffer. Returns
3792 : the string that matched, or nil. Waits indefinitely if TIMEOUT is
3793 : nil."
3794 11503 : (with-current-buffer (process-buffer proc)
3795 11503 : (let ((found (tramp-check-for-regexp proc regexp)))
3796 11503 : (cond (timeout
3797 71 : (with-timeout (timeout)
3798 142 : (while (not found)
3799 71 : (tramp-accept-process-output proc 1)
3800 71 : (unless (process-live-p proc)
3801 0 : (tramp-error-with-buffer
3802 71 : nil proc 'file-error "Process has died"))
3803 71 : (setq found (tramp-check-for-regexp proc regexp)))))
3804 : (t
3805 26226 : (while (not found)
3806 14794 : (tramp-accept-process-output proc 1)
3807 14794 : (unless (process-live-p proc)
3808 0 : (tramp-error-with-buffer
3809 14794 : nil proc 'file-error "Process has died"))
3810 14794 : (setq found (tramp-check-for-regexp proc regexp)))))
3811 11503 : (tramp-message proc 6 "\n%s" (buffer-string))
3812 11503 : (when (not found)
3813 0 : (if timeout
3814 0 : (tramp-error
3815 0 : proc 'file-error "[[Regexp `%s' not found in %d secs]]"
3816 0 : regexp timeout)
3817 11503 : (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
3818 11503 : found)))
3819 :
3820 : ;; It seems that Tru64 Unix does not like it if long strings are sent
3821 : ;; to it in one go. (This happens when sending the Perl
3822 : ;; `file-attributes' implementation, for instance.) Therefore, we
3823 : ;; have this function which sends the string in chunks.
3824 : (defun tramp-send-string (vec string)
3825 : "Send the STRING via connection VEC.
3826 :
3827 : The STRING is expected to use Unix line-endings, but the lines sent to
3828 : the remote host use line-endings as defined in the variable
3829 : `tramp-rsh-end-of-line'. The communication buffer is erased before sending."
3830 11530 : (let* ((p (tramp-get-connection-process vec))
3831 11530 : (chunksize (tramp-get-connection-property p "chunksize" nil)))
3832 11530 : (unless p
3833 0 : (tramp-error
3834 11530 : vec 'file-error "Can't send string to remote host -- not logged in"))
3835 11530 : (tramp-set-connection-property p "last-cmd-time" (current-time))
3836 11530 : (tramp-message vec 10 "%s" string)
3837 11530 : (with-current-buffer (tramp-get-connection-buffer vec)
3838 : ;; Clean up the buffer. We cannot call `erase-buffer' because
3839 : ;; narrowing might be in effect.
3840 11530 : (let (buffer-read-only) (delete-region (point-min) (point-max)))
3841 : ;; Replace "\n" by `tramp-rsh-end-of-line'.
3842 11530 : (setq string
3843 11530 : (mapconcat
3844 11530 : 'identity (split-string string "\n") tramp-rsh-end-of-line))
3845 11530 : (unless (or (string= string "")
3846 11530 : (string-equal (substring string -1) tramp-rsh-end-of-line))
3847 11530 : (setq string (concat string tramp-rsh-end-of-line)))
3848 : ;; Send the string.
3849 11530 : (if (and chunksize (not (zerop chunksize)))
3850 0 : (let ((pos 0)
3851 0 : (end (length string)))
3852 0 : (while (< pos end)
3853 0 : (tramp-message
3854 0 : vec 10 "Sending chunk from %s to %s"
3855 0 : pos (min (+ pos chunksize) end))
3856 0 : (process-send-string
3857 0 : p (substring string pos (min (+ pos chunksize) end)))
3858 0 : (setq pos (+ pos chunksize))))
3859 11530 : (process-send-string p string)))))
3860 :
3861 : (defun tramp-get-inode (vec)
3862 : "Returns the virtual inode number.
3863 : If it doesn't exist, generate a new one."
3864 0 : (with-tramp-file-property vec (tramp-file-name-localname vec) "inode"
3865 0 : (setq tramp-inodes (1+ tramp-inodes))))
3866 :
3867 : (defun tramp-get-device (vec)
3868 : "Returns the virtual device number.
3869 : If it doesn't exist, generate a new one."
3870 1409 : (with-tramp-connection-property (tramp-get-connection-process vec) "device"
3871 1373 : (cons -1 (setq tramp-devices (1+ tramp-devices)))))
3872 :
3873 : (defun tramp-equal-remote (file1 file2)
3874 : "Check, whether the remote parts of FILE1 and FILE2 are identical.
3875 : The check depends on method, user and host name of the files. If
3876 : one of the components is missing, the default values are used.
3877 : The local file name parts of FILE1 and FILE2 are not taken into
3878 : account.
3879 :
3880 : Example:
3881 :
3882 : (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
3883 :
3884 : would yield t. On the other hand, the following check results in nil:
3885 :
3886 : (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
3887 22 : (and (tramp-tramp-file-p file1)
3888 22 : (tramp-tramp-file-p file2)
3889 22 : (string-equal (file-remote-p file1) (file-remote-p file2))))
3890 :
3891 : ;;;###tramp-autoload
3892 : (defun tramp-mode-string-to-int (mode-string)
3893 : "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
3894 466 : (let* (case-fold-search
3895 466 : (mode-chars (string-to-vector mode-string))
3896 466 : (owner-read (aref mode-chars 1))
3897 466 : (owner-write (aref mode-chars 2))
3898 466 : (owner-execute-or-setid (aref mode-chars 3))
3899 466 : (group-read (aref mode-chars 4))
3900 466 : (group-write (aref mode-chars 5))
3901 466 : (group-execute-or-setid (aref mode-chars 6))
3902 466 : (other-read (aref mode-chars 7))
3903 466 : (other-write (aref mode-chars 8))
3904 466 : (other-execute-or-sticky (aref mode-chars 9)))
3905 466 : (save-match-data
3906 466 : (logior
3907 466 : (cond
3908 466 : ((char-equal owner-read ?r) (string-to-number "00400" 8))
3909 0 : ((char-equal owner-read ?-) 0)
3910 466 : (t (error "Second char `%c' must be one of `r-'" owner-read)))
3911 466 : (cond
3912 466 : ((char-equal owner-write ?w) (string-to-number "00200" 8))
3913 2 : ((char-equal owner-write ?-) 0)
3914 466 : (t (error "Third char `%c' must be one of `w-'" owner-write)))
3915 466 : (cond
3916 466 : ((char-equal owner-execute-or-setid ?x) (string-to-number "00100" 8))
3917 454 : ((char-equal owner-execute-or-setid ?S) (string-to-number "04000" 8))
3918 454 : ((char-equal owner-execute-or-setid ?s) (string-to-number "04100" 8))
3919 454 : ((char-equal owner-execute-or-setid ?-) 0)
3920 0 : (t (error "Fourth char `%c' must be one of `xsS-'"
3921 466 : owner-execute-or-setid)))
3922 466 : (cond
3923 466 : ((char-equal group-read ?r) (string-to-number "00040" 8))
3924 2 : ((char-equal group-read ?-) 0)
3925 466 : (t (error "Fifth char `%c' must be one of `r-'" group-read)))
3926 466 : (cond
3927 466 : ((char-equal group-write ?w) (string-to-number "00020" 8))
3928 464 : ((char-equal group-write ?-) 0)
3929 466 : (t (error "Sixth char `%c' must be one of `w-'" group-write)))
3930 466 : (cond
3931 466 : ((char-equal group-execute-or-setid ?x) (string-to-number "00010" 8))
3932 456 : ((char-equal group-execute-or-setid ?S) (string-to-number "02000" 8))
3933 456 : ((char-equal group-execute-or-setid ?s) (string-to-number "02010" 8))
3934 456 : ((char-equal group-execute-or-setid ?-) 0)
3935 0 : (t (error "Seventh char `%c' must be one of `xsS-'"
3936 466 : group-execute-or-setid)))
3937 466 : (cond
3938 466 : ((char-equal other-read ?r) (string-to-number "00004" 8))
3939 2 : ((char-equal other-read ?-) 0)
3940 466 : (t (error "Eighth char `%c' must be one of `r-'" other-read)))
3941 466 : (cond
3942 466 : ((char-equal other-write ?w) (string-to-number "00002" 8))
3943 464 : ((char-equal other-write ?-) 0)
3944 466 : (t (error "Ninth char `%c' must be one of `w-'" other-write)))
3945 466 : (cond
3946 466 : ((char-equal other-execute-or-sticky ?x) (string-to-number "00001" 8))
3947 456 : ((char-equal other-execute-or-sticky ?T) (string-to-number "01000" 8))
3948 456 : ((char-equal other-execute-or-sticky ?t) (string-to-number "01001" 8))
3949 456 : ((char-equal other-execute-or-sticky ?-) 0)
3950 0 : (t (error "Tenth char `%c' must be one of `xtT-'"
3951 466 : other-execute-or-sticky)))))))
3952 :
3953 : (defconst tramp-file-mode-type-map
3954 : '((0 . "-") ; Normal file (SVID-v2 and XPG2)
3955 : (1 . "p") ; fifo
3956 : (2 . "c") ; character device
3957 : (3 . "m") ; multiplexed character device (v7)
3958 : (4 . "d") ; directory
3959 : (5 . "?") ; Named special file (XENIX)
3960 : (6 . "b") ; block device
3961 : (7 . "?") ; multiplexed block device (v7)
3962 : (8 . "-") ; regular file
3963 : (9 . "n") ; network special file (HP-UX)
3964 : (10 . "l") ; symlink
3965 : (11 . "?") ; ACL shadow inode (Solaris, not userspace)
3966 : (12 . "s") ; socket
3967 : (13 . "D") ; door special (Solaris)
3968 : (14 . "w")) ; whiteout (BSD)
3969 : "A list of file types returned from the `stat' system call.
3970 : This is used to map a mode number to a permission string.")
3971 :
3972 : ;;;###tramp-autoload
3973 : (defun tramp-file-mode-from-int (mode)
3974 : "Turn an integer representing a file mode into an ls(1)-like string."
3975 237 : (let ((type (cdr
3976 237 : (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
3977 237 : (user (logand (lsh mode -6) 7))
3978 237 : (group (logand (lsh mode -3) 7))
3979 237 : (other (logand (lsh mode -0) 7))
3980 237 : (suid (> (logand (lsh mode -9) 4) 0))
3981 237 : (sgid (> (logand (lsh mode -9) 2) 0))
3982 237 : (sticky (> (logand (lsh mode -9) 1) 0)))
3983 237 : (setq user (tramp-file-mode-permissions user suid "s"))
3984 237 : (setq group (tramp-file-mode-permissions group sgid "s"))
3985 237 : (setq other (tramp-file-mode-permissions other sticky "t"))
3986 237 : (concat type user group other)))
3987 :
3988 : (defun tramp-file-mode-permissions (perm suid suid-text)
3989 : "Convert a permission bitset into a string.
3990 : This is used internally by `tramp-file-mode-from-int'."
3991 711 : (let ((r (> (logand perm 4) 0))
3992 711 : (w (> (logand perm 2) 0))
3993 711 : (x (> (logand perm 1) 0)))
3994 711 : (concat (or (and r "r") "-")
3995 711 : (or (and w "w") "-")
3996 711 : (or (and suid x suid-text) ; suid, execute
3997 711 : (and suid (upcase suid-text)) ; suid, !execute
3998 711 : (and x "x") "-")))) ; !suid
3999 :
4000 : ;;;###tramp-autoload
4001 : (defun tramp-get-local-uid (id-format)
4002 : "The uid of the local user, in ID-FORMAT.
4003 : ID-FORMAT valid values are `string' and `integer'."
4004 270 : (if (equal id-format 'integer) (user-uid) (user-login-name)))
4005 :
4006 : ;;;###tramp-autoload
4007 : (defun tramp-get-local-gid (id-format)
4008 : "The gid of the local user, in ID-FORMAT.
4009 : ID-FORMAT valid values are `string' and `integer'."
4010 : ;; `group-gid' has been introduced with Emacs 24.4.
4011 270 : (if (and (fboundp 'group-gid) (equal id-format 'integer))
4012 270 : (tramp-compat-funcall 'group-gid)
4013 270 : (tramp-compat-file-attribute-group-id (file-attributes "~/" id-format))))
4014 :
4015 : (defun tramp-get-local-locale (&optional vec)
4016 : "Determine locale, supporting UTF8 if possible.
4017 : VEC is used for tracing."
4018 : ;; We use key nil for local connection properties.
4019 71 : (with-tramp-connection-property nil "locale"
4020 3 : (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
4021 : locale)
4022 3 : (with-temp-buffer
4023 3 : (unless (or (memq system-type '(windows-nt))
4024 3 : (not (zerop (tramp-call-process
4025 3 : nil "locale" nil t nil "-a"))))
4026 6 : (while candidates
4027 3 : (goto-char (point-min))
4028 3 : (if (string-match (format "^%s\r?$" (regexp-quote (car candidates)))
4029 3 : (buffer-string))
4030 3 : (setq locale (car candidates)
4031 3 : candidates nil)
4032 3 : (setq candidates (cdr candidates))))))
4033 : ;; Return value.
4034 3 : (when vec (tramp-message vec 7 "locale %s" (or locale "C")))
4035 71 : (or locale "C"))))
4036 :
4037 : ;;;###tramp-autoload
4038 : (defun tramp-check-cached-permissions (vec access)
4039 : "Check `file-attributes' caches for VEC.
4040 : Return t if according to the cache access type ACCESS is known to
4041 : be granted."
4042 180 : (let ((result nil)
4043 180 : (offset (cond
4044 180 : ((eq ?r access) 1)
4045 134 : ((eq ?w access) 2)
4046 180 : ((eq ?x access) 3))))
4047 180 : (dolist (suffix '("string" "integer") result)
4048 360 : (setq
4049 : result
4050 360 : (or
4051 360 : result
4052 341 : (let ((file-attr
4053 341 : (or
4054 341 : (tramp-get-file-property
4055 341 : vec (tramp-file-name-localname vec)
4056 341 : (concat "file-attributes-" suffix) nil)
4057 326 : (file-attributes
4058 326 : (tramp-make-tramp-file-name
4059 326 : (tramp-file-name-method vec)
4060 326 : (tramp-file-name-user vec)
4061 326 : (tramp-file-name-domain vec)
4062 326 : (tramp-file-name-host vec)
4063 326 : (tramp-file-name-port vec)
4064 326 : (tramp-file-name-localname vec)
4065 326 : (tramp-file-name-hop vec))
4066 341 : (intern suffix))))
4067 : (remote-uid
4068 341 : (tramp-get-connection-property
4069 341 : vec (concat "uid-" suffix) nil))
4070 : (remote-gid
4071 341 : (tramp-get-connection-property
4072 341 : vec (concat "gid-" suffix) nil))
4073 : (unknown-id
4074 341 : (if (string-equal suffix "string")
4075 341 : tramp-unknown-id-string tramp-unknown-id-integer)))
4076 341 : (and
4077 341 : file-attr
4078 275 : (or
4079 : ;; Not a symlink.
4080 275 : (eq t (tramp-compat-file-attribute-type file-attr))
4081 275 : (null (tramp-compat-file-attribute-type file-attr)))
4082 275 : (or
4083 : ;; World accessible.
4084 275 : (eq access
4085 275 : (aref (tramp-compat-file-attribute-modes file-attr)
4086 275 : (+ offset 6)))
4087 : ;; User accessible and owned by user.
4088 256 : (and
4089 256 : (eq access
4090 256 : (aref (tramp-compat-file-attribute-modes file-attr) offset))
4091 248 : (or (equal remote-uid
4092 248 : (tramp-compat-file-attribute-user-id file-attr))
4093 127 : (equal unknown-id
4094 256 : (tramp-compat-file-attribute-user-id file-attr))))
4095 : ;; Group accessible and owned by user's principal group.
4096 135 : (and
4097 135 : (eq access
4098 135 : (aref (tramp-compat-file-attribute-modes file-attr)
4099 135 : (+ offset 3)))
4100 0 : (or (equal remote-gid
4101 0 : (tramp-compat-file-attribute-group-id file-attr))
4102 0 : (equal unknown-id
4103 0 : (tramp-compat-file-attribute-group-id
4104 360 : file-attr))))))))))))
4105 :
4106 : ;;;###tramp-autoload
4107 : (defun tramp-local-host-p (vec)
4108 : "Return t if this points to the local host, nil otherwise."
4109 1512 : (let ((host (tramp-file-name-host vec))
4110 1512 : (port (tramp-file-name-port vec)))
4111 1512 : (and
4112 1512 : (stringp host)
4113 1512 : (string-match tramp-local-host-regexp host)
4114 : ;; A port is an indication for an ssh tunnel or alike.
4115 1512 : (null port)
4116 : ;; The method shall be applied to one of the shell file name
4117 : ;; handlers. `tramp-local-host-p' is also called for "smb" and
4118 : ;; alike, where it must fail.
4119 1512 : (tramp-get-method-parameter vec 'tramp-login-program)
4120 : ;; The local temp directory must be writable for the other user.
4121 1512 : (file-writable-p
4122 1512 : (tramp-make-tramp-file-name
4123 1512 : (tramp-file-name-method vec)
4124 1512 : (tramp-file-name-user vec)
4125 1512 : (tramp-file-name-domain vec)
4126 1512 : host port
4127 1512 : (tramp-compat-temporary-file-directory)))
4128 : ;; On some systems, chown runs only for root.
4129 1512 : (or (zerop (user-uid))
4130 : ;; This is defined in tramp-sh.el. Let's assume this is
4131 : ;; loaded already.
4132 1512 : (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
4133 :
4134 : (defun tramp-get-remote-tmpdir (vec)
4135 : "Return directory for temporary files on the remote host identified by VEC."
4136 13 : (with-tramp-connection-property vec "tmpdir"
4137 4 : (let ((dir (tramp-make-tramp-file-name
4138 4 : (tramp-file-name-method vec)
4139 4 : (tramp-file-name-user vec)
4140 4 : (tramp-file-name-domain vec)
4141 4 : (tramp-file-name-host vec)
4142 4 : (tramp-file-name-port vec)
4143 4 : (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")
4144 4 : (tramp-file-name-hop vec))))
4145 4 : (or (and (file-directory-p dir) (file-writable-p dir)
4146 4 : (file-remote-p dir 'localname))
4147 4 : (tramp-error vec 'file-error "Directory %s not accessible" dir))
4148 9 : dir)))
4149 :
4150 : ;;;###tramp-autoload
4151 : (defun tramp-make-tramp-temp-file (vec)
4152 : "Create a temporary file on the remote host identified by VEC.
4153 : Return the local name of the temporary file."
4154 2 : (let ((prefix (expand-file-name
4155 2 : tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
4156 : result)
4157 4 : (while (not result)
4158 : ;; `make-temp-file' would be the natural choice for
4159 : ;; implementation. But it calls `write-region' internally,
4160 : ;; which also needs a temporary file - we would end in an
4161 : ;; infinite loop.
4162 2 : (setq result (make-temp-name prefix))
4163 2 : (if (file-exists-p result)
4164 0 : (setq result nil)
4165 : ;; This creates the file by side effect.
4166 2 : (set-file-times result)
4167 2 : (set-file-modes result (string-to-number "0700" 8))))
4168 :
4169 : ;; Return the local part.
4170 2 : (with-parsed-tramp-file-name result nil localname)))
4171 :
4172 : (defun tramp-delete-temp-file-function ()
4173 : "Remove temporary files related to current buffer."
4174 1805 : (when (stringp tramp-temp-buffer-file-name)
4175 1805 : (ignore-errors (delete-file tramp-temp-buffer-file-name))))
4176 :
4177 : (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
4178 : (add-hook 'tramp-unload-hook
4179 : (lambda ()
4180 : (remove-hook 'kill-buffer-hook
4181 : 'tramp-delete-temp-file-function)))
4182 :
4183 : (defun tramp-handle-make-auto-save-file-name ()
4184 : "Like `make-auto-save-file-name' for Tramp files.
4185 : Returns a file name in `tramp-auto-save-directory' for autosaving
4186 : this file, if that variable is non-nil."
4187 4 : (when (stringp tramp-auto-save-directory)
4188 0 : (setq tramp-auto-save-directory
4189 4 : (expand-file-name tramp-auto-save-directory)))
4190 : ;; Create directory.
4191 4 : (unless (or (null tramp-auto-save-directory)
4192 4 : (file-exists-p tramp-auto-save-directory))
4193 4 : (make-directory tramp-auto-save-directory t))
4194 :
4195 4 : (let ((system-type
4196 4 : (if (and (stringp tramp-auto-save-directory)
4197 4 : (file-remote-p tramp-auto-save-directory))
4198 : 'not-windows
4199 4 : system-type))
4200 : (auto-save-file-name-transforms
4201 4 : (if (null tramp-auto-save-directory)
4202 4 : auto-save-file-name-transforms))
4203 : (buffer-file-name
4204 4 : (if (null tramp-auto-save-directory)
4205 4 : buffer-file-name
4206 0 : (expand-file-name
4207 0 : (tramp-subst-strs-in-string
4208 : '(("_" . "|")
4209 : ("/" . "_a")
4210 : (":" . "_b")
4211 : ("|" . "__")
4212 : ("[" . "_l")
4213 : ("]" . "_r"))
4214 0 : (tramp-compat-file-name-unquote (buffer-file-name)))
4215 4 : tramp-auto-save-directory))))
4216 : ;; Run plain `make-auto-save-file-name'.
4217 4 : (tramp-run-real-handler 'make-auto-save-file-name nil)))
4218 :
4219 : (defun tramp-subst-strs-in-string (alist string)
4220 : "Replace all occurrences of the string FROM with TO in STRING.
4221 : ALIST is of the form ((FROM . TO) ...)."
4222 0 : (save-match-data
4223 0 : (while alist
4224 0 : (let* ((pr (car alist))
4225 0 : (from (car pr))
4226 0 : (to (cdr pr)))
4227 0 : (while (string-match (regexp-quote from) string)
4228 0 : (setq string (replace-match to t t string)))
4229 0 : (setq alist (cdr alist))))
4230 0 : string))
4231 :
4232 : (defun tramp-handle-temporary-file-directory ()
4233 : "Like `temporary-file-directory' for Tramp files."
4234 4 : (catch 'result
4235 4 : (dolist (dir `(,(ignore-errors
4236 4 : (tramp-get-remote-tmpdir
4237 4 : (tramp-dissect-file-name default-directory)))
4238 4 : ,default-directory))
4239 4 : (when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
4240 4 : (throw 'result (expand-file-name dir))))))
4241 :
4242 : (defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
4243 : "Like `make-nearby-temp-file' for Tramp files."
4244 0 : (let ((temporary-file-directory
4245 0 : (tramp-compat-temporary-file-directory-function)))
4246 0 : (make-temp-file prefix dir-flag suffix)))
4247 :
4248 : ;;; Compatibility functions section:
4249 :
4250 : (defun tramp-call-process
4251 : (vec program &optional infile destination display &rest args)
4252 : "Calls `call-process' on the local host.
4253 : It always returns a return code. The Lisp error raised when
4254 : PROGRAM is nil is trapped also, returning 1. Furthermore, traces
4255 : are written with verbosity of 6."
4256 274 : (let ((default-directory (tramp-compat-temporary-file-directory))
4257 274 : (v (or vec
4258 274 : (make-tramp-file-name
4259 274 : :method tramp-current-method :user tramp-current-user
4260 274 : :domain tramp-current-domain :host tramp-current-host
4261 274 : :port tramp-current-port)))
4262 274 : (destination (if (eq destination t) (current-buffer) destination))
4263 : output error result)
4264 274 : (tramp-message
4265 274 : v 6 "`%s %s' %s %s"
4266 274 : program (mapconcat 'identity args " ") infile destination)
4267 274 : (condition-case err
4268 274 : (with-temp-buffer
4269 274 : (setq result
4270 274 : (apply
4271 274 : 'call-process program infile (or destination t) display args))
4272 : ;; `result' could also be an error string.
4273 274 : (when (stringp result)
4274 0 : (setq error result
4275 274 : result 1))
4276 274 : (with-current-buffer
4277 274 : (if (bufferp destination) destination (current-buffer))
4278 274 : (setq output (buffer-string))))
4279 : (error
4280 0 : (setq error (error-message-string err)
4281 274 : result 1)))
4282 274 : (if (zerop (length error))
4283 274 : (tramp-message v 6 "%d\n%s" result output)
4284 274 : (tramp-message v 6 "%d\n%s\n%s" result output error))
4285 274 : result))
4286 :
4287 : (defun tramp-call-process-region
4288 : (vec start end program &optional delete buffer display &rest args)
4289 : "Calls `call-process-region' on the local host.
4290 : It always returns a return code. The Lisp error raised when
4291 : PROGRAM is nil is trapped also, returning 1. Furthermore, traces
4292 : are written with verbosity of 6."
4293 2 : (let ((default-directory (tramp-compat-temporary-file-directory))
4294 2 : (v (or vec
4295 0 : (make-tramp-file-name
4296 0 : :method tramp-current-method :user tramp-current-user
4297 0 : :domain tramp-current-domain :host tramp-current-host
4298 2 : :port tramp-current-port)))
4299 2 : (buffer (if (eq buffer t) (current-buffer) buffer))
4300 : result)
4301 2 : (tramp-message
4302 2 : v 6 "`%s %s' %s %s %s %s"
4303 2 : program (mapconcat 'identity args " ") start end delete buffer)
4304 2 : (condition-case err
4305 2 : (progn
4306 2 : (setq result
4307 2 : (apply
4308 : 'call-process-region
4309 2 : start end program delete buffer display args))
4310 : ;; `result' could also be an error string.
4311 2 : (when (stringp result)
4312 2 : (signal 'file-error (list result)))
4313 2 : (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
4314 2 : (if (zerop result)
4315 2 : (tramp-message v 6 "%d" result)
4316 2 : (tramp-message v 6 "%d\n%s" result (buffer-string)))))
4317 : (error
4318 0 : (setq result 1)
4319 2 : (tramp-message v 6 "%d\n%s" result (error-message-string err))))
4320 2 : result))
4321 :
4322 : ;;;###tramp-autoload
4323 : (defun tramp-read-passwd (proc &optional prompt)
4324 : "Read a password from user (compat function).
4325 : Consults the auth-source package.
4326 : Invokes `password-read' if available, `read-passwd' else."
4327 0 : (let* ((case-fold-search t)
4328 0 : (key (tramp-make-tramp-file-name
4329 0 : tramp-current-method tramp-current-user tramp-current-domain
4330 0 : tramp-current-host tramp-current-port ""))
4331 : (pw-prompt
4332 0 : (or prompt
4333 0 : (with-current-buffer (process-buffer proc)
4334 0 : (tramp-check-for-regexp proc tramp-password-prompt-regexp)
4335 0 : (format "%s for %s " (capitalize (match-string 1)) key))))
4336 : ;; We suspend the timers while reading the password.
4337 0 : (stimers (with-timeout-suspend))
4338 : auth-info auth-passwd)
4339 :
4340 0 : (unwind-protect
4341 0 : (with-parsed-tramp-file-name key nil
4342 0 : (prog1
4343 0 : (or
4344 : ;; See if auth-sources contains something useful.
4345 0 : (ignore-errors
4346 0 : (and (tramp-get-connection-property
4347 0 : v "first-password-request" nil)
4348 : ;; Try with Tramp's current method.
4349 0 : (setq auth-info
4350 0 : (auth-source-search
4351 : :max 1
4352 0 : (and tramp-current-user :user)
4353 0 : (if tramp-current-domain
4354 0 : (format
4355 : "%s%s%s"
4356 0 : tramp-current-user tramp-prefix-domain-format
4357 0 : tramp-current-domain)
4358 0 : tramp-current-user)
4359 : :host
4360 0 : (if tramp-current-port
4361 0 : (format
4362 : "%s%s%s"
4363 0 : tramp-current-host tramp-prefix-port-format
4364 0 : tramp-current-port)
4365 0 : tramp-current-host)
4366 0 : :port tramp-current-method
4367 : :require
4368 0 : (cons
4369 0 : :secret (and tramp-current-user '(:user))))
4370 0 : auth-passwd (plist-get
4371 0 : (nth 0 auth-info) :secret)
4372 0 : auth-passwd (if (functionp auth-passwd)
4373 0 : (funcall auth-passwd)
4374 0 : auth-passwd))))
4375 : ;; Try the password cache.
4376 0 : (let ((password (password-read pw-prompt key)))
4377 0 : (password-cache-add key password)
4378 0 : password)
4379 : ;; Else, get the password interactively.
4380 0 : (read-passwd pw-prompt))
4381 0 : (tramp-set-connection-property v "first-password-request" nil)))
4382 : ;; Reenable the timers.
4383 0 : (with-timeout-unsuspend stimers))))
4384 :
4385 : ;;;###tramp-autoload
4386 : (defun tramp-clear-passwd (vec)
4387 : "Clear password cache for connection related to VEC."
4388 2 : (let ((method (tramp-file-name-method vec))
4389 2 : (user (tramp-file-name-user vec))
4390 2 : (domain (tramp-file-name-domain vec))
4391 2 : (user-domain (tramp-file-name-user-domain vec))
4392 2 : (host (tramp-file-name-host vec))
4393 2 : (port (tramp-file-name-port vec))
4394 2 : (host-port (tramp-file-name-host-port vec))
4395 2 : (hop (tramp-file-name-hop vec)))
4396 2 : (when hop
4397 : ;; Clear also the passwords of the hops.
4398 0 : (tramp-clear-passwd
4399 0 : (tramp-dissect-file-name
4400 0 : (concat
4401 0 : (tramp-prefix-format)
4402 0 : (replace-regexp-in-string
4403 0 : (concat tramp-postfix-hop-regexp "$")
4404 2 : (tramp-postfix-host-format) hop)))))
4405 2 : (auth-source-forget
4406 2 : `(:max 1 ,(and user-domain :user) ,user-domain
4407 2 : :host ,host-port :port ,method))
4408 2 : (password-cache-remove
4409 2 : (tramp-make-tramp-file-name method user domain host port ""))))
4410 :
4411 : ;; Snarfed code from time-date.el.
4412 :
4413 : (defconst tramp-half-a-year '(241 17024)
4414 : "Evaluated by \"(days-to-time 183)\".")
4415 :
4416 : ;;;###tramp-autoload
4417 : (defun tramp-time-diff (t1 t2)
4418 : "Return the difference between the two times, in seconds.
4419 : T1 and T2 are time values (as returned by `current-time' for example)."
4420 : ;; Starting with Emacs 25.1, we could change this to use `time-subtract'.
4421 17993 : (float-time (tramp-compat-funcall 'subtract-time t1 t2)))
4422 :
4423 : (defun tramp-unquote-shell-quote-argument (s)
4424 : "Remove quotation prefix \"/:\" from string S, and quote it then for shell."
4425 11924 : (shell-quote-argument (tramp-compat-file-name-unquote s)))
4426 :
4427 : ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
4428 : ;; does not deal well with newline characters. Newline is replaced by
4429 : ;; backslash newline. But if, say, the string `a backslash newline b'
4430 : ;; is passed to a shell, the shell will expand this into "ab",
4431 : ;; completely omitting the newline. This is not what was intended.
4432 : ;; It does not appear to be possible to make the function
4433 : ;; `shell-quote-argument' work with newlines without making it
4434 : ;; dependent on the shell used. But within this package, we know that
4435 : ;; we will always use a Bourne-like shell, so we use an approach which
4436 : ;; groks newlines.
4437 : ;;
4438 : ;; The approach is simple: we call `shell-quote-argument', then
4439 : ;; massage the newline part of the result.
4440 : ;;
4441 : ;; This function should produce a string which is grokked by a Unix
4442 : ;; shell, even if the Emacs is running on Windows. Since this is the
4443 : ;; kludges section, we bind `system-type' in such a way that
4444 : ;; `shell-quote-argument' behaves as if on Unix.
4445 : ;;
4446 : ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
4447 : ;; function to work with Bourne-like shells.
4448 : ;;;###tramp-autoload
4449 : (defun tramp-shell-quote-argument (s)
4450 : "Similar to `shell-quote-argument', but groks newlines.
4451 : Only works for Bourne-like shells."
4452 11924 : (let ((system-type 'not-windows))
4453 11924 : (save-match-data
4454 11924 : (let ((result (tramp-unquote-shell-quote-argument s))
4455 11924 : (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
4456 11924 : (when (and (>= (length result) 2)
4457 11924 : (string= (substring result 0 2) "\\~"))
4458 11924 : (setq result (substring result 1)))
4459 11924 : (while (string-match nl result)
4460 0 : (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
4461 11924 : t t result)))
4462 11924 : result))))
4463 :
4464 : ;;; Integration of eshell.el:
4465 :
4466 : ;; eshell.el keeps the path in `eshell-path-env'. We must change it
4467 : ;; when `default-directory' points to another host.
4468 : (defun tramp-eshell-directory-change ()
4469 : "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
4470 0 : (setq eshell-path-env
4471 0 : (if (tramp-tramp-file-p default-directory)
4472 0 : (with-parsed-tramp-file-name default-directory nil
4473 0 : (mapconcat
4474 : 'identity
4475 0 : (or
4476 : ;; When `tramp-own-remote-path' is in `tramp-remote-path',
4477 : ;; the remote path is only set in the session cache.
4478 0 : (tramp-get-connection-property
4479 0 : (tramp-get-connection-process v) "remote-path" nil)
4480 0 : (tramp-get-connection-property v "remote-path" nil))
4481 0 : ":"))
4482 0 : (getenv "PATH"))))
4483 :
4484 : (eval-after-load "esh-util"
4485 : '(progn
4486 : (add-hook 'eshell-mode-hook
4487 : 'tramp-eshell-directory-change)
4488 : (add-hook 'eshell-directory-change-hook
4489 : 'tramp-eshell-directory-change)
4490 : (add-hook 'tramp-unload-hook
4491 : (lambda ()
4492 : (remove-hook 'eshell-mode-hook
4493 : 'tramp-eshell-directory-change)
4494 : (remove-hook 'eshell-directory-change-hook
4495 : 'tramp-eshell-directory-change)))))
4496 :
4497 : ;; Checklist for `tramp-unload-hook'
4498 : ;; - Unload all `tramp-*' packages
4499 : ;; - Reset `file-name-handler-alist'
4500 : ;; - Cleanup hooks where Tramp functions are in
4501 : ;; - Cleanup advised functions
4502 : ;; - Cleanup autoloads
4503 : ;;;###autoload
4504 : (defun tramp-unload-tramp ()
4505 : "Discard Tramp from loading remote files."
4506 : (interactive)
4507 : ;; ange-ftp settings must be enabled.
4508 0 : (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
4509 : ;; Maybe it's not loaded yet.
4510 0 : (ignore-errors (unload-feature 'tramp 'force)))
4511 :
4512 : (provide 'tramp)
4513 :
4514 : ;;; TODO:
4515 :
4516 : ;; * In Emacs 21, `insert-directory' shows total number of bytes used
4517 : ;; by the files in that directory. Add this here.
4518 : ;;
4519 : ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
4520 : ;;
4521 : ;; * Better error checking. At least whenever we see something
4522 : ;; strange when doing zerop, we should kill the process and start
4523 : ;; again. (Greg Stark)
4524 : ;;
4525 : ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
4526 : ;;
4527 : ;; * I was wondering if it would be possible to use tramp even if I'm
4528 : ;; actually using sshfs. But when I launch a command I would like
4529 : ;; to get it executed on the remote machine where the files really
4530 : ;; are. (Andrea Crotti)
4531 : ;;
4532 : ;; * Run emerge on two remote files. Bug is described here:
4533 : ;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
4534 : ;; (Bug#6850)
4535 : ;;
4536 : ;; * Refactor code from different handlers. Start with
4537 : ;; *-process-file. One idea is to generalize `tramp-send-command'
4538 : ;; and friends, for most of the handlers this is the major
4539 : ;; difference between the different backends. Other handlers but
4540 : ;; *-process-file would profit from this as well.
4541 :
4542 : ;;; tramp.el ends here
4543 :
4544 : ;; Local Variables:
4545 : ;; mode: Emacs-Lisp
4546 : ;; coding: utf-8
4547 : ;; End:
|