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