]> code.delx.au - gnu-emacs/blob - lisp/net/tramp.el
6fe176f28c8a3c5429364667d5720a048215acbc
[gnu-emacs] / lisp / net / tramp.el
1 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
2
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5
6 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
7 ;; 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 22.1 and higher, and for XEmacs 21.4
39 ;; and higher. For XEmacs 21, you need the package `fsf-compat' for
40 ;; the `with-timeout' macro.
41 ;;
42 ;; Also see the todo list at the bottom of this file.
43 ;;
44 ;; The current version of Tramp can be retrieved from the following URL:
45 ;; http://ftp.gnu.org/gnu/tramp/
46 ;;
47 ;; There's a mailing list for this, as well. Its name is:
48 ;; tramp-devel@gnu.org
49 ;; You can use the Web to subscribe, under the following URL:
50 ;; http://lists.gnu.org/mailman/listinfo/tramp-devel
51 ;;
52 ;; For the adventurous, the current development sources are available
53 ;; via CVS. You can find instructions about this at the following URL:
54 ;; http://savannah.gnu.org/projects/tramp/
55 ;; Click on "CVS" in the navigation bar near the top.
56 ;;
57 ;; Don't forget to put on your asbestos longjohns, first!
58
59 ;;; Code:
60
61 (require 'tramp-compat)
62
63 ;;; User Customizable Internal Variables:
64
65 (defgroup tramp nil
66 "Edit remote files with a combination of rsh and rcp or similar programs."
67 :group 'files
68 :group 'comm
69 :version "22.1")
70
71 ;; Maybe we need once a real Tramp mode, with key bindings etc.
72 ;;;###autoload
73 (defcustom tramp-mode t
74 "*Whether Tramp is enabled.
75 If it is set to nil, all remote file names are used literally."
76 :group 'tramp
77 :type 'boolean)
78
79 (defcustom tramp-verbose 3
80 "*Verbosity level for Tramp messages.
81 Any level x includes messages for all levels 1 .. x-1. The levels are
82
83 0 silent (no tramp messages at all)
84 1 errors
85 2 warnings
86 3 connection to remote hosts (default level)
87 4 activities
88 5 internal
89 6 sent and received strings
90 7 file caching
91 8 connection properties
92 9 test commands
93 10 traces (huge)."
94 :group 'tramp
95 :type 'integer)
96
97 ;; Emacs case.
98 (eval-and-compile
99 (when (boundp 'backup-directory-alist)
100 (defcustom tramp-backup-directory-alist nil
101 "Alist of filename patterns and backup directory names.
102 Each element looks like (REGEXP . DIRECTORY), with the same meaning like
103 in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
104 is a local file name, the backup directory is prepended with Tramp file
105 name prefix \(method, user, host\) of file.
106
107 \(setq tramp-backup-directory-alist backup-directory-alist\)
108
109 gives the same backup policy for Tramp files on their hosts like the
110 policy for local files."
111 :group 'tramp
112 :type '(repeat (cons (regexp :tag "Regexp matching filename")
113 (directory :tag "Backup directory name"))))))
114
115 ;; XEmacs case. We cannot check for `bkup-backup-directory-info', because
116 ;; the package "backup-dir" might not be loaded yet.
117 (eval-and-compile
118 (when (featurep 'xemacs)
119 (defcustom tramp-bkup-backup-directory-info nil
120 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
121 It has the same meaning like `bkup-backup-directory-info' from package
122 `backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
123 file name, the backup directory is prepended with Tramp file name prefix
124 \(method, user, host\) of file.
125
126 \(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
127
128 gives the same backup policy for Tramp files on their hosts like the
129 policy for local files."
130 :type '(repeat
131 (list (regexp :tag "File regexp")
132 (string :tag "Backup Dir")
133 (set :inline t
134 (const ok-create)
135 (const full-path)
136 (const prepend-name)
137 (const search-upward))))
138 :group 'tramp)))
139
140 (defcustom tramp-auto-save-directory nil
141 "*Put auto-save files in this directory, if set.
142 The idea is to use a local directory so that auto-saving is faster."
143 :group 'tramp
144 :type '(choice (const nil) string))
145
146 (defcustom tramp-encoding-shell
147 (if (memq system-type '(windows-nt))
148 (getenv "COMSPEC")
149 "/bin/sh")
150 "*Use this program for encoding and decoding commands on the local host.
151 This shell is used to execute the encoding and decoding command on the
152 local host, so if you want to use `~' in those commands, you should
153 choose a shell here which groks tilde expansion. `/bin/sh' normally
154 does not understand tilde expansion.
155
156 For encoding and deocding, commands like the following are executed:
157
158 /bin/sh -c COMMAND < INPUT > OUTPUT
159
160 This variable can be used to change the \"/bin/sh\" part. See the
161 variable `tramp-encoding-command-switch' for the \"-c\" part.
162
163 Note that this variable is not used for remote commands. There are
164 mechanisms in tramp.el which automatically determine the right shell to
165 use for the remote host."
166 :group 'tramp
167 :type '(file :must-match t))
168
169 (defcustom tramp-encoding-command-switch
170 (if (string-match "cmd\\.exe" tramp-encoding-shell)
171 "/c"
172 "-c")
173 "*Use this switch together with `tramp-encoding-shell' for local commands.
174 See the variable `tramp-encoding-shell' for more information."
175 :group 'tramp
176 :type 'string)
177
178 ;;;###tramp-autoload
179 (defvar tramp-methods nil
180 "*Alist of methods for remote files.
181 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
182 Each NAME stands for a remote access method. Each PARAM is a
183 pair of the form (KEY VALUE). The following KEYs are defined:
184 * `tramp-remote-sh'
185 This specifies the Bourne shell to use on the remote host. This
186 MUST be a Bourne-like shell. It is normally not necessary to set
187 this to any value other than \"/bin/sh\": Tramp wants to use a shell
188 which groks tilde expansion, but it can search for it. Also note
189 that \"/bin/sh\" exists on all Unixen, this might not be true for
190 the value that you decide to use. You Have Been Warned.
191 * `tramp-login-program'
192 This specifies the name of the program to use for logging in to the
193 remote host. This may be the name of rsh or a workalike program,
194 or the name of telnet or a workalike, or the name of su or a workalike.
195 * `tramp-login-args'
196 This specifies the list of arguments to pass to the above
197 mentioned program. Please note that this is a list of list of arguments,
198 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
199 here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
200 There are some patterns: \"%h\" in this list is replaced by the host
201 name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
202 port number, and \"%%\" can be used to obtain a literal percent character.
203 If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
204 expansion (i.e. no host or no user specified), this list is not used as
205 argument. By this, arguments like (\"-l\" \"%u\") are optional.
206 \"%t\" is replaced by the temporary file name produced with
207 `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
208 parameter of a program, if exists.
209 * `tramp-async-args'
210 When an asynchronous process is started, we know already that
211 the connection works. Therefore, we can pass additional
212 parameters to suppress diagnostic messages, in order not to
213 tamper the process output.
214 * `tramp-copy-program'
215 This specifies the name of the program to use for remotely copying
216 the file; this might be the absolute filename of rcp or the name of
217 a workalike program.
218 * `tramp-copy-args'
219 This specifies the list of parameters to pass to the above mentioned
220 program, the hints for `tramp-login-args' also apply here.
221 * `tramp-copy-keep-date'
222 This specifies whether the copying program when the preserves the
223 timestamp of the original file.
224 * `tramp-copy-keep-tmpfile'
225 This specifies whether a temporary local file shall be kept
226 for optimization reasons (useful for \"rsync\" methods).
227 * `tramp-copy-recursive'
228 Whether the operation copies directories recursively.
229 * `tramp-default-port'
230 The default port of a method is needed in case of gateway connections.
231 Additionally, it is used as indication which method is prepared for
232 passing gateways.
233 * `tramp-gw-args'
234 As the attribute name says, additional arguments are specified here
235 when a method is applied via a gateway.
236 * `tramp-password-end-of-line'
237 This specifies the string to use for terminating the line after
238 submitting the password. If this method parameter is nil, then the
239 value of the normal variable `tramp-default-password-end-of-line'
240 is used. This parameter is necessary because the \"plink\" program
241 requires any two characters after sending the password. These do
242 not have to be newline or carriage return characters. Other login
243 programs are happy with just one character, the newline character.
244 We use \"xy\" as the value for methods using \"plink\".
245
246 What does all this mean? Well, you should specify `tramp-login-program'
247 for all methods; this program is used to log in to the remote site. Then,
248 there are two ways to actually transfer the files between the local and the
249 remote side. One way is using an additional rcp-like program. If you want
250 to do this, set `tramp-copy-program' in the method.
251
252 Another possibility for file transfer is inline transfer, i.e. the
253 file is passed through the same buffer used by `tramp-login-program'. In
254 this case, the file contents need to be protected since the
255 `tramp-login-program' might use escape codes or the connection might not
256 be eight-bit clean. Therefore, file contents are encoded for transit.
257 See the variables `tramp-local-coding-commands' and
258 `tramp-remote-coding-commands' for details.
259
260 So, to summarize: if the method is an out-of-band method, then you
261 must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
262 inline method, then these two parameters should be nil. Methods which
263 are fit for gateways must have `tramp-default-port' at least.
264
265 Notes:
266
267 When using `su' or `sudo' the phrase `open connection to a remote
268 host' sounds strange, but it is used nevertheless, for consistency.
269 No connection is opened to a remote host, but `su' or `sudo' is
270 started on the local host. You should specify a remote host
271 `localhost' or the name of the local host. Another host name is
272 useful only in combination with `tramp-default-proxies-alist'.")
273
274 (defun tramp-detect-ssh-controlmaster ()
275 "Call ssh to detect whether it supports the ControlMaster argument.
276 This function may return nil when the argument is supported, but
277 shouldn't return t when it isn't."
278 (ignore-errors
279 (with-temp-buffer
280 (call-process "ssh" nil t nil "-o" "ControlMaster")
281 (goto-char (point-min))
282 (search-forward-regexp "Missing ControlMaster argument" nil t))))
283
284 (defcustom tramp-default-method
285 ;; An external copy method seems to be preferred, because it is much
286 ;; more performant for large files, and it hasn't too serious delays
287 ;; for small files. But it must be ensured that there aren't
288 ;; permanent password queries. Either a password agent like
289 ;; "ssh-agent" or "Pageant" shall run, or the optional
290 ;; password-cache.el or auth-sources.el packages shall be active for
291 ;; password caching. "scpc" is chosen if we detect that the user is
292 ;; running OpenSSH 4.0 or newer.
293 (cond
294 ;; PuTTY is installed. We don't take it, if it is installed on a
295 ;; non-windows system, or pscp from the pssh (parallel ssh) package
296 ;; is found.
297 ((and (eq system-type 'windows-nt)
298 (executable-find "pscp"))
299 (if (or (fboundp 'password-read)
300 (fboundp 'auth-source-user-or-password)
301 ;; Pageant is running.
302 (tramp-compat-process-running-p "Pageant"))
303 "pscp"
304 "plink"))
305 ;; There is an ssh installation.
306 ((executable-find "scp")
307 (cond
308 ((tramp-detect-ssh-controlmaster) "scpc")
309 ((or (fboundp 'password-read)
310 (fboundp 'auth-source-user-or-password)
311 ;; ssh-agent is running.
312 (getenv "SSH_AUTH_SOCK")
313 (getenv "SSH_AGENT_PID"))
314 "scp")
315 (t "ssh")))
316 ;; Fallback.
317 (t "ftp"))
318 "*Default method to use for transferring files.
319 See `tramp-methods' for possibilities.
320 Also see `tramp-default-method-alist'."
321 :group 'tramp
322 :type 'string)
323
324 ;;;###tramp-autoload
325 (defcustom tramp-default-method-alist nil
326 "*Default method to use for specific host/user pairs.
327 This is an alist of items (HOST USER METHOD). The first matching item
328 specifies the method to use for a file name which does not specify a
329 method. HOST and USER are regular expressions or nil, which is
330 interpreted as a regular expression which always matches. If no entry
331 matches, the variable `tramp-default-method' takes effect.
332
333 If the file name does not specify the user, lookup is done using the
334 empty string for the user name.
335
336 See `tramp-methods' for a list of possibilities for METHOD."
337 :group 'tramp
338 :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
339 (choice :tag "User regexp" regexp sexp)
340 (choice :tag "Method name" string (const nil)))))
341
342 (defcustom tramp-default-user nil
343 "*Default user to use for transferring files.
344 It is nil by default; otherwise settings in configuration files like
345 \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
346
347 This variable is regarded as obsolete, and will be removed soon."
348 :group 'tramp
349 :type '(choice (const nil) string))
350
351 ;;;###tramp-autoload
352 (defcustom tramp-default-user-alist nil
353 "*Default user to use for specific method/host pairs.
354 This is an alist of items (METHOD HOST USER). The first matching item
355 specifies the user to use for a file name which does not specify a
356 user. METHOD and USER are regular expressions or nil, which is
357 interpreted as a regular expression which always matches. If no entry
358 matches, the variable `tramp-default-user' takes effect.
359
360 If the file name does not specify the method, lookup is done using the
361 empty string for the method name."
362 :group 'tramp
363 :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
364 (choice :tag " Host regexp" regexp sexp)
365 (choice :tag " User name" string (const nil)))))
366
367 (defcustom tramp-default-host (system-name)
368 "*Default host to use for transferring files.
369 Useful for su and sudo methods mostly."
370 :group 'tramp
371 :type 'string)
372
373 (defcustom tramp-default-proxies-alist nil
374 "*Route to be followed for specific host/user pairs.
375 This is an alist of items (HOST USER PROXY). The first matching
376 item specifies the proxy to be passed for a file name located on
377 a remote target matching USER@HOST. HOST and USER are regular
378 expressions. PROXY must be a Tramp filename without a localname
379 part. Method and user name on PROXY are optional, which is
380 interpreted with the default values. PROXY can contain the
381 patterns %h and %u, which are replaced by the strings matching
382 HOST or USER, respectively.
383
384 HOST, USER or PROXY could also be Lisp forms, which will be
385 evaluated. The result must be a string or nil, which is
386 interpreted as a regular expression which always matches."
387 :group 'tramp
388 :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
389 (choice :tag "User regexp" regexp sexp)
390 (choice :tag " Proxy name" string (const nil)))))
391
392 ;;;###tramp-autoload
393 (defconst tramp-local-host-regexp
394 (concat
395 "\\`"
396 (regexp-opt
397 (list "localhost" "localhost6" (system-name) "127\.0\.0\.1" "::1") t)
398 "\\'")
399 "*Host names which are regarded as local host.")
400
401 (defvar tramp-completion-function-alist nil
402 "*Alist of methods for remote files.
403 This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
404 Each NAME stands for a remote access method. Each PAIR is of the form
405 \(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
406 names from FILE for completion. The following predefined FUNCTIONs exists:
407
408 * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
409 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
410 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
411 * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
412 * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
413 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
414 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
415 * `tramp-parse-netrc' for \"~/.netrc\" like files.
416 * `tramp-parse-putty' for PuTTY registry keys.
417
418 FUNCTION can also be a customer defined function. For more details see
419 the info pages.")
420
421 (defconst tramp-echo-mark-marker "_echo"
422 "String marker to surround echoed commands.")
423
424 (defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
425 "String length of `tramp-echo-mark-marker'.")
426
427 (defconst tramp-echo-mark
428 (concat tramp-echo-mark-marker
429 (make-string tramp-echo-mark-marker-length ?\b))
430 "String mark to be transmitted around shell commands.
431 Used to separate their echo from the output they produce. This
432 will only be used if we cannot disable remote echo via stty.
433 This string must have no effect on the remote shell except for
434 producing some echo which can later be detected by
435 `tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
436 followed by an equal number of backspaces to erase them will
437 usually suffice.")
438
439 (defconst tramp-echoed-echo-mark-regexp
440 (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
441 tramp-echo-mark-marker tramp-echo-mark-marker-length)
442 "Regexp which matches `tramp-echo-mark' as it gets echoed by
443 the remote shell.")
444
445 (defcustom tramp-rsh-end-of-line "\n"
446 "*String used for end of line in rsh connections.
447 I don't think this ever needs to be changed, so please tell me about it
448 if you need to change this.
449 Also see the method parameter `tramp-password-end-of-line' and the normal
450 variable `tramp-default-password-end-of-line'."
451 :group 'tramp
452 :type 'string)
453
454 (defcustom tramp-default-password-end-of-line
455 tramp-rsh-end-of-line
456 "*String used for end of line after sending a password.
457 This variable provides the default value for the method parameter
458 `tramp-password-end-of-line', see `tramp-methods' for more details.
459
460 It seems that people using plink under Windows need to send
461 \"\\r\\n\" (carriage-return, then newline) after a password, but just
462 \"\\n\" after all other lines. This variable can be used for the
463 password, see `tramp-rsh-end-of-line' for the other cases.
464
465 The default value is to use the same value as `tramp-rsh-end-of-line'."
466 :group 'tramp
467 :type 'string)
468
469 (defcustom tramp-login-prompt-regexp
470 ".*ogin\\( .*\\)?: *"
471 "*Regexp matching login-like prompts.
472 The regexp should match at end of buffer.
473
474 Sometimes the prompt is reported to look like \"login as:\"."
475 :group 'tramp
476 :type 'regexp)
477
478 (defcustom tramp-shell-prompt-pattern
479 ;; Allow a prompt to start right after a ^M since it indeed would be
480 ;; displayed at the beginning of the line (and Zsh uses it). This
481 ;; regexp works only for GNU Emacs.
482 (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
483 "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
484 "Regexp to match prompts from remote shell.
485 Normally, Tramp expects you to configure `shell-prompt-pattern'
486 correctly, but sometimes it happens that you are connecting to a
487 remote host which sends a different kind of shell prompt. Therefore,
488 Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
489 and also things matched by this variable. The default value of this
490 variable is similar to the default value of `shell-prompt-pattern',
491 which should work well in many cases.
492
493 This regexp must match both `tramp-initial-end-of-output' and
494 `tramp-end-of-output'."
495 :group 'tramp
496 :type 'regexp)
497
498 (defcustom tramp-password-prompt-regexp
499 "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
500 "*Regexp matching password-like prompts.
501 The regexp should match at end of buffer.
502
503 The `sudo' program appears to insert a `^@' character into the prompt."
504 :group 'tramp
505 :type 'regexp)
506
507 (defcustom tramp-wrong-passwd-regexp
508 (concat "^.*"
509 ;; These strings should be on the last line
510 (regexp-opt '("Permission denied"
511 "Login incorrect"
512 "Login Incorrect"
513 "Connection refused"
514 "Connection closed"
515 "Timeout, server not responding."
516 "Sorry, try again."
517 "Name or service not known"
518 "Host key verification failed."
519 "No supported authentication methods left to try!") t)
520 ".*"
521 "\\|"
522 "^.*\\("
523 ;; Here comes a list of regexes, separated by \\|
524 "Received signal [0-9]+"
525 "\\).*")
526 "*Regexp matching a `login failed' message.
527 The regexp should match at end of buffer."
528 :group 'tramp
529 :type 'regexp)
530
531 (defcustom tramp-yesno-prompt-regexp
532 (concat
533 (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
534 "\\s-*")
535 "Regular expression matching all yes/no queries which need to be confirmed.
536 The confirmation should be done with yes or no.
537 The regexp should match at end of buffer.
538 See also `tramp-yn-prompt-regexp'."
539 :group 'tramp
540 :type 'regexp)
541
542 (defcustom tramp-yn-prompt-regexp
543 (concat
544 (regexp-opt '("Store key in cache? (y/n)"
545 "Update cached key? (y/n, Return cancels connection)") t)
546 "\\s-*")
547 "Regular expression matching all y/n queries which need to be confirmed.
548 The confirmation should be done with y or n.
549 The regexp should match at end of buffer.
550 See also `tramp-yesno-prompt-regexp'."
551 :group 'tramp
552 :type 'regexp)
553
554 (defcustom tramp-terminal-prompt-regexp
555 (concat "\\("
556 "TERM = (.*)"
557 "\\|"
558 "Terminal type\\? \\[.*\\]"
559 "\\)\\s-*")
560 "Regular expression matching all terminal setting prompts.
561 The regexp should match at end of buffer.
562 The answer will be provided by `tramp-action-terminal', which see."
563 :group 'tramp
564 :type 'regexp)
565
566 (defcustom tramp-operation-not-permitted-regexp
567 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
568 (regexp-opt '("Operation not permitted") t))
569 "Regular expression matching keep-date problems in (s)cp operations.
570 Copying has been performed successfully already, so this message can
571 be ignored safely."
572 :group 'tramp
573 :type 'regexp)
574
575 (defcustom tramp-copy-failed-regexp
576 (concat "\\(.+: "
577 (regexp-opt '("Permission denied"
578 "not a regular file"
579 "is a directory"
580 "No such file or directory") t)
581 "\\)\\s-*")
582 "Regular expression matching copy problems in (s)cp operations."
583 :group 'tramp
584 :type 'regexp)
585
586 (defcustom tramp-process-alive-regexp
587 ""
588 "Regular expression indicating a process has finished.
589 In fact this expression is empty by intention, it will be used only to
590 check regularly the status of the associated process.
591 The answer will be provided by `tramp-action-process-alive',
592 `tramp-action-out-of-band', which see."
593 :group 'tramp
594 :type 'regexp)
595
596 (defconst tramp-temp-name-prefix "tramp."
597 "*Prefix to use for temporary files.
598 If this is a relative file name (such as \"tramp.\"), it is considered
599 relative to the directory name returned by the function
600 `tramp-compat-temporary-file-directory' (which see). It may also be an
601 absolute file name; don't forget to include a prefix for the filename
602 part, though.")
603
604 (defconst tramp-temp-buffer-name " *tramp temp*"
605 "Buffer name for a temporary buffer.
606 It shall be used in combination with `generate-new-buffer-name'.")
607
608 (defvar tramp-temp-buffer-file-name nil
609 "File name of a persistent local temporary file.
610 Useful for \"rsync\" like methods.")
611 (make-variable-buffer-local 'tramp-temp-buffer-file-name)
612 (put 'tramp-temp-buffer-file-name 'permanent-local t)
613
614 ;; XEmacs is distributed with few Lisp packages. Further packages are
615 ;; installed using EFS. If we use a unified filename format, then
616 ;; Tramp is required in addition to EFS. (But why can't Tramp just
617 ;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
618 ;; just like before.) Another reason for using a separate filename
619 ;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
620 ;; Tramp only knows how to deal with `file-name-handler-alist', not
621 ;; the other places.
622
623 ;; Currently, we have the choice between 'ftp, 'sep, and 'url.
624 ;;;###autoload
625 (defcustom tramp-syntax
626 (if (featurep 'xemacs) 'sep 'ftp)
627 "Tramp filename syntax to be used.
628
629 It can have the following values:
630
631 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
632 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
633 'url -- URL-like syntax."
634 :group 'tramp
635 :type (if (featurep 'xemacs)
636 '(choice (const :tag "EFS" ftp)
637 (const :tag "XEmacs" sep)
638 (const :tag "URL" url))
639 '(choice (const :tag "Ange-FTP" ftp)
640 (const :tag "URL" url))))
641
642 (defconst tramp-prefix-format
643 (cond ((equal tramp-syntax 'ftp) "/")
644 ((equal tramp-syntax 'sep) "/[")
645 ((equal tramp-syntax 'url) "/")
646 (t (error "Wrong `tramp-syntax' defined")))
647 "*String matching the very beginning of Tramp file names.
648 Used in `tramp-make-tramp-file-name'.")
649
650 (defconst tramp-prefix-regexp
651 (concat "^" (regexp-quote tramp-prefix-format))
652 "*Regexp matching the very beginning of Tramp file names.
653 Should always start with \"^\". Derived from `tramp-prefix-format'.")
654
655 (defconst tramp-method-regexp
656 "[a-zA-Z_0-9-]+"
657 "*Regexp matching methods identifiers.")
658
659 (defconst tramp-postfix-method-format
660 (cond ((equal tramp-syntax 'ftp) ":")
661 ((equal tramp-syntax 'sep) "/")
662 ((equal tramp-syntax 'url) "://")
663 (t (error "Wrong `tramp-syntax' defined")))
664 "*String matching delimeter between method and user or host names.
665 Used in `tramp-make-tramp-file-name'.")
666
667 (defconst tramp-postfix-method-regexp
668 (regexp-quote tramp-postfix-method-format)
669 "*Regexp matching delimeter between method and user or host names.
670 Derived from `tramp-postfix-method-format'.")
671
672 (defconst tramp-user-regexp "[^:/ \t]+"
673 "*Regexp matching user names.")
674
675 ;;;###tramp-autoload
676 (defconst tramp-prefix-domain-format "%"
677 "*String matching delimeter between user and domain names.")
678
679 ;;;###tramp-autoload
680 (defconst tramp-prefix-domain-regexp
681 (regexp-quote tramp-prefix-domain-format)
682 "*Regexp matching delimeter between user and domain names.
683 Derived from `tramp-prefix-domain-format'.")
684
685 (defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+"
686 "*Regexp matching domain names.")
687
688 (defconst tramp-user-with-domain-regexp
689 (concat "\\(" tramp-user-regexp "\\)"
690 tramp-prefix-domain-regexp
691 "\\(" tramp-domain-regexp "\\)")
692 "*Regexp matching user names with domain names.")
693
694 (defconst tramp-postfix-user-format "@"
695 "*String matching delimeter between user and host names.
696 Used in `tramp-make-tramp-file-name'.")
697
698 (defconst tramp-postfix-user-regexp
699 (regexp-quote tramp-postfix-user-format)
700 "*Regexp matching delimeter between user and host names.
701 Derived from `tramp-postfix-user-format'.")
702
703 (defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
704 "*Regexp matching host names.")
705
706 (defconst tramp-prefix-ipv6-format
707 (cond ((equal tramp-syntax 'ftp) "[")
708 ((equal tramp-syntax 'sep) "")
709 ((equal tramp-syntax 'url) "[")
710 (t (error "Wrong `tramp-syntax' defined")))
711 "*String matching left hand side of IPv6 addresses.
712 Used in `tramp-make-tramp-file-name'.")
713
714 (defconst tramp-prefix-ipv6-regexp
715 (regexp-quote tramp-prefix-ipv6-format)
716 "*Regexp matching left hand side of IPv6 addresses.
717 Derived from `tramp-prefix-ipv6-format'.")
718
719 ;; The following regexp is a bit sloppy. But it shall serve our
720 ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
721 ;; "::ffff:192.168.0.1".
722 (defconst tramp-ipv6-regexp
723 "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
724 "*Regexp matching IPv6 addresses.")
725
726 (defconst tramp-postfix-ipv6-format
727 (cond ((equal tramp-syntax 'ftp) "]")
728 ((equal tramp-syntax 'sep) "")
729 ((equal tramp-syntax 'url) "]")
730 (t (error "Wrong `tramp-syntax' defined")))
731 "*String matching right hand side of IPv6 addresses.
732 Used in `tramp-make-tramp-file-name'.")
733
734 (defconst tramp-postfix-ipv6-regexp
735 (regexp-quote tramp-postfix-ipv6-format)
736 "*Regexp matching right hand side of IPv6 addresses.
737 Derived from `tramp-postfix-ipv6-format'.")
738
739 (defconst tramp-prefix-port-format
740 (cond ((equal tramp-syntax 'ftp) "#")
741 ((equal tramp-syntax 'sep) "#")
742 ((equal tramp-syntax 'url) ":")
743 (t (error "Wrong `tramp-syntax' defined")))
744 "*String matching delimeter between host names and port numbers.")
745
746 (defconst tramp-prefix-port-regexp
747 (regexp-quote tramp-prefix-port-format)
748 "*Regexp matching delimeter between host names and port numbers.
749 Derived from `tramp-prefix-port-format'.")
750
751 (defconst tramp-port-regexp "[0-9]+"
752 "*Regexp matching port numbers.")
753
754 (defconst tramp-host-with-port-regexp
755 (concat "\\(" tramp-host-regexp "\\)"
756 tramp-prefix-port-regexp
757 "\\(" tramp-port-regexp "\\)")
758 "*Regexp matching host names with port numbers.")
759
760 (defconst tramp-postfix-host-format
761 (cond ((equal tramp-syntax 'ftp) ":")
762 ((equal tramp-syntax 'sep) "]")
763 ((equal tramp-syntax 'url) "")
764 (t (error "Wrong `tramp-syntax' defined")))
765 "*String matching delimeter between host names and localnames.
766 Used in `tramp-make-tramp-file-name'.")
767
768 (defconst tramp-postfix-host-regexp
769 (regexp-quote tramp-postfix-host-format)
770 "*Regexp matching delimeter between host names and localnames.
771 Derived from `tramp-postfix-host-format'.")
772
773 (defconst tramp-localname-regexp ".*$"
774 "*Regexp matching localnames.")
775
776 ;;; File name format:
777
778 (defconst tramp-file-name-structure
779 (list
780 (concat
781 tramp-prefix-regexp
782 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
783 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
784 "\\(" "\\(" tramp-host-regexp
785 "\\|"
786 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
787 tramp-postfix-ipv6-regexp "\\)"
788 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
789 tramp-postfix-host-regexp
790 "\\(" tramp-localname-regexp "\\)")
791 2 4 5 8)
792
793 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
794 the Tramp file name structure.
795
796 The first element REGEXP is a regular expression matching a Tramp file
797 name. The regex should contain parentheses around the method name,
798 the user name, the host name, and the file name parts.
799
800 The second element METHOD is a number, saying which pair of
801 parentheses matches the method name. The third element USER is
802 similar, but for the user name. The fourth element HOST is similar,
803 but for the host name. The fifth element FILE is for the file name.
804 These numbers are passed directly to `match-string', which see. That
805 means the opening parentheses are counted to identify the pair.
806
807 See also `tramp-file-name-regexp'.")
808
809 ;;;###autoload
810 (defconst tramp-file-name-regexp-unified
811 (if (memq system-type '(cygwin windows-nt))
812 "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
813 "\\`/\\([^[/:]+\\|[^/]+]\\):")
814 "Value for `tramp-file-name-regexp' for unified remoting.
815 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
816 Tramp. See `tramp-file-name-structure' for more explanations.
817
818 On W32 systems, the volume letter must be ignored.")
819
820 ;;;###autoload
821 (defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]"
822 "Value for `tramp-file-name-regexp' for separate remoting.
823 XEmacs uses a separate filename syntax for Tramp and EFS.
824 See `tramp-file-name-structure' for more explanations.")
825
826 ;;;###autoload
827 (defconst tramp-file-name-regexp-url "\\`/[^/:]+://"
828 "Value for `tramp-file-name-regexp' for URL-like remoting.
829 See `tramp-file-name-structure' for more explanations.")
830
831 ;;;###autoload
832 (defconst tramp-file-name-regexp
833 (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
834 ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
835 ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
836 (t (error "Wrong `tramp-syntax' defined")))
837 "*Regular expression matching file names handled by Tramp.
838 This regexp should match Tramp file names but no other file names.
839 When tramp.el is loaded, this regular expression is prepended to
840 `file-name-handler-alist', and that is searched sequentially. Thus,
841 if the Tramp entry appears rather early in the `file-name-handler-alist'
842 and is a bit too general, then some files might be considered Tramp
843 files which are not really Tramp files.
844
845 Please note that the entry in `file-name-handler-alist' is made when
846 this file \(tramp.el\) is loaded. This means that this variable must be set
847 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
848 updated after changing this variable.
849
850 Also see `tramp-file-name-structure'.")
851
852 ;;;###autoload
853 (defconst tramp-root-regexp
854 (if (memq system-type '(cygwin windows-nt))
855 "\\`\\([a-zA-Z]:\\)?/"
856 "\\`/")
857 "Beginning of an incomplete Tramp file name.
858 Usually, it is just \"\\\\`/\". On W32 systems, there might be a
859 volume letter, which will be removed by `tramp-drop-volume-letter'.")
860
861 ;;;###autoload
862 (defconst tramp-completion-file-name-regexp-unified
863 (if (memq system-type '(cygwin windows-nt))
864 (concat tramp-root-regexp "[^/]\\{2,\\}\\'")
865 (concat tramp-root-regexp "[^/]*\\'"))
866 "Value for `tramp-completion-file-name-regexp' for unified remoting.
867 GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
868 See `tramp-file-name-structure' for more explanations.
869
870 On W32 systems, the volume letter must be ignored.")
871
872 ;;;###autoload
873 (defconst tramp-completion-file-name-regexp-separate
874 (concat tramp-root-regexp "\\([[][^]]*\\)?\\'")
875 "Value for `tramp-completion-file-name-regexp' for separate remoting.
876 XEmacs uses a separate filename syntax for Tramp and EFS.
877 See `tramp-file-name-structure' for more explanations.")
878
879 ;;;###autoload
880 (defconst tramp-completion-file-name-regexp-url
881 (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'")
882 "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
883 See `tramp-file-name-structure' for more explanations.")
884
885 ;;;###autoload
886 (defconst tramp-completion-file-name-regexp
887 (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
888 ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
889 ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
890 (t (error "Wrong `tramp-syntax' defined")))
891 "*Regular expression matching file names handled by Tramp completion.
892 This regexp should match partial Tramp file names only.
893
894 Please note that the entry in `file-name-handler-alist' is made when
895 this file (tramp.el) is loaded. This means that this variable must be set
896 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
897 updated after changing this variable.
898
899 Also see `tramp-file-name-structure'.")
900
901 ;; Chunked sending kludge. We set this to 500 for black-listed constellations
902 ;; known to have a bug in `process-send-string'; some ssh connections appear
903 ;; to drop bytes when data is sent too quickly. There is also a connection
904 ;; buffer local variable, which is computed depending on remote host properties
905 ;; when `tramp-chunksize' is zero or nil.
906 (defcustom tramp-chunksize
907 (when (and (not (featurep 'xemacs))
908 (memq system-type '(hpux)))
909 500)
910 ;; Parentheses in docstring starting at beginning of line are escaped.
911 ;; Fontification is messed up when
912 ;; `open-paren-in-column-0-is-defun-start' set to t.
913 "*If non-nil, chunksize for sending input to local process.
914 It is necessary only on systems which have a buggy `process-send-string'
915 implementation. The necessity, whether this variable must be set, can be
916 checked via the following code:
917
918 (with-temp-buffer
919 (let* ((user \"xxx\") (host \"yyy\")
920 (init 0) (step 50)
921 (sent init) (received init))
922 (while (= sent received)
923 (setq sent (+ sent step))
924 (erase-buffer)
925 (let ((proc (start-process (buffer-name) (current-buffer)
926 \"ssh\" \"-l\" user host \"wc\" \"-c\")))
927 (when (memq (process-status proc) '(run open))
928 (process-send-string proc (make-string sent ?\\ ))
929 (process-send-eof proc)
930 (process-send-eof proc))
931 (while (not (progn (goto-char (point-min))
932 (re-search-forward \"\\\\w+\" (point-max) t)))
933 (accept-process-output proc 1))
934 (when (memq (process-status proc) '(run open))
935 (setq received (string-to-number (match-string 0)))
936 (delete-process proc)
937 (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
938 (sit-for 0))))
939 (if (> sent (+ init step))
940 (message \"You should set `tramp-chunksize' to a maximum of %s\"
941 (- sent step))
942 (message \"Test does not work\")
943 (display-buffer (current-buffer))
944 (sit-for 30))))
945
946 In the Emacs normally running Tramp, evaluate the above code
947 \(replace \"xxx\" and \"yyy\" by the remote user and host name,
948 respectively\). You can do this, for example, by pasting it into
949 the `*scratch*' buffer and then hitting C-j with the cursor after the
950 last closing parenthesis. Note that it works only if you have configured
951 \"ssh\" to run without password query, see ssh-agent\(1\).
952
953 You will see the number of bytes sent successfully to the remote host.
954 If that number exceeds 1000, you can stop the execution by hitting
955 C-g, because your Emacs is likely clean.
956
957 When it is necessary to set `tramp-chunksize', you might consider to
958 use an out-of-the-band method \(like \"scp\"\) instead of an internal one
959 \(like \"ssh\"\), because setting `tramp-chunksize' to non-nil decreases
960 performance.
961
962 If your Emacs is buggy, the code stops and gives you an indication
963 about the value `tramp-chunksize' should be set. Maybe you could just
964 experiment a bit, e.g. changing the values of `init' and `step'
965 in the third line of the code.
966
967 Please raise a bug report via \"M-x tramp-bug\" if your system needs
968 this variable to be set as well."
969 :group 'tramp
970 :type '(choice (const nil) integer))
971
972 ;; Logging in to a remote host normally requires obtaining a pty. But
973 ;; Emacs on MacOS X has process-connection-type set to nil by default,
974 ;; so on those systems Tramp doesn't obtain a pty. Here, we allow
975 ;; for an override of the system default.
976 (defcustom tramp-process-connection-type t
977 "Overrides `process-connection-type' for connections from Tramp.
978 Tramp binds process-connection-type to the value given here before
979 opening a connection to a remote host."
980 :group 'tramp
981 :type '(choice (const nil) (const t) (const pty)))
982
983 (defcustom tramp-completion-reread-directory-timeout 10
984 "Defines seconds since last remote command before rereading a directory.
985 A remote directory might have changed its contents. In order to
986 make it visible during file name completion in the minibuffer,
987 Tramp flushes its cache and rereads the directory contents when
988 more than `tramp-completion-reread-directory-timeout' seconds
989 have been gone since last remote command execution. A value of `t'
990 would require an immediate reread during filename completion, `nil'
991 means to use always cached values for the directory contents."
992 :group 'tramp
993 :type '(choice (const nil) integer))
994
995 ;;; Internal Variables:
996
997 (defvar tramp-current-method nil
998 "Connection method for this *tramp* buffer.")
999
1000 (defvar tramp-current-user nil
1001 "Remote login name for this *tramp* buffer.")
1002
1003 (defvar tramp-current-host nil
1004 "Remote host for this *tramp* buffer.")
1005
1006 ;;;###autoload
1007 (defconst tramp-completion-file-name-handler-alist
1008 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
1009 (file-name-completion . tramp-completion-handle-file-name-completion))
1010 "Alist of completion handler functions.
1011 Used for file names matching `tramp-file-name-regexp'. Operations
1012 not mentioned here will be handled by Tramp's file name handler
1013 functions, or the normal Emacs functions.")
1014
1015 ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
1016 ;;;###tramp-autoload
1017 (defvar tramp-foreign-file-name-handler-alist nil
1018 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
1019 If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
1020 calling HANDLER.")
1021
1022 ;;; Internal functions which must come first:
1023
1024 ;; Conversion functions between external representation and
1025 ;; internal data structure. Convenience functions for internal
1026 ;; data structure.
1027
1028 (defun tramp-file-name-p (vec)
1029 "Check, whether VEC is a Tramp object."
1030 (and (vectorp vec) (= 4 (length vec))))
1031
1032 (defun tramp-file-name-method (vec)
1033 "Return method component of VEC."
1034 (and (tramp-file-name-p vec) (aref vec 0)))
1035
1036 (defun tramp-file-name-user (vec)
1037 "Return user component of VEC."
1038 (and (tramp-file-name-p vec) (aref vec 1)))
1039
1040 (defun tramp-file-name-host (vec)
1041 "Return host component of VEC."
1042 (and (tramp-file-name-p vec) (aref vec 2)))
1043
1044 (defun tramp-file-name-localname (vec)
1045 "Return localname component of VEC."
1046 (and (tramp-file-name-p vec) (aref vec 3)))
1047
1048 ;; The user part of a Tramp file name vector can be of kind
1049 ;; "user%domain". Sometimes, we must extract these parts.
1050 (defun tramp-file-name-real-user (vec)
1051 "Return the user name of VEC without domain."
1052 (save-match-data
1053 (let ((user (tramp-file-name-user vec)))
1054 (if (and (stringp user)
1055 (string-match tramp-user-with-domain-regexp user))
1056 (match-string 1 user)
1057 user))))
1058
1059 (defun tramp-file-name-domain (vec)
1060 "Return the domain name of VEC."
1061 (save-match-data
1062 (let ((user (tramp-file-name-user vec)))
1063 (and (stringp user)
1064 (string-match tramp-user-with-domain-regexp user)
1065 (match-string 2 user)))))
1066
1067 ;; The host part of a Tramp file name vector can be of kind
1068 ;; "host#port". Sometimes, we must extract these parts.
1069 (defun tramp-file-name-real-host (vec)
1070 "Return the host name of VEC without port."
1071 (save-match-data
1072 (let ((host (tramp-file-name-host vec)))
1073 (if (and (stringp host)
1074 (string-match tramp-host-with-port-regexp host))
1075 (match-string 1 host)
1076 host))))
1077
1078 (defun tramp-file-name-port (vec)
1079 "Return the port number of VEC."
1080 (save-match-data
1081 (let ((method (tramp-file-name-method vec))
1082 (host (tramp-file-name-host vec)))
1083 (or (and (stringp host)
1084 (string-match tramp-host-with-port-regexp host)
1085 (string-to-number (match-string 2 host)))
1086 (tramp-get-method-parameter method 'tramp-default-port)))))
1087
1088 ;;;###tramp-autoload
1089 (defun tramp-tramp-file-p (name)
1090 "Return t if NAME is a string with Tramp file name syntax."
1091 (save-match-data
1092 (and (stringp name) (string-match tramp-file-name-regexp name))))
1093
1094 (defun tramp-find-method (method user host)
1095 "Return the right method string to use.
1096 This is METHOD, if non-nil. Otherwise, do a lookup in
1097 `tramp-default-method-alist'."
1098 (or method
1099 (let ((choices tramp-default-method-alist)
1100 lmethod item)
1101 (while choices
1102 (setq item (pop choices))
1103 (when (and (string-match (or (nth 0 item) "") (or host ""))
1104 (string-match (or (nth 1 item) "") (or user "")))
1105 (setq lmethod (nth 2 item))
1106 (setq choices nil)))
1107 lmethod)
1108 tramp-default-method))
1109
1110 (defun tramp-find-user (method user host)
1111 "Return the right user string to use.
1112 This is USER, if non-nil. Otherwise, do a lookup in
1113 `tramp-default-user-alist'."
1114 (or user
1115 (let ((choices tramp-default-user-alist)
1116 luser item)
1117 (while choices
1118 (setq item (pop choices))
1119 (when (and (string-match (or (nth 0 item) "") (or method ""))
1120 (string-match (or (nth 1 item) "") (or host "")))
1121 (setq luser (nth 2 item))
1122 (setq choices nil)))
1123 luser)
1124 tramp-default-user))
1125
1126 (defun tramp-find-host (method user host)
1127 "Return the right host string to use.
1128 This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
1129 (or (and (> (length host) 0) host)
1130 tramp-default-host))
1131
1132 (defun tramp-dissect-file-name (name &optional nodefault)
1133 "Return a `tramp-file-name' structure.
1134 The structure consists of remote method, remote user, remote host
1135 and localname (file name on remote host). If NODEFAULT is
1136 non-nil, the file name parts are not expanded to their default
1137 values."
1138 (save-match-data
1139 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
1140 (unless match (error "Not a Tramp file name: %s" name))
1141 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
1142 (user (match-string (nth 2 tramp-file-name-structure) name))
1143 (host (match-string (nth 3 tramp-file-name-structure) name))
1144 (localname (match-string (nth 4 tramp-file-name-structure) name)))
1145 (when host
1146 (when (string-match tramp-prefix-ipv6-regexp host)
1147 (setq host (replace-match "" nil t host)))
1148 (when (string-match tramp-postfix-ipv6-regexp host)
1149 (setq host (replace-match "" nil t host))))
1150 (if nodefault
1151 (vector method user host localname)
1152 (vector
1153 (tramp-find-method method user host)
1154 (tramp-find-user method user host)
1155 (tramp-find-host method user host)
1156 localname))))))
1157
1158 (defun tramp-buffer-name (vec)
1159 "A name for the connection buffer VEC."
1160 ;; We must use `tramp-file-name-real-host', because for gateway
1161 ;; methods the default port will be expanded later on, which would
1162 ;; tamper the name.
1163 (let ((method (tramp-file-name-method vec))
1164 (user (tramp-file-name-user vec))
1165 (host (tramp-file-name-real-host vec)))
1166 (if (not (zerop (length user)))
1167 (format "*tramp/%s %s@%s*" method user host)
1168 (format "*tramp/%s %s*" method host))))
1169
1170 (defun tramp-make-tramp-file-name (method user host localname)
1171 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
1172 (concat tramp-prefix-format
1173 (when (not (zerop (length method)))
1174 (concat method tramp-postfix-method-format))
1175 (when (not (zerop (length user)))
1176 (concat user tramp-postfix-user-format))
1177 (when host
1178 (if (string-match tramp-ipv6-regexp host)
1179 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
1180 host))
1181 tramp-postfix-host-format
1182 (when localname localname)))
1183
1184 (defun tramp-completion-make-tramp-file-name (method user host localname)
1185 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
1186 It must not be a complete Tramp file name, but as long as there are
1187 necessary only. This function will be used in file name completion."
1188 (concat tramp-prefix-format
1189 (when (not (zerop (length method)))
1190 (concat method tramp-postfix-method-format))
1191 (when (not (zerop (length user)))
1192 (concat user tramp-postfix-user-format))
1193 (when (not (zerop (length host)))
1194 (concat
1195 (if (string-match tramp-ipv6-regexp host)
1196 (concat
1197 tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
1198 host)
1199 tramp-postfix-host-format))
1200 (when localname localname)))
1201
1202 (defun tramp-get-buffer (vec)
1203 "Get the connection buffer to be used for VEC."
1204 (or (get-buffer (tramp-buffer-name vec))
1205 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
1206 (setq buffer-undo-list t)
1207 (setq default-directory
1208 (tramp-make-tramp-file-name
1209 (tramp-file-name-method vec)
1210 (tramp-file-name-user vec)
1211 (tramp-file-name-host vec)
1212 "/"))
1213 (current-buffer))))
1214
1215 (defun tramp-get-connection-buffer (vec)
1216 "Get the connection buffer to be used for VEC.
1217 In case a second asynchronous communication has been started, it is different
1218 from `tramp-get-buffer'."
1219 (or (tramp-get-connection-property vec "process-buffer" nil)
1220 (tramp-get-buffer vec)))
1221
1222 (defun tramp-get-connection-name (vec)
1223 "Get the connection name to be used for VEC.
1224 In case a second asynchronous communication has been started, it is different
1225 from the default one."
1226 (or (tramp-get-connection-property vec "process-name" nil)
1227 (tramp-buffer-name vec)))
1228
1229 (defun tramp-get-connection-process (vec)
1230 "Get the connection process to be used for VEC.
1231 In case a second asynchronous communication has been started, it is different
1232 from the default one."
1233 (get-process (tramp-get-connection-name vec)))
1234
1235 (defun tramp-debug-buffer-name (vec)
1236 "A name for the debug buffer for VEC."
1237 ;; We must use `tramp-file-name-real-host', because for gateway
1238 ;; methods the default port will be expanded later on, which would
1239 ;; tamper the name.
1240 (let ((method (tramp-file-name-method vec))
1241 (user (tramp-file-name-user vec))
1242 (host (tramp-file-name-real-host vec)))
1243 (if (not (zerop (length user)))
1244 (format "*debug tramp/%s %s@%s*" method user host)
1245 (format "*debug tramp/%s %s*" method host))))
1246
1247 (defconst tramp-debug-outline-regexp
1248 "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #"
1249 "Used for highlighting Tramp debug buffers in `outline-mode'.")
1250
1251 (defun tramp-debug-outline-level ()
1252 "Return the depth to which a statement is nested in the outline.
1253 Point must be at the beginning of a header line.
1254
1255 The outline level is equal to the verbosity of the Tramp message."
1256 (1+ (string-to-number (match-string 1))))
1257
1258 (defun tramp-get-debug-buffer (vec)
1259 "Get the debug buffer for VEC."
1260 (with-current-buffer
1261 (get-buffer-create (tramp-debug-buffer-name vec))
1262 (when (bobp)
1263 (setq buffer-undo-list t)
1264 ;; Activate `outline-mode'. This runs `text-mode-hook' and
1265 ;; `outline-mode-hook'. We must prevent that local processes
1266 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
1267 ;; Furthermore, `outline-regexp' must have the correct value
1268 ;; already, because it is used by `font-lock-compile-keywords'.
1269 (let ((default-directory (tramp-compat-temporary-file-directory))
1270 (outline-regexp tramp-debug-outline-regexp))
1271 (outline-mode))
1272 (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
1273 (set (make-local-variable 'outline-level) 'tramp-debug-outline-level))
1274 (current-buffer)))
1275
1276 (defsubst tramp-debug-message (vec fmt-string &rest args)
1277 "Append message to debug buffer.
1278 Message is formatted with FMT-STRING as control string and the remaining
1279 ARGS to actually emit the message (if applicable)."
1280 (when (get-buffer (tramp-buffer-name vec))
1281 (with-current-buffer (tramp-get-debug-buffer vec)
1282 (goto-char (point-max))
1283 ;; Headline.
1284 (when (bobp)
1285 (insert
1286 (format
1287 ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
1288 (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
1289 emacs-version tramp-version)))
1290 (unless (bolp)
1291 (insert "\n"))
1292 ;; Timestamp.
1293 (let ((now (current-time)))
1294 (insert (format-time-string "%T." now))
1295 (insert (format "%06d " (nth 2 now))))
1296 ;; Calling Tramp function. We suppress compat and trace
1297 ;; functions from being displayed.
1298 (let ((btn 1) btf fn)
1299 (while (not fn)
1300 (setq btf (nth 1 (backtrace-frame btn)))
1301 (if (not btf)
1302 (setq fn "")
1303 (when (symbolp btf)
1304 (setq fn (symbol-name btf))
1305 (unless
1306 (and
1307 (string-match "^tramp" fn)
1308 (not
1309 (string-match
1310 (concat
1311 "^"
1312 (regexp-opt
1313 '("tramp-compat-funcall"
1314 "tramp-compat-with-temp-message"
1315 "tramp-debug-message"
1316 "tramp-error"
1317 "tramp-error-with-buffer"
1318 "tramp-message")
1319 t)
1320 "$")
1321 fn)))
1322 (setq fn nil)))
1323 (setq btn (1+ btn))))
1324 ;; The following code inserts filename and line number.
1325 ;; Should be deactivated by default, because it is time
1326 ;; consuming.
1327 ; (let ((ffn (find-function-noselect (intern fn))))
1328 ; (insert
1329 ; (format
1330 ; "%s:%d: "
1331 ; (file-name-nondirectory (buffer-file-name (car ffn)))
1332 ; (with-current-buffer (car ffn)
1333 ; (1+ (count-lines (point-min) (cdr ffn)))))))
1334 (insert (format "%s " fn)))
1335 ;; The message.
1336 (insert (apply 'format fmt-string args)))))
1337
1338 (defvar tramp-message-show-message t
1339 "Show Tramp message in the minibuffer.
1340 This variable is used to disable messages from `tramp-error'.
1341 The messages are visible anyway, because an error is raised.")
1342
1343 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
1344 "Emit a message depending on verbosity level.
1345 VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
1346 vector or a process. LEVEL says to be quiet if `tramp-verbose' is
1347 less than LEVEL. The message is emitted only if `tramp-verbose' is
1348 greater than or equal to LEVEL.
1349
1350 The message is also logged into the debug buffer when `tramp-verbose'
1351 is greater than or equal 4.
1352
1353 Calls functions `message' and `tramp-debug-message' with FMT-STRING as
1354 control string and the remaining ARGS to actually emit the message (if
1355 applicable)."
1356 (ignore-errors
1357 (when (<= level tramp-verbose)
1358 ;; Match data must be preserved!
1359 (save-match-data
1360 ;; Display only when there is a minimum level.
1361 (when (and tramp-message-show-message (<= level 3))
1362 (apply 'message
1363 (concat
1364 (cond
1365 ((= level 0) "")
1366 ((= level 1) "")
1367 ((= level 2) "Warning: ")
1368 (t "Tramp: "))
1369 fmt-string)
1370 args))
1371 ;; Log only when there is a minimum level.
1372 (when (>= tramp-verbose 4)
1373 (when (and vec-or-proc
1374 (processp vec-or-proc)
1375 (buffer-name (process-buffer vec-or-proc)))
1376 (with-current-buffer (process-buffer vec-or-proc)
1377 ;; Translate proc to vec.
1378 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
1379 (when (and vec-or-proc (vectorp vec-or-proc))
1380 (apply 'tramp-debug-message
1381 vec-or-proc
1382 (concat (format "(%d) # " level) fmt-string)
1383 args)))))))
1384
1385 (defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
1386 "Emit an error.
1387 VEC-OR-PROC identifies the connection to use, SIGNAL is the
1388 signal identifier to be raised, remaining args passed to
1389 `tramp-message'. Finally, signal SIGNAL is raised."
1390 (let (tramp-message-show-message)
1391 (tramp-message
1392 vec-or-proc 1 "%s"
1393 (error-message-string
1394 (list signal
1395 (get signal 'error-message)
1396 (apply 'format fmt-string args))))
1397 (signal signal (list (apply 'format fmt-string args)))))
1398
1399 (defsubst tramp-error-with-buffer
1400 (buffer vec-or-proc signal fmt-string &rest args)
1401 "Emit an error, and show BUFFER.
1402 If BUFFER is nil, show the connection buffer. Wait for 30\", or until
1403 an input event arrives. The other arguments are passed to `tramp-error'."
1404 (save-window-excursion
1405 (unwind-protect
1406 (apply 'tramp-error vec-or-proc signal fmt-string args)
1407 (when (and vec-or-proc
1408 (not (zerop tramp-verbose))
1409 (not (tramp-completion-mode-p)))
1410 (let ((enable-recursive-minibuffers t))
1411 (pop-to-buffer
1412 (or (and (bufferp buffer) buffer)
1413 (and (processp vec-or-proc) (process-buffer vec-or-proc))
1414 (tramp-get-buffer vec-or-proc)))
1415 (sit-for 30))))))
1416
1417 (defmacro with-parsed-tramp-file-name (filename var &rest body)
1418 "Parse a Tramp filename and make components available in the body.
1419
1420 First arg FILENAME is evaluated and dissected into its components.
1421 Second arg VAR is a symbol. It is used as a variable name to hold
1422 the filename structure. It is also used as a prefix for the variables
1423 holding the components. For example, if VAR is the symbol `foo', then
1424 `foo' will be bound to the whole structure, `foo-method' will be bound to
1425 the method component, and so on for `foo-user', `foo-host', `foo-localname'.
1426
1427 Remaining args are Lisp expressions to be evaluated (inside an implicit
1428 `progn').
1429
1430 If VAR is nil, then we bind `v' to the structure and `method', `user',
1431 `host', `localname' to the components."
1432 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1433 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
1434 (tramp-file-name-method ,(or var 'v)))
1435 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
1436 (tramp-file-name-user ,(or var 'v)))
1437 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
1438 (tramp-file-name-host ,(or var 'v)))
1439 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
1440 (tramp-file-name-localname ,(or var 'v))))
1441 ,@body))
1442
1443 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
1444 (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
1445 (tramp-compat-font-lock-add-keywords
1446 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
1447
1448 (defun tramp-progress-reporter-update (reporter &optional value)
1449 (let* ((parameters (cdr reporter))
1450 (message (aref parameters 3)))
1451 (when (string-match message (or (current-message) ""))
1452 (tramp-compat-funcall 'progress-reporter-update reporter value))))
1453
1454 (defmacro with-progress-reporter (vec level message &rest body)
1455 "Executes BODY, spinning a progress reporter with MESSAGE.
1456 If LEVEL does not fit for visible messages, or if this is a
1457 nested call of the macro, there are only traces without a visible
1458 progress reporter."
1459 `(let (pr tm)
1460 (tramp-message ,vec ,level "%s..." ,message)
1461 ;; We start a pulsing progress reporter after 3 seconds. Feature
1462 ;; introduced in Emacs 24.1.
1463 (when (and tramp-message-show-message
1464 ;; Display only when there is a minimum level.
1465 (<= ,level (min tramp-verbose 3)))
1466 (ignore-errors
1467 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
1468 tm (when pr
1469 (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
1470 (unwind-protect
1471 ;; Execute the body. Unset `tramp-message-show-message' when
1472 ;; the timer object is created, in order to suppress
1473 ;; concurrent timers.
1474 (let ((tramp-message-show-message
1475 (and tramp-message-show-message (not tm))))
1476 ,@body)
1477 ;; Stop progress reporter.
1478 (if tm (tramp-compat-funcall 'cancel-timer tm))
1479 (tramp-message ,vec ,level "%s...done" ,message))))
1480
1481 (put 'with-progress-reporter 'lisp-indent-function 3)
1482 (put 'with-progress-reporter 'edebug-form-spec t)
1483 (tramp-compat-font-lock-add-keywords
1484 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
1485
1486 (eval-and-compile ;; Silence compiler.
1487 (if (memq system-type '(cygwin windows-nt))
1488 (defun tramp-drop-volume-letter (name)
1489 "Cut off unnecessary drive letter from file NAME.
1490 The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
1491 locally on a remote file name. When the local system is a W32 system
1492 but the remote system is Unix, this introduces a superfluous drive
1493 letter into the file name. This function removes it."
1494 (save-match-data
1495 (if (string-match tramp-root-regexp name)
1496 (replace-match "/" nil t name)
1497 name)))
1498
1499 (defalias 'tramp-drop-volume-letter 'identity)))
1500
1501 ;;; Config Manipulation Functions:
1502
1503 (defun tramp-set-completion-function (method function-list)
1504 "Sets the list of completion functions for METHOD.
1505 FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
1506 The FUNCTION is intended to parse FILE according its syntax.
1507 It might be a predefined FUNCTION, or a user defined FUNCTION.
1508 Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
1509 `tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
1510 and `tramp-parse-netrc'.
1511
1512 Example:
1513
1514 (tramp-set-completion-function
1515 \"ssh\"
1516 '((tramp-parse-sconfig \"/etc/ssh_config\")
1517 (tramp-parse-sconfig \"~/.ssh/config\")))"
1518
1519 (let ((r function-list)
1520 (v function-list))
1521 (setq tramp-completion-function-alist
1522 (delete (assoc method tramp-completion-function-alist)
1523 tramp-completion-function-alist))
1524
1525 (while v
1526 ;; Remove double entries.
1527 (when (member (car v) (cdr v))
1528 (setcdr v (delete (car v) (cdr v))))
1529 ;; Check for function and file or registry key.
1530 (unless (and (functionp (nth 0 (car v)))
1531 (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
1532 ;; Windows registry.
1533 (and (memq system-type '(cygwin windows-nt))
1534 (zerop
1535 (tramp-compat-call-process
1536 "reg" nil nil nil "query" (nth 1 (car v)))))
1537 ;; Configuration file.
1538 (file-exists-p (nth 1 (car v)))))
1539 (setq r (delete (car v) r)))
1540 (setq v (cdr v)))
1541
1542 (when r
1543 (add-to-list 'tramp-completion-function-alist
1544 (cons method r)))))
1545
1546 (defun tramp-get-completion-function (method)
1547 "Returns a list of completion functions for METHOD.
1548 For definition of that list see `tramp-set-completion-function'."
1549 (cons
1550 ;; Hosts visited once shall be remembered.
1551 `(tramp-parse-connection-properties ,method)
1552 ;; The method related defaults.
1553 (cdr (assoc method tramp-completion-function-alist))))
1554
1555
1556 ;;; Fontification of `read-file-name':
1557
1558 ;; rfn-eshadow.el is part of Emacs 22. It is autoloaded.
1559 (defvar tramp-rfn-eshadow-overlay)
1560 (make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
1561
1562 (defun tramp-rfn-eshadow-setup-minibuffer ()
1563 "Set up a minibuffer for `file-name-shadow-mode'.
1564 Adds another overlay hiding filename parts according to Tramp's
1565 special handling of `substitute-in-file-name'."
1566 (when (symbol-value 'minibuffer-completing-file-name)
1567 (setq tramp-rfn-eshadow-overlay
1568 (tramp-compat-funcall
1569 'make-overlay
1570 (tramp-compat-funcall 'minibuffer-prompt-end)
1571 (tramp-compat-funcall 'minibuffer-prompt-end)))
1572 ;; Copy rfn-eshadow-overlay properties.
1573 (let ((props (tramp-compat-funcall
1574 'overlay-properties (symbol-value 'rfn-eshadow-overlay))))
1575 (while props
1576 (tramp-compat-funcall
1577 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))))))
1578
1579 (when (boundp 'rfn-eshadow-setup-minibuffer-hook)
1580 (add-hook 'rfn-eshadow-setup-minibuffer-hook
1581 'tramp-rfn-eshadow-setup-minibuffer)
1582 (add-hook 'tramp-unload-hook
1583 (lambda ()
1584 (remove-hook 'rfn-eshadow-setup-minibuffer-hook
1585 'tramp-rfn-eshadow-setup-minibuffer))))
1586
1587 (defconst tramp-rfn-eshadow-update-overlay-regexp
1588 (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
1589
1590 (defun tramp-rfn-eshadow-update-overlay ()
1591 "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
1592 This is intended to be used as a minibuffer `post-command-hook' for
1593 `file-name-shadow-mode'; the minibuffer should have already
1594 been set up by `rfn-eshadow-setup-minibuffer'."
1595 ;; In remote files name, there is a shadowing just for the local part.
1596 (let ((end (or (tramp-compat-funcall
1597 'overlay-end (symbol-value 'rfn-eshadow-overlay))
1598 (tramp-compat-funcall 'minibuffer-prompt-end))))
1599 (when
1600 (file-remote-p
1601 (tramp-compat-funcall 'buffer-substring-no-properties end (point-max)))
1602 (save-excursion
1603 (save-restriction
1604 (narrow-to-region
1605 (1+ (or (string-match
1606 tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end)
1607 end))
1608 (point-max))
1609 (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
1610 (rfn-eshadow-update-overlay-hook nil))
1611 (tramp-compat-funcall
1612 'move-overlay rfn-eshadow-overlay (point-max) (point-max))
1613 (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))
1614
1615 (when (boundp 'rfn-eshadow-update-overlay-hook)
1616 (add-hook 'rfn-eshadow-update-overlay-hook
1617 'tramp-rfn-eshadow-update-overlay)
1618 (add-hook 'tramp-unload-hook
1619 (lambda ()
1620 (remove-hook 'rfn-eshadow-update-overlay-hook
1621 'tramp-rfn-eshadow-update-overlay))))
1622
1623 ;; Inodes don't exist for some file systems. Therefore we must
1624 ;; generate virtual ones. Used in `find-buffer-visiting'. The method
1625 ;; applied might be not so efficient (Ange-FTP uses hashes). But
1626 ;; performance isn't the major issue given that file transfer will
1627 ;; take time.
1628 (defvar tramp-inodes nil
1629 "Keeps virtual inodes numbers.")
1630
1631 ;; Devices must distinguish physical file systems. The device numbers
1632 ;; provided by "lstat" aren't unique, because we operate on different hosts.
1633 ;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
1634 ;; EFS use device number "-1". In order to be different, we use device number
1635 ;; (-1 . x), whereby "x" is unique for a given (method user host).
1636 (defvar tramp-devices nil
1637 "Keeps virtual device numbers.")
1638
1639 (defun tramp-default-file-modes (filename)
1640 "Return file modes of FILENAME as integer.
1641 If the file modes of FILENAME cannot be determined, return the
1642 value of `default-file-modes', without execute permissions."
1643 (or (file-modes filename)
1644 (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
1645
1646 (defun tramp-replace-environment-variables (filename)
1647 "Replace environment variables in FILENAME.
1648 Return the string with the replaced variables."
1649 (save-match-data
1650 (let ((idx (string-match "$\\(\\w+\\)" filename)))
1651 ;; `$' is coded as `$$'.
1652 (when (and idx
1653 (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
1654 (getenv (match-string 1 filename)))
1655 (setq filename
1656 (replace-match
1657 (substitute-in-file-name (match-string 0 filename))
1658 t nil filename)))
1659 filename)))
1660
1661 ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
1662 ;; which calls corresponding functions (see minibuf.el).
1663 (when (fboundp 'minibuffer-electric-separator)
1664 (mapc
1665 (lambda (x)
1666 (eval
1667 `(defadvice ,x
1668 (around ,(intern (format "tramp-advice-%s" x)) activate)
1669 "Invoke `substitute-in-file-name' for Tramp files."
1670 (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
1671 (tramp-tramp-file-p (buffer-substring)))
1672 ;; We don't need to handle `last-input-event', because
1673 ;; due to the key map we know it must be ?/ or ?~.
1674 (let ((s (concat (buffer-substring (point-min) (point))
1675 (string last-command-char))))
1676 (delete-region (point-min) (point))
1677 (insert (substitute-in-file-name s))
1678 (setq ad-return-value last-command-char))
1679 ad-do-it)))
1680 (eval
1681 `(add-hook
1682 'tramp-unload-hook
1683 (lambda ()
1684 (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x)))
1685 (ad-activate ',x)))))
1686
1687 '(minibuffer-electric-separator
1688 minibuffer-electric-tilde)))
1689
1690 (defun tramp-find-file-name-coding-system-alist (filename tmpname)
1691 "Like `find-operation-coding-system' for Tramp filenames.
1692 Tramp's `insert-file-contents' and `write-region' work over
1693 temporary file names. If `file-coding-system-alist' contains an
1694 expression, which matches more than the file name suffix, the
1695 coding system might not be determined. This function repairs it."
1696 (let (result)
1697 (dolist (elt file-coding-system-alist result)
1698 (when (and (consp elt) (string-match (car elt) filename))
1699 ;; We found a matching entry in `file-coding-system-alist'.
1700 ;; So we add a similar entry, but with the temporary file name
1701 ;; as regexp.
1702 (add-to-list
1703 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
1704
1705 ;;;###autoload
1706 (progn (defun tramp-run-real-handler (operation args)
1707 "Invoke normal file name handler for OPERATION.
1708 First arg specifies the OPERATION, second arg is a list of arguments to
1709 pass to the OPERATION."
1710 (let* ((inhibit-file-name-handlers
1711 `(tramp-file-name-handler
1712 tramp-vc-file-name-handler
1713 tramp-completion-file-name-handler
1714 cygwin-mount-name-hook-function
1715 cygwin-mount-map-drive-hook-function
1716 .
1717 ,(and (eq inhibit-file-name-operation operation)
1718 inhibit-file-name-handlers)))
1719 (inhibit-file-name-operation operation))
1720 (apply operation args))))
1721
1722 ;;;###autoload
1723 (progn (defun tramp-completion-run-real-handler (operation args)
1724 "Invoke `tramp-file-name-handler' for OPERATION.
1725 First arg specifies the OPERATION, second arg is a list of arguments to
1726 pass to the OPERATION."
1727 (let* ((inhibit-file-name-handlers
1728 `(tramp-completion-file-name-handler
1729 cygwin-mount-name-hook-function
1730 cygwin-mount-map-drive-hook-function
1731 .
1732 ,(and (eq inhibit-file-name-operation operation)
1733 inhibit-file-name-handlers)))
1734 (inhibit-file-name-operation operation))
1735 (apply operation args))))
1736
1737 ;; We handle here all file primitives. Most of them have the file
1738 ;; name as first parameter; nevertheless we check for them explicitly
1739 ;; in order to be signaled if a new primitive appears. This
1740 ;; scenario is needed because there isn't a way to decide by
1741 ;; syntactical means whether a foreign method must be called. It would
1742 ;; ease the life if `file-name-handler-alist' would support a decision
1743 ;; function as well but regexp only.
1744 (defun tramp-file-name-for-operation (operation &rest args)
1745 "Return file name related to OPERATION file primitive.
1746 ARGS are the arguments OPERATION has been called with."
1747 (cond
1748 ;; FILE resp DIRECTORY.
1749 ((member operation
1750 (list 'access-file 'byte-compiler-base-file-name 'delete-directory
1751 'delete-file 'diff-latest-backup-file 'directory-file-name
1752 'directory-files 'directory-files-and-attributes
1753 'dired-compress-file 'dired-uncache
1754 'file-accessible-directory-p 'file-attributes
1755 'file-directory-p 'file-executable-p 'file-exists-p
1756 'file-local-copy 'file-remote-p 'file-modes
1757 'file-name-as-directory 'file-name-directory
1758 'file-name-nondirectory 'file-name-sans-versions
1759 'file-ownership-preserved-p 'file-readable-p
1760 'file-regular-p 'file-symlink-p 'file-truename
1761 'file-writable-p 'find-backup-file-name 'find-file-noselect
1762 'get-file-buffer 'insert-directory 'insert-file-contents
1763 'load 'make-directory 'make-directory-internal
1764 'set-file-modes 'substitute-in-file-name
1765 'unhandled-file-name-directory 'vc-registered
1766 ;; Emacs 22+ only.
1767 'set-file-times
1768 ;; Emacs 24+ only.
1769 'file-selinux-context 'set-file-selinux-context
1770 ;; XEmacs only.
1771 'abbreviate-file-name 'create-file-buffer
1772 'dired-file-modtime 'dired-make-compressed-filename
1773 'dired-recursive-delete-directory 'dired-set-file-modtime
1774 'dired-shell-unhandle-file-name 'dired-uucode-file
1775 'insert-file-contents-literally 'make-temp-name 'recover-file
1776 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
1777 (if (file-name-absolute-p (nth 0 args))
1778 (nth 0 args)
1779 (expand-file-name (nth 0 args))))
1780 ;; FILE DIRECTORY resp FILE1 FILE2.
1781 ((member operation
1782 (list 'add-name-to-file 'copy-file 'expand-file-name
1783 'file-name-all-completions 'file-name-completion
1784 'file-newer-than-file-p 'make-symbolic-link 'rename-file
1785 ;; Emacs 23+ only.
1786 'copy-directory
1787 ;; XEmacs only.
1788 'dired-make-relative-symlink
1789 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
1790 (save-match-data
1791 (cond
1792 ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
1793 ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
1794 (t (buffer-file-name (current-buffer))))))
1795 ;; START END FILE.
1796 ((eq operation 'write-region)
1797 (nth 2 args))
1798 ;; BUFFER.
1799 ((member operation
1800 (list 'set-visited-file-modtime 'verify-visited-file-modtime
1801 ;; Emacs 22+ only.
1802 'make-auto-save-file-name
1803 ;; XEmacs only.
1804 'backup-buffer))
1805 (buffer-file-name
1806 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
1807 ;; COMMAND.
1808 ((member operation
1809 (list ;; not in Emacs 23+.
1810 'dired-call-process
1811 ;; Emacs only.
1812 'shell-command
1813 ;; Emacs 22+ only.
1814 'process-file
1815 ;; Emacs 23+ only.
1816 'start-file-process
1817 ;; XEmacs only.
1818 'dired-print-file 'dired-shell-call-process
1819 ;; nowhere yet.
1820 'executable-find 'start-process
1821 'call-process 'call-process-region))
1822 default-directory)
1823 ;; Unknown file primitive.
1824 (t (error "unknown file I/O primitive: %s" operation))))
1825
1826 (defun tramp-find-foreign-file-name-handler (filename)
1827 "Return foreign file name handler if exists."
1828 (when (tramp-tramp-file-p filename)
1829 (let ((v (tramp-dissect-file-name filename t))
1830 (handler tramp-foreign-file-name-handler-alist)
1831 elt res)
1832 ;; When we are not fully sure that filename completion is safe,
1833 ;; we should not return a handler.
1834 (when (or (tramp-file-name-method v) (tramp-file-name-user v)
1835 (and (tramp-file-name-host v)
1836 (not (member (tramp-file-name-host v)
1837 (mapcar 'car tramp-methods))))
1838 (not (tramp-completion-mode-p)))
1839 (while handler
1840 (setq elt (car handler)
1841 handler (cdr handler))
1842 (when (funcall (car elt) filename)
1843 (setq handler nil
1844 res (cdr elt))))
1845 res))))
1846
1847 ;; Main function.
1848 ;;;###autoload
1849 (defun tramp-file-name-handler (operation &rest args)
1850 "Invoke Tramp file name handler.
1851 Falls back to normal file name handler if no Tramp file name handler exists."
1852 (if tramp-mode
1853 (save-match-data
1854 (let* ((filename
1855 (tramp-replace-environment-variables
1856 (apply 'tramp-file-name-for-operation operation args)))
1857 (completion (tramp-completion-mode-p))
1858 (foreign (tramp-find-foreign-file-name-handler filename)))
1859 (with-parsed-tramp-file-name filename nil
1860 ;; Call the backend function.
1861 (if foreign
1862 (condition-case err
1863 (apply foreign operation args)
1864
1865 ;; Trace, that somebody has interrupted the operation.
1866 (quit
1867 (let (tramp-message-show-message)
1868 (tramp-message
1869 v 1 "Interrupt received in operation %s"
1870 (append (list operation) args)))
1871 ;; Propagate the quit signal.
1872 (signal (car err) (cdr err)))
1873
1874 ;; When we are in completion mode, some failed
1875 ;; operations shall return at least a default value
1876 ;; in order to give the user a chance to correct the
1877 ;; file name in the minibuffer.
1878 (error
1879 (cond
1880 ((and completion (zerop (length localname))
1881 (memq operation '(file-exists-p file-directory-p)))
1882 t)
1883 ((and completion (zerop (length localname))
1884 (memq operation
1885 '(expand-file-name file-name-as-directory)))
1886 filename)
1887 ;; Propagate the error.
1888 (t (signal (car err) (cdr err))))))
1889
1890 ;; Nothing to do for us.
1891 (tramp-run-real-handler operation args)))))
1892
1893 ;; When `tramp-mode' is not enabled, we don't do anything.
1894 (tramp-run-real-handler operation args)))
1895
1896 ;; In Emacs, there is some concurrency due to timers. If a timer
1897 ;; interrupts Tramp and wishes to use the same connection buffer as
1898 ;; the "main" Emacs, then garbage might occur in the connection
1899 ;; buffer. Therefore, we need to make sure that a timer does not use
1900 ;; the same connection buffer as the "main" Emacs. We implement a
1901 ;; cheap global lock, instead of locking each connection buffer
1902 ;; separately. The global lock is based on two variables,
1903 ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
1904 ;; (with setq) to indicate a lock. But Tramp also calls itself during
1905 ;; processing of a single file operation, so we need to allow
1906 ;; recursive calls. That's where the `tramp-locker' variable comes in
1907 ;; -- it is let-bound to t during the execution of the current
1908 ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
1909 ;; then we should just proceed because we have been called
1910 ;; recursively. But if `tramp-locker' is nil, then we are a timer
1911 ;; interrupting the "main" Emacs, and then we signal an error.
1912
1913 (defvar tramp-locked nil
1914 "If non-nil, then Tramp is currently busy.
1915 Together with `tramp-locker', this implements a locking mechanism
1916 preventing reentrant calls of Tramp.")
1917
1918 (defvar tramp-locker nil
1919 "If non-nil, then a caller has locked Tramp.
1920 Together with `tramp-locked', this implements a locking mechanism
1921 preventing reentrant calls of Tramp.")
1922
1923 ;;;###autoload
1924 (progn (defun tramp-completion-file-name-handler (operation &rest args)
1925 "Invoke Tramp file name completion handler.
1926 Falls back to normal file name handler if no Tramp file name handler exists."
1927 ;; We bind `directory-sep-char' here for XEmacs on Windows, which
1928 ;; would otherwise use backslash.
1929 (let ((directory-sep-char ?/)
1930 (fn (assoc operation tramp-completion-file-name-handler-alist)))
1931 (if (and
1932 ;; When `tramp-mode' is not enabled, we don't do anything.
1933 fn tramp-mode
1934 ;; For other syntaxes than `sep', the regexp matches many common
1935 ;; situations where the user doesn't actually want to use Tramp.
1936 ;; So to avoid autoloading Tramp after typing just "/s", we
1937 ;; disable this part of the completion, unless the user implicitly
1938 ;; indicated his interest in using a fancier completion system.
1939 (or (eq tramp-syntax 'sep)
1940 (featurep 'tramp) ;; If it's loaded, we may as well use it.
1941 ;; `partial-completion-mode' does not exist in XEmacs.
1942 ;; It is obsoleted with Emacs 24.1.
1943 (and (boundp 'partial-completion-mode)
1944 (symbol-value 'partial-completion-mode))
1945 ;; FIXME: These may have been loaded even if the user never
1946 ;; intended to use them.
1947 (featurep 'ido)
1948 (featurep 'icicles)))
1949 (save-match-data (apply (cdr fn) args))
1950 (tramp-completion-run-real-handler operation args)))))
1951
1952 ;;;###autoload
1953 (progn (defun tramp-register-file-name-handlers ()
1954 "Add Tramp file name handlers to `file-name-handler-alist'."
1955 ;; Remove autoloaded handlers from file name handler alist. Useful,
1956 ;; if `tramp-syntax' has been changed.
1957 (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
1958 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
1959 (let ((a1 (rassq
1960 'tramp-completion-file-name-handler file-name-handler-alist)))
1961 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
1962 ;; Add the handlers.
1963 (add-to-list 'file-name-handler-alist
1964 (cons tramp-file-name-regexp 'tramp-file-name-handler))
1965 (put 'tramp-file-name-handler 'safe-magic t)
1966 (add-to-list 'file-name-handler-alist
1967 (cons tramp-completion-file-name-regexp
1968 'tramp-completion-file-name-handler))
1969 (put 'tramp-completion-file-name-handler 'safe-magic t)
1970 ;; If jka-compr or epa-file are already loaded, move them to the
1971 ;; front of `file-name-handler-alist'.
1972 (dolist (fnh '(epa-file-handler jka-compr-handler))
1973 (let ((entry (rassoc fnh file-name-handler-alist)))
1974 (when entry
1975 (setq file-name-handler-alist
1976 (cons entry (delete entry file-name-handler-alist))))))))
1977
1978 ;; `tramp-file-name-handler' must be registered before evaluation of
1979 ;; site-start and init files, because there might exist remote files
1980 ;; already, f.e. files kept via recentf-mode.
1981 ;;;###autoload
1982 (tramp-register-file-name-handlers)
1983
1984 (defun tramp-exists-file-name-handler (operation &rest args)
1985 "Check, whether OPERATION runs a file name handler."
1986 ;; The file name handler is determined on base of either an
1987 ;; argument, `buffer-file-name', or `default-directory'.
1988 (ignore-errors
1989 (let* ((buffer-file-name "/")
1990 (default-directory "/")
1991 (fnha file-name-handler-alist)
1992 (check-file-name-operation operation)
1993 (file-name-handler-alist
1994 (list
1995 (cons "/"
1996 (lambda (operation &rest args)
1997 "Returns OPERATION if it is the one to be checked."
1998 (if (equal check-file-name-operation operation)
1999 operation
2000 (let ((file-name-handler-alist fnha))
2001 (apply operation args))))))))
2002 (equal (apply operation args) operation))))
2003
2004 ;;;###autoload
2005 (defun tramp-unload-file-name-handlers ()
2006 (setq file-name-handler-alist
2007 (delete (rassoc 'tramp-file-name-handler
2008 file-name-handler-alist)
2009 (delete (rassoc 'tramp-completion-file-name-handler
2010 file-name-handler-alist)
2011 file-name-handler-alist))))
2012
2013 (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
2014
2015 ;;; File name handler functions for completion mode:
2016
2017 (defvar tramp-completion-mode nil
2018 "If non-nil, external packages signal that they are in file name completion.
2019
2020 This is necessary, because Tramp uses a heuristic depending on last
2021 input event. This fails when external packages use other characters
2022 but <TAB>, <SPACE> or ?\\? for file name completion. This variable
2023 should never be set globally, the intention is to let-bind it.")
2024
2025 ;; Necessary because `tramp-file-name-regexp-unified' and
2026 ;; `tramp-completion-file-name-regexp-unified' aren't different. If
2027 ;; nil, `tramp-completion-run-real-handler' is called (i.e. forwarding
2028 ;; to `tramp-file-name-handler'). Otherwise, it takes
2029 ;; `tramp-run-real-handler'. Using `last-input-event' is a little bit
2030 ;; risky, because completing a file might require loading other files,
2031 ;; like "~/.netrc", and for them it shouldn't be decided based on that
2032 ;; variable. On the other hand, those files shouldn't have partial
2033 ;; Tramp file name syntax. Maybe another variable should be introduced
2034 ;; overwriting this check in such cases. Or we change Tramp file name
2035 ;; syntax in order to avoid ambiguities, like in XEmacs ...
2036 ;;;###tramp-autoload
2037 (defun tramp-completion-mode-p ()
2038 "Check, whether method / user name / host name completion is active."
2039 (or
2040 ;; Signal from outside. `non-essential' has been introduced in Emacs 24.
2041 (and (boundp 'non-essential) (symbol-value 'non-essential))
2042 tramp-completion-mode
2043 ;; Emacs.
2044 (equal last-input-event 'tab)
2045 (and (natnump last-input-event)
2046 (or
2047 ;; ?\t has event-modifier 'control.
2048 (equal last-input-event ?\t)
2049 (and (not (event-modifiers last-input-event))
2050 (or (equal last-input-event ?\?)
2051 (equal last-input-event ?\ )))))
2052 ;; XEmacs.
2053 (and (featurep 'xemacs)
2054 ;; `last-input-event' might be nil.
2055 (not (null last-input-event))
2056 ;; `last-input-event' may have no character approximation.
2057 (tramp-compat-funcall 'event-to-character last-input-event)
2058 (or
2059 ;; ?\t has event-modifier 'control.
2060 (equal
2061 (tramp-compat-funcall 'event-to-character last-input-event) ?\t)
2062 (and (not (event-modifiers last-input-event))
2063 (or (equal
2064 (tramp-compat-funcall 'event-to-character last-input-event)
2065 ?\?)
2066 (equal
2067 (tramp-compat-funcall 'event-to-character last-input-event)
2068 ?\ )))))))
2069
2070 (defun tramp-connectable-p (filename)
2071 "Check, whether it is possible to connect the remote host w/o side-effects.
2072 This is true, if either the remote host is already connected, or if we are
2073 not in completion mode."
2074 (and (tramp-tramp-file-p filename)
2075 (with-parsed-tramp-file-name filename nil
2076 (or (get-buffer (tramp-buffer-name v))
2077 (not (tramp-completion-mode-p))))))
2078
2079 ;; Method, host name and user name completion.
2080 ;; `tramp-completion-dissect-file-name' returns a list of
2081 ;; tramp-file-name structures. For all of them we return possible completions.
2082 ;;;###autoload
2083 (defun tramp-completion-handle-file-name-all-completions (filename directory)
2084 "Like `file-name-all-completions' for partial Tramp files."
2085
2086 (let* ((fullname (tramp-drop-volume-letter
2087 (expand-file-name filename directory)))
2088 ;; Possible completion structures.
2089 (v (tramp-completion-dissect-file-name fullname))
2090 result result1)
2091
2092 (while v
2093 (let* ((car (car v))
2094 (method (tramp-file-name-method car))
2095 (user (tramp-file-name-user car))
2096 (host (tramp-file-name-host car))
2097 (localname (tramp-file-name-localname car))
2098 (m (tramp-find-method method user host))
2099 (tramp-current-user user) ; see `tramp-parse-passwd'
2100 all-user-hosts)
2101
2102 (unless localname ;; Nothing to complete.
2103
2104 (if (or user host)
2105
2106 ;; Method dependent user / host combinations.
2107 (progn
2108 (mapc
2109 (lambda (x)
2110 (setq all-user-hosts
2111 (append all-user-hosts
2112 (funcall (nth 0 x) (nth 1 x)))))
2113 (tramp-get-completion-function m))
2114
2115 (setq result
2116 (append result
2117 (mapcar
2118 (lambda (x)
2119 (tramp-get-completion-user-host
2120 method user host (nth 0 x) (nth 1 x)))
2121 (delq nil all-user-hosts)))))
2122
2123 ;; Possible methods.
2124 (setq result
2125 (append result (tramp-get-completion-methods m)))))
2126
2127 (setq v (cdr v))))
2128
2129 ;; Unify list, remove nil elements.
2130 (while result
2131 (let ((car (car result)))
2132 (when car
2133 (add-to-list
2134 'result1
2135 (substring car (length (tramp-drop-volume-letter directory)))))
2136 (setq result (cdr result))))
2137
2138 ;; Complete local parts.
2139 (append
2140 result1
2141 (ignore-errors
2142 (apply (if (tramp-connectable-p fullname)
2143 'tramp-completion-run-real-handler
2144 'tramp-run-real-handler)
2145 'file-name-all-completions (list (list filename directory)))))))
2146
2147 ;; Method, host name and user name completion for a file.
2148 ;;;###autoload
2149 (defun tramp-completion-handle-file-name-completion
2150 (filename directory &optional predicate)
2151 "Like `file-name-completion' for Tramp files."
2152 (try-completion
2153 filename
2154 (mapcar 'list (file-name-all-completions filename directory))
2155 (when (and predicate
2156 (tramp-connectable-p (expand-file-name filename directory)))
2157 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
2158
2159 ;; I misuse a little bit the tramp-file-name structure in order to handle
2160 ;; completion possibilities for partial methods / user names / host names.
2161 ;; Return value is a list of tramp-file-name structures according to possible
2162 ;; completions. If "localname" is non-nil it means there
2163 ;; shouldn't be a completion anymore.
2164
2165 ;; Expected results:
2166
2167 ;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
2168 ;; [nil nil "x" nil] [nil "x" nil nil] [nil "x" "y" nil]
2169 ;; [nil "x" nil nil]
2170 ;; ["x" nil nil nil]
2171
2172 ;; "/x:" "/x:y" "/x:y:"
2173 ;; [nil nil "x" ""] [nil nil "x" "y"] ["x" nil "y" ""]
2174 ;; "/[x/" "/[x/y"
2175 ;; ["x" nil "" nil] ["x" nil "y" nil]
2176 ;; ["x" "" nil nil] ["x" "y" nil nil]
2177
2178 ;; "/x:y@" "/x:y@z" "/x:y@z:"
2179 ;; [nil nil "x" "y@"] [nil nil "x" "y@z"] ["x" "y" "z" ""]
2180 ;; "/[x/y@" "/[x/y@z"
2181 ;; ["x" nil "y" nil] ["x" "y" "z" nil]
2182 (defun tramp-completion-dissect-file-name (name)
2183 "Returns a list of `tramp-file-name' structures.
2184 They are collected by `tramp-completion-dissect-file-name1'."
2185
2186 (let* ((result)
2187 (x-nil "\\|\\(\\)")
2188 (tramp-completion-ipv6-regexp
2189 (format
2190 "[^%s]*"
2191 (if (zerop (length tramp-postfix-ipv6-format))
2192 tramp-postfix-host-format
2193 tramp-postfix-ipv6-format)))
2194 ;; "/method" "/[method"
2195 (tramp-completion-file-name-structure1
2196 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
2197 1 nil nil nil))
2198 ;; "/user" "/[user"
2199 (tramp-completion-file-name-structure2
2200 (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$")
2201 nil 1 nil nil))
2202 ;; "/host" "/[host"
2203 (tramp-completion-file-name-structure3
2204 (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$")
2205 nil nil 1 nil))
2206 ;; "/[ipv6" "/[ipv6"
2207 (tramp-completion-file-name-structure4
2208 (list (concat tramp-prefix-regexp
2209 tramp-prefix-ipv6-regexp
2210 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2211 nil nil 1 nil))
2212 ;; "/user@host" "/[user@host"
2213 (tramp-completion-file-name-structure5
2214 (list (concat tramp-prefix-regexp
2215 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2216 "\\(" tramp-host-regexp x-nil "\\)$")
2217 nil 1 2 nil))
2218 ;; "/user@[ipv6" "/[user@ipv6"
2219 (tramp-completion-file-name-structure6
2220 (list (concat tramp-prefix-regexp
2221 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2222 tramp-prefix-ipv6-regexp
2223 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2224 nil 1 2 nil))
2225 ;; "/method:user" "/[method/user" "/method://user"
2226 (tramp-completion-file-name-structure7
2227 (list (concat tramp-prefix-regexp
2228 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
2229 "\\(" tramp-user-regexp x-nil "\\)$")
2230 1 2 nil nil))
2231 ;; "/method:host" "/[method/host" "/method://host"
2232 (tramp-completion-file-name-structure8
2233 (list (concat tramp-prefix-regexp
2234 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
2235 "\\(" tramp-host-regexp x-nil "\\)$")
2236 1 nil 2 nil))
2237 ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
2238 (tramp-completion-file-name-structure9
2239 (list (concat tramp-prefix-regexp
2240 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
2241 tramp-prefix-ipv6-regexp
2242 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2243 1 nil 2 nil))
2244 ;; "/method:user@host" "/[method/user@host" "/method://user@host"
2245 (tramp-completion-file-name-structure10
2246 (list (concat tramp-prefix-regexp
2247 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
2248 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2249 "\\(" tramp-host-regexp x-nil "\\)$")
2250 1 2 3 nil))
2251 ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
2252 (tramp-completion-file-name-structure11
2253 (list (concat tramp-prefix-regexp
2254 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
2255 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
2256 tramp-prefix-ipv6-regexp
2257 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
2258 1 2 3 nil))
2259 ;; "/method: "/method:/"
2260 (tramp-completion-file-name-structure12
2261 (list
2262 (if (equal tramp-syntax 'url)
2263 (concat tramp-prefix-regexp
2264 "\\(" tramp-method-regexp "\\)"
2265 "\\(" (substring tramp-postfix-method-regexp 0 1)
2266 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
2267 "\\(" "\\)$")
2268 ;; Should not match if not URL syntax.
2269 (concat tramp-prefix-regexp "/$"))
2270 1 3 nil nil))
2271 ;; "/method: "/method:/"
2272 (tramp-completion-file-name-structure13
2273 (list
2274 (if (equal tramp-syntax 'url)
2275 (concat tramp-prefix-regexp
2276 "\\(" tramp-method-regexp "\\)"
2277 "\\(" (substring tramp-postfix-method-regexp 0 1)
2278 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
2279 "\\(" "\\)$")
2280 ;; Should not match if not URL syntax.
2281 (concat tramp-prefix-regexp "/$"))
2282 1 nil 3 nil)))
2283
2284 (mapc (lambda (regexp)
2285 (add-to-list 'result
2286 (tramp-completion-dissect-file-name1 regexp name)))
2287 (list
2288 tramp-completion-file-name-structure1
2289 tramp-completion-file-name-structure2
2290 tramp-completion-file-name-structure3
2291 tramp-completion-file-name-structure4
2292 tramp-completion-file-name-structure5
2293 tramp-completion-file-name-structure6
2294 tramp-completion-file-name-structure7
2295 tramp-completion-file-name-structure8
2296 tramp-completion-file-name-structure9
2297 tramp-completion-file-name-structure10
2298 tramp-completion-file-name-structure11
2299 tramp-completion-file-name-structure12
2300 tramp-completion-file-name-structure13
2301 tramp-file-name-structure))
2302
2303 (delq nil result)))
2304
2305 (defun tramp-completion-dissect-file-name1 (structure name)
2306 "Returns a `tramp-file-name' structure matching STRUCTURE.
2307 The structure consists of remote method, remote user,
2308 remote host and localname (filename on remote host)."
2309
2310 (save-match-data
2311 (when (string-match (nth 0 structure) name)
2312 (let ((method (and (nth 1 structure)
2313 (match-string (nth 1 structure) name)))
2314 (user (and (nth 2 structure)
2315 (match-string (nth 2 structure) name)))
2316 (host (and (nth 3 structure)
2317 (match-string (nth 3 structure) name)))
2318 (localname (and (nth 4 structure)
2319 (match-string (nth 4 structure) name))))
2320 (vector method user host localname)))))
2321
2322 ;; This function returns all possible method completions, adding the
2323 ;; trailing method delimeter.
2324 (defun tramp-get-completion-methods (partial-method)
2325 "Returns all method completions for PARTIAL-METHOD."
2326 (mapcar
2327 (lambda (method)
2328 (and method
2329 (string-match (concat "^" (regexp-quote partial-method)) method)
2330 (tramp-completion-make-tramp-file-name method nil nil nil)))
2331 (mapcar 'car tramp-methods)))
2332
2333 ;; Compares partial user and host names with possible completions.
2334 (defun tramp-get-completion-user-host (method partial-user partial-host user host)
2335 "Returns the most expanded string for user and host name completion.
2336 PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
2337 (cond
2338
2339 ((and partial-user partial-host)
2340 (if (and host
2341 (string-match (concat "^" (regexp-quote partial-host)) host)
2342 (string-equal partial-user (or user partial-user)))
2343 (setq user partial-user)
2344 (setq user nil
2345 host nil)))
2346
2347 (partial-user
2348 (setq host nil)
2349 (unless
2350 (and user (string-match (concat "^" (regexp-quote partial-user)) user))
2351 (setq user nil)))
2352
2353 (partial-host
2354 (setq user nil)
2355 (unless
2356 (and host (string-match (concat "^" (regexp-quote partial-host)) host))
2357 (setq host nil)))
2358
2359 (t (setq user nil
2360 host nil)))
2361
2362 (unless (zerop (+ (length user) (length host)))
2363 (tramp-completion-make-tramp-file-name method user host nil)))
2364
2365 (defun tramp-parse-rhosts (filename)
2366 "Return a list of (user host) tuples allowed to access.
2367 Either user or host may be nil."
2368 ;; On Windows, there are problems in completion when
2369 ;; `default-directory' is remote.
2370 (let ((default-directory (tramp-compat-temporary-file-directory))
2371 res)
2372 (when (file-readable-p filename)
2373 (with-temp-buffer
2374 (insert-file-contents filename)
2375 (goto-char (point-min))
2376 (while (not (eobp))
2377 (push (tramp-parse-rhosts-group) res))))
2378 res))
2379
2380 (defun tramp-parse-rhosts-group ()
2381 "Return a (user host) tuple allowed to access.
2382 Either user or host may be nil."
2383 (let ((result)
2384 (regexp
2385 (concat
2386 "^\\(" tramp-host-regexp "\\)"
2387 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2388 (narrow-to-region (point) (point-at-eol))
2389 (when (re-search-forward regexp nil t)
2390 (setq result (append (list (match-string 3) (match-string 1)))))
2391 (widen)
2392 (forward-line 1)
2393 result))
2394
2395 (defun tramp-parse-shosts (filename)
2396 "Return a list of (user host) tuples allowed to access.
2397 User is always nil."
2398 ;; On Windows, there are problems in completion when
2399 ;; `default-directory' is remote.
2400 (let ((default-directory (tramp-compat-temporary-file-directory))
2401 res)
2402 (when (file-readable-p filename)
2403 (with-temp-buffer
2404 (insert-file-contents filename)
2405 (goto-char (point-min))
2406 (while (not (eobp))
2407 (push (tramp-parse-shosts-group) res))))
2408 res))
2409
2410 (defun tramp-parse-shosts-group ()
2411 "Return a (user host) tuple allowed to access.
2412 User is always nil."
2413 (let ((result)
2414 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
2415 (narrow-to-region (point) (point-at-eol))
2416 (when (re-search-forward regexp nil t)
2417 (setq result (list nil (match-string 1))))
2418 (widen)
2419 (or
2420 (> (skip-chars-forward ",") 0)
2421 (forward-line 1))
2422 result))
2423
2424 (defun tramp-parse-sconfig (filename)
2425 "Return a list of (user host) tuples allowed to access.
2426 User is always nil."
2427 ;; On Windows, there are problems in completion when
2428 ;; `default-directory' is remote.
2429 (let ((default-directory (tramp-compat-temporary-file-directory))
2430 res)
2431 (when (file-readable-p filename)
2432 (with-temp-buffer
2433 (insert-file-contents filename)
2434 (goto-char (point-min))
2435 (while (not (eobp))
2436 (push (tramp-parse-sconfig-group) res))))
2437 res))
2438
2439 (defun tramp-parse-sconfig-group ()
2440 "Return a (user host) tuple allowed to access.
2441 User is always nil."
2442 (let ((result)
2443 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
2444 (narrow-to-region (point) (point-at-eol))
2445 (when (re-search-forward regexp nil t)
2446 (setq result (list nil (match-string 1))))
2447 (widen)
2448 (or
2449 (> (skip-chars-forward ",") 0)
2450 (forward-line 1))
2451 result))
2452
2453 (defun tramp-parse-shostkeys (dirname)
2454 "Return a list of (user host) tuples allowed to access.
2455 User is always nil."
2456 ;; On Windows, there are problems in completion when
2457 ;; `default-directory' is remote.
2458 (let* ((default-directory (tramp-compat-temporary-file-directory))
2459 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
2460 (files (when (file-directory-p dirname) (directory-files dirname)))
2461 result)
2462 (while files
2463 (when (string-match regexp (car files))
2464 (push (list nil (match-string 1 (car files))) result))
2465 (setq files (cdr files)))
2466 result))
2467
2468 (defun tramp-parse-sknownhosts (dirname)
2469 "Return a list of (user host) tuples allowed to access.
2470 User is always nil."
2471 ;; On Windows, there are problems in completion when
2472 ;; `default-directory' is remote.
2473 (let* ((default-directory (tramp-compat-temporary-file-directory))
2474 (regexp (concat "^\\(" tramp-host-regexp
2475 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
2476 (files (when (file-directory-p dirname) (directory-files dirname)))
2477 result)
2478 (while files
2479 (when (string-match regexp (car files))
2480 (push (list nil (match-string 1 (car files))) result))
2481 (setq files (cdr files)))
2482 result))
2483
2484 (defun tramp-parse-hosts (filename)
2485 "Return a list of (user host) tuples allowed to access.
2486 User is always nil."
2487 ;; On Windows, there are problems in completion when
2488 ;; `default-directory' is remote.
2489 (let ((default-directory (tramp-compat-temporary-file-directory))
2490 res)
2491 (when (file-readable-p filename)
2492 (with-temp-buffer
2493 (insert-file-contents filename)
2494 (goto-char (point-min))
2495 (while (not (eobp))
2496 (push (tramp-parse-hosts-group) res))))
2497 res))
2498
2499 (defun tramp-parse-hosts-group ()
2500 "Return a (user host) tuple allowed to access.
2501 User is always nil."
2502 (let ((result)
2503 (regexp
2504 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
2505 (narrow-to-region (point) (point-at-eol))
2506 (when (re-search-forward regexp nil t)
2507 (setq result (list nil (match-string 1))))
2508 (widen)
2509 (or
2510 (> (skip-chars-forward " \t") 0)
2511 (forward-line 1))
2512 result))
2513
2514 ;; For su-alike methods it would be desirable to return "root@localhost"
2515 ;; as default. Unfortunately, we have no information whether any user name
2516 ;; has been typed already. So we use `tramp-current-user' as indication,
2517 ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
2518 (defun tramp-parse-passwd (filename)
2519 "Return a list of (user host) tuples allowed to access.
2520 Host is always \"localhost\"."
2521 ;; On Windows, there are problems in completion when
2522 ;; `default-directory' is remote.
2523 (let ((default-directory (tramp-compat-temporary-file-directory))
2524 res)
2525 (if (zerop (length tramp-current-user))
2526 '(("root" nil))
2527 (when (file-readable-p filename)
2528 (with-temp-buffer
2529 (insert-file-contents filename)
2530 (goto-char (point-min))
2531 (while (not (eobp))
2532 (push (tramp-parse-passwd-group) res))))
2533 res)))
2534
2535 (defun tramp-parse-passwd-group ()
2536 "Return a (user host) tuple allowed to access.
2537 Host is always \"localhost\"."
2538 (let ((result)
2539 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
2540 (narrow-to-region (point) (point-at-eol))
2541 (when (re-search-forward regexp nil t)
2542 (setq result (list (match-string 1) "localhost")))
2543 (widen)
2544 (forward-line 1)
2545 result))
2546
2547 (defun tramp-parse-netrc (filename)
2548 "Return a list of (user host) tuples allowed to access.
2549 User may be nil."
2550 ;; On Windows, there are problems in completion when
2551 ;; `default-directory' is remote.
2552 (let ((default-directory (tramp-compat-temporary-file-directory))
2553 res)
2554 (when (file-readable-p filename)
2555 (with-temp-buffer
2556 (insert-file-contents filename)
2557 (goto-char (point-min))
2558 (while (not (eobp))
2559 (push (tramp-parse-netrc-group) res))))
2560 res))
2561
2562 (defun tramp-parse-netrc-group ()
2563 "Return a (user host) tuple allowed to access.
2564 User may be nil."
2565 (let ((result)
2566 (regexp
2567 (concat
2568 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
2569 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
2570 (narrow-to-region (point) (point-at-eol))
2571 (when (re-search-forward regexp nil t)
2572 (setq result (list (match-string 3) (match-string 1))))
2573 (widen)
2574 (forward-line 1)
2575 result))
2576
2577 (defun tramp-parse-putty (registry)
2578 "Return a list of (user host) tuples allowed to access.
2579 User is always nil."
2580 ;; On Windows, there are problems in completion when
2581 ;; `default-directory' is remote.
2582 (let ((default-directory (tramp-compat-temporary-file-directory))
2583 res)
2584 (with-temp-buffer
2585 (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
2586 (goto-char (point-min))
2587 (while (not (eobp))
2588 (push (tramp-parse-putty-group registry) res))))
2589 res))
2590
2591 (defun tramp-parse-putty-group (registry)
2592 "Return a (user host) tuple allowed to access.
2593 User is always nil."
2594 (let ((result)
2595 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
2596 (narrow-to-region (point) (point-at-eol))
2597 (when (re-search-forward regexp nil t)
2598 (setq result (list nil (match-string 1))))
2599 (widen)
2600 (forward-line 1)
2601 result))
2602
2603 ;;; Common file name handler functions for different backends:
2604
2605 (defvar tramp-handle-file-local-copy-hook nil
2606 "Normal hook to be run at the end of `tramp-*-handle-file-local-copy'.")
2607
2608 (defvar tramp-handle-write-region-hook nil
2609 "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
2610
2611 (defun tramp-handle-directory-file-name (directory)
2612 "Like `directory-file-name' for Tramp files."
2613 ;; If localname component of filename is "/", leave it unchanged.
2614 ;; Otherwise, remove any trailing slash from localname component.
2615 ;; Method, host, etc, are unchanged. Does it make sense to try
2616 ;; to avoid parsing the filename?
2617 (with-parsed-tramp-file-name directory nil
2618 (if (and (not (zerop (length localname)))
2619 (eq (aref localname (1- (length localname))) ?/)
2620 (not (string= localname "/")))
2621 (substring directory 0 -1)
2622 directory)))
2623
2624 (defun tramp-handle-directory-files
2625 (directory &optional full match nosort files-only)
2626 "Like `directory-files' for Tramp files."
2627 ;; FILES-ONLY is valid for XEmacs only.
2628 (when (file-directory-p directory)
2629 (setq directory (file-name-as-directory (expand-file-name directory)))
2630 (let ((temp (nreverse (file-name-all-completions "" directory)))
2631 result item)
2632
2633 (while temp
2634 (setq item (directory-file-name (pop temp)))
2635 (when (and (or (null match) (string-match match item))
2636 (or (null files-only)
2637 ;; Files only.
2638 (and (equal files-only t) (file-regular-p item))
2639 ;; Directories only.
2640 (file-directory-p item)))
2641 (push (if full (concat directory item) item)
2642 result)))
2643 (if nosort result (sort result 'string<)))))
2644
2645 (defun tramp-handle-directory-files-and-attributes
2646 (directory &optional full match nosort id-format)
2647 "Like `directory-files-and-attributes' for Tramp files."
2648 (mapcar
2649 (lambda (x)
2650 (cons x (tramp-compat-file-attributes
2651 (if full x (expand-file-name x directory)) id-format)))
2652 (directory-files directory full match nosort)))
2653
2654 (defun tramp-handle-dired-uncache (dir &optional dir-p)
2655 "Like `dired-uncache' for Tramp files."
2656 ;; DIR-P is valid for XEmacs only.
2657 (with-parsed-tramp-file-name
2658 (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
2659 (tramp-flush-directory-property v localname)))
2660
2661 (defun tramp-handle-file-exists-p (filename)
2662 "Like `file-exists-p' for Tramp files."
2663 (not (null (file-attributes filename))))
2664
2665 (defun tramp-handle-file-modes (filename)
2666 "Like `file-modes' for Tramp files."
2667 (let ((truename (or (file-truename filename) filename)))
2668 (when (file-exists-p truename)
2669 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
2670
2671 ;; Localname manipulation functions that grok Tramp localnames...
2672 (defun tramp-handle-file-name-as-directory (file)
2673 "Like `file-name-as-directory' but aware of Tramp files."
2674 ;; `file-name-as-directory' would be sufficient except localname is
2675 ;; the empty string.
2676 (let ((v (tramp-dissect-file-name file t)))
2677 ;; Run the command on the localname portion only.
2678 (tramp-make-tramp-file-name
2679 (tramp-file-name-method v)
2680 (tramp-file-name-user v)
2681 (tramp-file-name-host v)
2682 (tramp-run-real-handler
2683 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
2684
2685 (defun tramp-handle-file-name-completion
2686 (filename directory &optional predicate)
2687 "Like `file-name-completion' for Tramp files."
2688 (unless (tramp-tramp-file-p directory)
2689 (error
2690 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2691 directory))
2692 (try-completion
2693 filename
2694 (mapcar 'list (file-name-all-completions filename directory))
2695 (when predicate
2696 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
2697
2698 (defun tramp-handle-file-name-directory (file)
2699 "Like `file-name-directory' but aware of Tramp files."
2700 ;; Everything except the last filename thing is the directory. We
2701 ;; cannot apply `with-parsed-tramp-file-name', because this expands
2702 ;; the remote file name parts. This is a problem when we are in
2703 ;; file name completion.
2704 (let ((v (tramp-dissect-file-name file t)))
2705 ;; Run the command on the localname portion only.
2706 (tramp-make-tramp-file-name
2707 (tramp-file-name-method v)
2708 (tramp-file-name-user v)
2709 (tramp-file-name-host v)
2710 (tramp-run-real-handler
2711 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
2712
2713 (defun tramp-handle-file-name-nondirectory (file)
2714 "Like `file-name-nondirectory' but aware of Tramp files."
2715 (with-parsed-tramp-file-name file nil
2716 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
2717
2718 (defun tramp-handle-file-newer-than-file-p (file1 file2)
2719 "Like `file-newer-than-file-p' for Tramp files."
2720 (cond
2721 ((not (file-exists-p file1)) nil)
2722 ((not (file-exists-p file2)) t)
2723 (t (tramp-time-less-p (nth 5 (file-attributes file2))
2724 (nth 5 (file-attributes file1))))))
2725
2726 (defun tramp-handle-file-regular-p (filename)
2727 "Like `file-regular-p' for Tramp files."
2728 (and (file-exists-p filename)
2729 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
2730
2731 (defun tramp-handle-file-remote-p (filename &optional identification connected)
2732 "Like `file-remote-p' for Tramp files."
2733 (let ((tramp-verbose 3))
2734 (when (tramp-tramp-file-p filename)
2735 (let* ((v (tramp-dissect-file-name filename))
2736 (p (tramp-get-connection-process v))
2737 (c (and p (processp p) (memq (process-status p) '(run open)))))
2738 ;; We expand the file name only, if there is already a connection.
2739 (with-parsed-tramp-file-name
2740 (if c (expand-file-name filename) filename) nil
2741 (and (or (not connected) c)
2742 (cond
2743 ((eq identification 'method) method)
2744 ((eq identification 'user) user)
2745 ((eq identification 'host) host)
2746 ((eq identification 'localname) localname)
2747 (t (tramp-make-tramp-file-name method user host "")))))))))
2748
2749 (defun tramp-handle-file-symlink-p (filename)
2750 "Like `file-symlink-p' for Tramp files."
2751 (with-parsed-tramp-file-name filename nil
2752 (let ((x (car (file-attributes filename))))
2753 (when (stringp x)
2754 ;; When Tramp is running on VMS, then `file-name-absolute-p'
2755 ;; might do weird things.
2756 (if (file-name-absolute-p x)
2757 (tramp-make-tramp-file-name method user host x)
2758 x)))))
2759
2760 (defun tramp-handle-find-backup-file-name (filename)
2761 "Like `find-backup-file-name' for Tramp files."
2762 (with-parsed-tramp-file-name filename nil
2763 ;; We set both variables. It doesn't matter whether it is
2764 ;; Emacs or XEmacs.
2765 (let ((backup-directory-alist
2766 ;; Emacs case.
2767 (when (boundp 'backup-directory-alist)
2768 (if (symbol-value 'tramp-backup-directory-alist)
2769 (mapcar
2770 (lambda (x)
2771 (cons
2772 (car x)
2773 (if (and (stringp (cdr x))
2774 (file-name-absolute-p (cdr x))
2775 (not (tramp-file-name-p (cdr x))))
2776 (tramp-make-tramp-file-name method user host (cdr x))
2777 (cdr x))))
2778 (symbol-value 'tramp-backup-directory-alist))
2779 (symbol-value 'backup-directory-alist))))
2780
2781 (bkup-backup-directory-info
2782 ;; XEmacs case.
2783 (when (boundp 'bkup-backup-directory-info)
2784 (if (symbol-value 'tramp-bkup-backup-directory-info)
2785 (mapcar
2786 (lambda (x)
2787 (nconc
2788 (list (car x))
2789 (list
2790 (if (and (stringp (car (cdr x)))
2791 (file-name-absolute-p (car (cdr x)))
2792 (not (tramp-file-name-p (car (cdr x)))))
2793 (tramp-make-tramp-file-name
2794 method user host (car (cdr x)))
2795 (car (cdr x))))
2796 (cdr (cdr x))))
2797 (symbol-value 'tramp-bkup-backup-directory-info))
2798 (symbol-value 'bkup-backup-directory-info)))))
2799
2800 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
2801
2802 (defun tramp-handle-insert-file-contents
2803 (filename &optional visit beg end replace)
2804 "Like `insert-file-contents' for Tramp files."
2805 (barf-if-buffer-read-only)
2806 (setq filename (expand-file-name filename))
2807 (let (result local-copy remote-copy)
2808 (with-parsed-tramp-file-name filename nil
2809 (unwind-protect
2810 (if (not (file-exists-p filename))
2811 ;; We don't raise a Tramp error, because it might be
2812 ;; suppressed, like in `find-file-noselect-1'.
2813 (signal 'file-error
2814 (list "File not found on remote host" filename))
2815
2816 (if (and (tramp-local-host-p v)
2817 (let (file-name-handler-alist)
2818 (file-readable-p localname)))
2819 ;; Short track: if we are on the local host, we can
2820 ;; run directly.
2821 (setq result
2822 (tramp-run-real-handler
2823 'insert-file-contents
2824 (list localname visit beg end replace)))
2825
2826 ;; When we shall insert only a part of the file, we copy
2827 ;; this part.
2828 (when (or beg end)
2829 (setq remote-copy (tramp-make-tramp-temp-file v))
2830 ;; This is defined in tramp-sh.el. Let's assume this
2831 ;; is loaded already.
2832 (tramp-compat-funcall 'tramp-send-command
2833 v
2834 (cond
2835 ((and beg end)
2836 (format "tail -c +%d %s | head -c +%d >%s"
2837 (1+ beg) (tramp-shell-quote-argument localname)
2838 (- end beg) remote-copy))
2839 (beg
2840 (format "tail -c +%d %s >%s"
2841 (1+ beg) (tramp-shell-quote-argument localname)
2842 remote-copy))
2843 (end
2844 (format "head -c +%d %s >%s"
2845 (1+ end) (tramp-shell-quote-argument localname)
2846 remote-copy)))))
2847
2848 ;; `insert-file-contents-literally' takes care to avoid
2849 ;; calling jka-compr. By let-binding
2850 ;; `inhibit-file-name-operation', we propagate that care
2851 ;; to the `file-local-copy' operation.
2852 (setq local-copy
2853 (let ((inhibit-file-name-operation
2854 (when (eq inhibit-file-name-operation
2855 'insert-file-contents)
2856 'file-local-copy)))
2857 (cond
2858 ((stringp remote-copy)
2859 (file-local-copy
2860 (tramp-make-tramp-file-name
2861 method user host remote-copy)))
2862 ((stringp tramp-temp-buffer-file-name)
2863 (copy-file filename tramp-temp-buffer-file-name 'ok)
2864 tramp-temp-buffer-file-name)
2865 (t (file-local-copy filename)))))
2866
2867 ;; When the file is not readable for the owner, it
2868 ;; cannot be inserted, even if it is readable for the
2869 ;; group or for everybody.
2870 (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
2871
2872 (when (and (null remote-copy)
2873 (tramp-get-method-parameter
2874 method 'tramp-copy-keep-tmpfile))
2875 ;; We keep the local file for performance reasons,
2876 ;; useful for "rsync".
2877 (setq tramp-temp-buffer-file-name local-copy))
2878
2879 (with-progress-reporter
2880 v 3 (format "Inserting local temp file `%s'" local-copy)
2881 ;; We must ensure that `file-coding-system-alist'
2882 ;; matches `local-copy'.
2883 (let ((file-coding-system-alist
2884 (tramp-find-file-name-coding-system-alist
2885 filename local-copy)))
2886 (setq result
2887 (insert-file-contents
2888 local-copy nil nil nil replace))))))
2889
2890 ;; Save exit.
2891 (progn
2892 (when visit
2893 (setq buffer-file-name filename)
2894 (setq buffer-read-only (not (file-writable-p filename)))
2895 (set-visited-file-modtime)
2896 (set-buffer-modified-p nil))
2897 (when (and (stringp local-copy)
2898 (or remote-copy (null tramp-temp-buffer-file-name)))
2899 (delete-file local-copy))
2900 (when (stringp remote-copy)
2901 (delete-file
2902 (tramp-make-tramp-file-name method user host remote-copy))))))
2903
2904 ;; Result.
2905 (list (expand-file-name filename)
2906 (cadr result))))
2907
2908 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2909 "Like `load' for Tramp files."
2910 (with-parsed-tramp-file-name (expand-file-name file) nil
2911 (unless nosuffix
2912 (cond ((file-exists-p (concat file ".elc"))
2913 (setq file (concat file ".elc")))
2914 ((file-exists-p (concat file ".el"))
2915 (setq file (concat file ".el")))))
2916 (when must-suffix
2917 ;; The first condition is always true for absolute file names.
2918 ;; Included for safety's sake.
2919 (unless (or (file-name-directory file)
2920 (string-match "\\.elc?\\'" file))
2921 (tramp-error
2922 v 'file-error
2923 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2924 (unless noerror
2925 (when (not (file-exists-p file))
2926 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2927 (if (not (file-exists-p file))
2928 nil
2929 (let ((tramp-message-show-message (not nomessage)))
2930 (with-progress-reporter v 0 (format "Loading %s" file)
2931 (let ((local-copy (file-local-copy file)))
2932 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2933 (unwind-protect
2934 (load local-copy noerror t t)
2935 (delete-file local-copy)))))
2936 t)))
2937
2938 (defun tramp-handle-substitute-in-file-name (filename)
2939 "Like `substitute-in-file-name' for Tramp files.
2940 \"//\" and \"/~\" substitute only in the local filename part.
2941 If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
2942 beginning of local filename are not substituted."
2943 ;; First, we must replace environment variables.
2944 (setq filename (tramp-replace-environment-variables filename))
2945 (with-parsed-tramp-file-name filename nil
2946 (if (equal tramp-syntax 'url)
2947 ;; We need to check localname only. The other parts cannot contain
2948 ;; "//" or "/~".
2949 (if (and (> (length localname) 1)
2950 (or (string-match "//" localname)
2951 (string-match "/~" localname 1)))
2952 (tramp-run-real-handler 'substitute-in-file-name (list filename))
2953 (tramp-make-tramp-file-name
2954 (when method (substitute-in-file-name method))
2955 (when user (substitute-in-file-name user))
2956 (when host (substitute-in-file-name host))
2957 (when localname
2958 (tramp-run-real-handler
2959 'substitute-in-file-name (list localname)))))
2960 ;; Ignore in LOCALNAME everything before "//" or "/~".
2961 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
2962 (setq filename
2963 (concat (file-remote-p filename)
2964 (replace-match "\\1" nil nil localname)))
2965 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
2966 (when (string-match "~$" filename)
2967 (setq filename (concat filename "/"))))
2968 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
2969
2970 (defun tramp-handle-unhandled-file-name-directory (filename)
2971 "Like `unhandled-file-name-directory' for Tramp files."
2972 ;; With Emacs 23, we could simply return `nil'. But we must keep it
2973 ;; for backward compatibility.
2974 (expand-file-name "~/"))
2975
2976 ;;; Functions for establishing connection:
2977
2978 ;; The following functions are actions to be taken when seeing certain
2979 ;; prompts from the remote host. See the variable
2980 ;; `tramp-actions-before-shell' for usage of these functions.
2981
2982 (defun tramp-action-login (proc vec)
2983 "Send the login name."
2984 (when (not (stringp tramp-current-user))
2985 (save-window-excursion
2986 (let ((enable-recursive-minibuffers t))
2987 (pop-to-buffer (tramp-get-connection-buffer vec))
2988 (setq tramp-current-user (read-string (match-string 0))))))
2989 (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
2990 (with-current-buffer (tramp-get-connection-buffer vec)
2991 (tramp-message vec 6 "\n%s" (buffer-string)))
2992 (tramp-send-string vec tramp-current-user))
2993
2994 (defun tramp-action-password (proc vec)
2995 "Query the user for a password."
2996 (with-current-buffer (process-buffer proc)
2997 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
2998 (tramp-message vec 3 "Sending %s" (match-string 1))
2999 (tramp-enter-password proc)
3000 ;; Hide password prompt.
3001 (narrow-to-region (point-max) (point-max))))
3002
3003 (defun tramp-action-succeed (proc vec)
3004 "Signal success in finding shell prompt."
3005 (throw 'tramp-action 'ok))
3006
3007 (defun tramp-action-permission-denied (proc vec)
3008 "Signal permission denied."
3009 (kill-process proc)
3010 (throw 'tramp-action 'permission-denied))
3011
3012 (defun tramp-action-yesno (proc vec)
3013 "Ask the user for confirmation using `yes-or-no-p'.
3014 Send \"yes\" to remote process on confirmation, abort otherwise.
3015 See also `tramp-action-yn'."
3016 (save-window-excursion
3017 (let ((enable-recursive-minibuffers t))
3018 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
3019 (unless (yes-or-no-p (match-string 0))
3020 (kill-process proc)
3021 (throw 'tramp-action 'permission-denied))
3022 (with-current-buffer (tramp-get-connection-buffer vec)
3023 (tramp-message vec 6 "\n%s" (buffer-string)))
3024 (tramp-send-string vec "yes"))))
3025
3026 (defun tramp-action-yn (proc vec)
3027 "Ask the user for confirmation using `y-or-n-p'.
3028 Send \"y\" to remote process on confirmation, abort otherwise.
3029 See also `tramp-action-yesno'."
3030 (save-window-excursion
3031 (let ((enable-recursive-minibuffers t))
3032 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
3033 (unless (y-or-n-p (match-string 0))
3034 (kill-process proc)
3035 (throw 'tramp-action 'permission-denied))
3036 (with-current-buffer (tramp-get-connection-buffer vec)
3037 (tramp-message vec 6 "\n%s" (buffer-string)))
3038 (tramp-send-string vec "y"))))
3039
3040 (defun tramp-action-terminal (proc vec)
3041 "Tell the remote host which terminal type to use.
3042 The terminal type can be configured with `tramp-terminal-type'."
3043 (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
3044 (with-current-buffer (tramp-get-connection-buffer vec)
3045 (tramp-message vec 6 "\n%s" (buffer-string)))
3046 (tramp-send-string vec tramp-terminal-type))
3047
3048 (defun tramp-action-process-alive (proc vec)
3049 "Check, whether a process has finished."
3050 (unless (memq (process-status proc) '(run open))
3051 (throw 'tramp-action 'process-died)))
3052
3053 (defun tramp-action-out-of-band (proc vec)
3054 "Check, whether an out-of-band copy has finished."
3055 (cond ((and (memq (process-status proc) '(stop exit))
3056 (zerop (process-exit-status proc)))
3057 (tramp-message vec 3 "Process has finished.")
3058 (throw 'tramp-action 'ok))
3059 ((or (and (memq (process-status proc) '(stop exit))
3060 (not (zerop (process-exit-status proc))))
3061 (memq (process-status proc) '(signal)))
3062 ;; `scp' could have copied correctly, but set modes could have failed.
3063 ;; This can be ignored.
3064 (with-current-buffer (process-buffer proc)
3065 (goto-char (point-min))
3066 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
3067 (progn
3068 (tramp-message vec 5 "'set mode' error ignored.")
3069 (tramp-message vec 3 "Process has finished.")
3070 (throw 'tramp-action 'ok))
3071 (tramp-message vec 3 "Process has died.")
3072 (throw 'tramp-action 'process-died))))
3073 (t nil)))
3074
3075 ;;; Functions for processing the actions:
3076
3077 (defun tramp-process-one-action (proc vec actions)
3078 "Wait for output from the shell and perform one action."
3079 (let (found todo item pattern action)
3080 (while (not found)
3081 ;; Reread output once all actions have been performed.
3082 ;; Obviously, the output was not complete.
3083 (tramp-accept-process-output proc 1)
3084 (setq todo actions)
3085 (while todo
3086 (setq item (pop todo))
3087 (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
3088 (setq action (nth 1 item))
3089 (tramp-message
3090 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
3091 (when (tramp-check-for-regexp proc pattern)
3092 (tramp-message vec 5 "Call `%s'" (symbol-name action))
3093 (setq found (funcall action proc vec)))))
3094 found))
3095
3096 (defun tramp-process-actions (proc vec actions &optional timeout)
3097 "Perform actions until success or TIMEOUT."
3098 ;; Preserve message for `progress-reporter'.
3099 (tramp-compat-with-temp-message ""
3100 ;; Enable auth-source and password-cache.
3101 (tramp-set-connection-property vec "first-password-request" t)
3102 (save-restriction
3103 (let (exit)
3104 (while (not exit)
3105 (tramp-message proc 3 "Waiting for prompts from remote shell")
3106 (setq exit
3107 (catch 'tramp-action
3108 (if timeout
3109 (with-timeout (timeout)
3110 (tramp-process-one-action proc vec actions))
3111 (tramp-process-one-action proc vec actions)))))
3112 (with-current-buffer (tramp-get-connection-buffer vec)
3113 (widen)
3114 (tramp-message vec 6 "\n%s" (buffer-string)))
3115 (unless (eq exit 'ok)
3116 (tramp-clear-passwd vec)
3117 (tramp-error-with-buffer
3118 nil vec 'file-error
3119 (cond
3120 ((eq exit 'permission-denied) "Permission denied")
3121 ((eq exit 'process-died) "Process died")
3122 (t "Login failed"))))))))
3123
3124 :;; Utility functions:
3125
3126 (defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
3127 "Like `accept-process-output' for Tramp processes.
3128 This is needed in order to hide `last-coding-system-used', which is set
3129 for process communication also."
3130 (with-current-buffer (process-buffer proc)
3131 (tramp-message proc 10 "%s %s" proc (process-status proc))
3132 (let (buffer-read-only last-coding-system-used)
3133 ;; Under Windows XP, accept-process-output doesn't return
3134 ;; sometimes. So we add an additional timeout.
3135 (with-timeout ((or timeout 1))
3136 (accept-process-output proc timeout timeout-msecs)))
3137 (tramp-message proc 10 "\n%s" (buffer-string))))
3138
3139 (defun tramp-check-for-regexp (proc regexp)
3140 "Check, whether REGEXP is contained in process buffer of PROC.
3141 Erase echoed commands if exists."
3142 (with-current-buffer (process-buffer proc)
3143 (goto-char (point-min))
3144
3145 ;; Check whether we need to remove echo output.
3146 (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
3147 (re-search-forward tramp-echoed-echo-mark-regexp nil t))
3148 (let ((begin (match-beginning 0)))
3149 (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
3150 ;; Discard echo from remote output.
3151 (tramp-set-connection-property proc "check-remote-echo" nil)
3152 (tramp-message proc 5 "echo-mark found")
3153 (forward-line 1)
3154 (delete-region begin (point))
3155 (goto-char (point-min)))))
3156
3157 (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
3158 ;; Sometimes, the echo string is suppressed on the remote side.
3159 (not (string-equal
3160 (tramp-compat-funcall
3161 'substring-no-properties tramp-echo-mark-marker
3162 0 (min tramp-echo-mark-marker-length (1- (point-max))))
3163 (tramp-compat-funcall
3164 'buffer-substring-no-properties
3165 1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
3166 ;; No echo to be handled, now we can look for the regexp.
3167 (goto-char (point-min))
3168 (re-search-forward regexp nil t))))
3169
3170 (defun tramp-wait-for-regexp (proc timeout regexp)
3171 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
3172 Expects the output of PROC to be sent to the current buffer. Returns
3173 the string that matched, or nil. Waits indefinitely if TIMEOUT is
3174 nil."
3175 (with-current-buffer (process-buffer proc)
3176 (let ((found (tramp-check-for-regexp proc regexp))
3177 (start-time (current-time)))
3178 (cond (timeout
3179 ;; Work around a bug in XEmacs 21, where the timeout
3180 ;; expires faster than it should. This degenerates
3181 ;; to polling for buggy XEmacsen, but oh, well.
3182 (while (and (not found)
3183 (< (tramp-time-diff (current-time) start-time)
3184 timeout))
3185 (with-timeout (timeout)
3186 (while (not found)
3187 (tramp-accept-process-output proc 1)
3188 (unless (memq (process-status proc) '(run open))
3189 (tramp-error-with-buffer
3190 nil proc 'file-error "Process has died"))
3191 (setq found (tramp-check-for-regexp proc regexp))))))
3192 (t
3193 (while (not found)
3194 (tramp-accept-process-output proc 1)
3195 (unless (memq (process-status proc) '(run open))
3196 (tramp-error-with-buffer
3197 nil proc 'file-error "Process has died"))
3198 (setq found (tramp-check-for-regexp proc regexp)))))
3199 (tramp-message proc 6 "\n%s" (buffer-string))
3200 (when (not found)
3201 (if timeout
3202 (tramp-error
3203 proc 'file-error "[[Regexp `%s' not found in %d secs]]"
3204 regexp timeout)
3205 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
3206 found)))
3207
3208 ;; We don't call `tramp-send-string' in order to hide the password
3209 ;; from the debug buffer, and because end-of-line handling of the
3210 ;; string.
3211 (defun tramp-enter-password (proc)
3212 "Prompt for a password and send it to the remote end."
3213 (process-send-string
3214 proc (concat (tramp-read-passwd proc)
3215 (or (tramp-get-method-parameter
3216 tramp-current-method
3217 'tramp-password-end-of-line)
3218 tramp-default-password-end-of-line))))
3219
3220 ;; It seems that Tru64 Unix does not like it if long strings are sent
3221 ;; to it in one go. (This happens when sending the Perl
3222 ;; `file-attributes' implementation, for instance.) Therefore, we
3223 ;; have this function which sends the string in chunks.
3224 (defun tramp-send-string (vec string)
3225 "Send the STRING via connection VEC.
3226
3227 The STRING is expected to use Unix line-endings, but the lines sent to
3228 the remote host use line-endings as defined in the variable
3229 `tramp-rsh-end-of-line'. The communication buffer is erased before sending."
3230 (let* ((p (tramp-get-connection-process vec))
3231 (chunksize (tramp-get-connection-property p "chunksize" nil)))
3232 (unless p
3233 (tramp-error
3234 vec 'file-error "Can't send string to remote host -- not logged in"))
3235 (tramp-set-connection-property p "last-cmd-time" (current-time))
3236 (tramp-message vec 10 "%s" string)
3237 (with-current-buffer (tramp-get-connection-buffer vec)
3238 ;; Clean up the buffer. We cannot call `erase-buffer' because
3239 ;; narrowing might be in effect.
3240 (let (buffer-read-only) (delete-region (point-min) (point-max)))
3241 ;; Replace "\n" by `tramp-rsh-end-of-line'.
3242 (setq string
3243 (mapconcat 'identity
3244 (tramp-compat-split-string string "\n")
3245 tramp-rsh-end-of-line))
3246 (unless (or (string= string "")
3247 (string-equal (substring string -1) tramp-rsh-end-of-line))
3248 (setq string (concat string tramp-rsh-end-of-line)))
3249 ;; Send the string.
3250 (if (and chunksize (not (zerop chunksize)))
3251 (let ((pos 0)
3252 (end (length string)))
3253 (while (< pos end)
3254 (tramp-message
3255 vec 10 "Sending chunk from %s to %s"
3256 pos (min (+ pos chunksize) end))
3257 (process-send-string
3258 p (substring string pos (min (+ pos chunksize) end)))
3259 (setq pos (+ pos chunksize))))
3260 (process-send-string p string)))))
3261
3262 (defun tramp-get-inode (vec)
3263 "Returns the virtual inode number.
3264 If it doesn't exist, generate a new one."
3265 (let ((string (tramp-make-tramp-file-name
3266 (tramp-file-name-method vec)
3267 (tramp-file-name-user vec)
3268 (tramp-file-name-host vec)
3269 "")))
3270 (unless (assoc string tramp-inodes)
3271 (add-to-list 'tramp-inodes
3272 (list string (length tramp-inodes))))
3273 (nth 1 (assoc string tramp-inodes))))
3274
3275 (defun tramp-get-device (vec)
3276 "Returns the virtual device number.
3277 If it doesn't exist, generate a new one."
3278 (let ((string (tramp-make-tramp-file-name
3279 (tramp-file-name-method vec)
3280 (tramp-file-name-user vec)
3281 (tramp-file-name-host vec)
3282 "")))
3283 (unless (assoc string tramp-devices)
3284 (add-to-list 'tramp-devices
3285 (list string (length tramp-devices))))
3286 (cons -1 (nth 1 (assoc string tramp-devices)))))
3287
3288 (defun tramp-equal-remote (file1 file2)
3289 "Check, whether the remote parts of FILE1 and FILE2 are identical.
3290 The check depends on method, user and host name of the files. If
3291 one of the components is missing, the default values are used.
3292 The local file name parts of FILE1 and FILE2 are not taken into
3293 account.
3294
3295 Example:
3296
3297 (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
3298
3299 would yield `t'. On the other hand, the following check results in nil:
3300
3301 (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
3302 (and (stringp (file-remote-p file1))
3303 (stringp (file-remote-p file2))
3304 (string-equal (file-remote-p file1) (file-remote-p file2))))
3305
3306 (defun tramp-get-method-parameter (method param)
3307 "Return the method parameter PARAM.
3308 If the `tramp-methods' entry does not exist, return nil."
3309 (let ((entry (assoc param (assoc method tramp-methods))))
3310 (when entry (cadr entry))))
3311
3312 (defun tramp-mode-string-to-int (mode-string)
3313 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
3314 (let* (case-fold-search
3315 (mode-chars (string-to-vector mode-string))
3316 (owner-read (aref mode-chars 1))
3317 (owner-write (aref mode-chars 2))
3318 (owner-execute-or-setid (aref mode-chars 3))
3319 (group-read (aref mode-chars 4))
3320 (group-write (aref mode-chars 5))
3321 (group-execute-or-setid (aref mode-chars 6))
3322 (other-read (aref mode-chars 7))
3323 (other-write (aref mode-chars 8))
3324 (other-execute-or-sticky (aref mode-chars 9)))
3325 (save-match-data
3326 (logior
3327 (cond
3328 ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400"))
3329 ((char-equal owner-read ?-) 0)
3330 (t (error "Second char `%c' must be one of `r-'" owner-read)))
3331 (cond
3332 ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200"))
3333 ((char-equal owner-write ?-) 0)
3334 (t (error "Third char `%c' must be one of `w-'" owner-write)))
3335 (cond
3336 ((char-equal owner-execute-or-setid ?x)
3337 (tramp-compat-octal-to-decimal "00100"))
3338 ((char-equal owner-execute-or-setid ?S)
3339 (tramp-compat-octal-to-decimal "04000"))
3340 ((char-equal owner-execute-or-setid ?s)
3341 (tramp-compat-octal-to-decimal "04100"))
3342 ((char-equal owner-execute-or-setid ?-) 0)
3343 (t (error "Fourth char `%c' must be one of `xsS-'"
3344 owner-execute-or-setid)))
3345 (cond
3346 ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040"))
3347 ((char-equal group-read ?-) 0)
3348 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
3349 (cond
3350 ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020"))
3351 ((char-equal group-write ?-) 0)
3352 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
3353 (cond
3354 ((char-equal group-execute-or-setid ?x)
3355 (tramp-compat-octal-to-decimal "00010"))
3356 ((char-equal group-execute-or-setid ?S)
3357 (tramp-compat-octal-to-decimal "02000"))
3358 ((char-equal group-execute-or-setid ?s)
3359 (tramp-compat-octal-to-decimal "02010"))
3360 ((char-equal group-execute-or-setid ?-) 0)
3361 (t (error "Seventh char `%c' must be one of `xsS-'"
3362 group-execute-or-setid)))
3363 (cond
3364 ((char-equal other-read ?r)
3365 (tramp-compat-octal-to-decimal "00004"))
3366 ((char-equal other-read ?-) 0)
3367 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
3368 (cond
3369 ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002"))
3370 ((char-equal other-write ?-) 0)
3371 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
3372 (cond
3373 ((char-equal other-execute-or-sticky ?x)
3374 (tramp-compat-octal-to-decimal "00001"))
3375 ((char-equal other-execute-or-sticky ?T)
3376 (tramp-compat-octal-to-decimal "01000"))
3377 ((char-equal other-execute-or-sticky ?t)
3378 (tramp-compat-octal-to-decimal "01001"))
3379 ((char-equal other-execute-or-sticky ?-) 0)
3380 (t (error "Tenth char `%c' must be one of `xtT-'"
3381 other-execute-or-sticky)))))))
3382
3383 (defun tramp-local-host-p (vec)
3384 "Return t if this points to the local host, nil otherwise."
3385 ;; We cannot use `tramp-file-name-real-host'. A port is an
3386 ;; indication for an ssh tunnel or alike.
3387 (let ((host (tramp-file-name-host vec)))
3388 (and
3389 (stringp host)
3390 (string-match tramp-local-host-regexp host)
3391 ;; The method shall be applied to one of the shell file name
3392 ;; handler. `tramp-local-host-p' is also called for "smb" and
3393 ;; alike, where it must fail.
3394 (tramp-get-method-parameter
3395 (tramp-file-name-method vec) 'tramp-login-program)
3396 ;; The local temp directory must be writable for the other user.
3397 (file-writable-p
3398 (tramp-make-tramp-file-name
3399 (tramp-file-name-method vec)
3400 (tramp-file-name-user vec)
3401 host
3402 (tramp-compat-temporary-file-directory)))
3403 ;; On some systems, chown runs only for root.
3404 (or (zerop (user-uid))
3405 ;; This is defined in tramp-sh.el. Let's assume this is
3406 ;; loaded already.
3407 (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
3408
3409 (defun tramp-make-tramp-temp-file (vec)
3410 "Create a temporary file on the remote host identified by VEC.
3411 Return the local name of the temporary file."
3412 (let ((prefix
3413 (tramp-make-tramp-file-name
3414 (tramp-file-name-method vec)
3415 (tramp-file-name-user vec)
3416 (tramp-file-name-host vec)
3417 (tramp-drop-volume-letter
3418 (expand-file-name
3419 tramp-temp-name-prefix
3420 ;; This is defined in tramp-sh.el. Let's assume this is
3421 ;; loaded already.
3422 (tramp-compat-funcall 'tramp-get-remote-tmpdir vec)))))
3423 result)
3424 (while (not result)
3425 ;; `make-temp-file' would be the natural choice for
3426 ;; implementation. But it calls `write-region' internally,
3427 ;; which also needs a temporary file - we would end in an
3428 ;; infinite loop.
3429 (setq result (make-temp-name prefix))
3430 (if (file-exists-p result)
3431 (setq result nil)
3432 ;; This creates the file by side effect.
3433 (set-file-times result)
3434 (set-file-modes result (tramp-compat-octal-to-decimal "0700"))))
3435
3436 ;; Return the local part.
3437 (with-parsed-tramp-file-name result nil localname)))
3438
3439 (defun tramp-delete-temp-file-function ()
3440 "Remove temporary files related to current buffer."
3441 (when (stringp tramp-temp-buffer-file-name)
3442 (ignore-errors (delete-file tramp-temp-buffer-file-name))))
3443
3444 (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
3445 (add-hook 'tramp-cache-unload-hook
3446 (lambda ()
3447 (remove-hook 'kill-buffer-hook
3448 'tramp-delete-temp-file-function)))
3449
3450 ;;; Auto saving to a special directory:
3451
3452 (unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
3453 (defadvice make-auto-save-file-name
3454 (around tramp-advice-make-auto-save-file-name () activate)
3455 "Invoke `tramp-*-handle-make-auto-save-file-name' for Tramp files."
3456 (if (tramp-tramp-file-p (buffer-file-name))
3457 ;; We cannot call `tramp-handle-make-auto-save-file-name'
3458 ;; directly, because this would bypass the locking mechanism.
3459 (setq ad-return-value
3460 (tramp-file-name-handler 'make-auto-save-file-name))
3461 ad-do-it))
3462 (add-hook
3463 'tramp-unload-hook
3464 (lambda ()
3465 (ad-remove-advice
3466 'make-auto-save-file-name
3467 'around 'tramp-advice-make-auto-save-file-name)
3468 (ad-activate 'make-auto-save-file-name))))
3469
3470 ;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus
3471 ;; umask. This is a security threat.
3472
3473 (defun tramp-set-auto-save-file-modes ()
3474 "Set permissions of autosaved remote files to the original permissions."
3475 (let ((bfn (buffer-file-name)))
3476 (when (and (tramp-tramp-file-p bfn)
3477 (buffer-modified-p)
3478 (stringp buffer-auto-save-file-name)
3479 (not (equal bfn buffer-auto-save-file-name)))
3480 (unless (file-exists-p buffer-auto-save-file-name)
3481 (write-region "" nil buffer-auto-save-file-name))
3482 ;; Permissions should be set always, because there might be an old
3483 ;; auto-saved file belonging to another original file. This could
3484 ;; be a security threat.
3485 (set-file-modes
3486 buffer-auto-save-file-name
3487 (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600"))))))
3488
3489 (unless (and (featurep 'xemacs)
3490 (= emacs-major-version 21)
3491 (> emacs-minor-version 4))
3492 (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
3493 (add-hook 'tramp-unload-hook
3494 (lambda ()
3495 (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
3496
3497 (defun tramp-subst-strs-in-string (alist string)
3498 "Replace all occurrences of the string FROM with TO in STRING.
3499 ALIST is of the form ((FROM . TO) ...)."
3500 (save-match-data
3501 (while alist
3502 (let* ((pr (car alist))
3503 (from (car pr))
3504 (to (cdr pr)))
3505 (while (string-match (regexp-quote from) string)
3506 (setq string (replace-match to t t string)))
3507 (setq alist (cdr alist))))
3508 string))
3509
3510 ;;; Compatibility functions section:
3511
3512 (defun tramp-read-passwd (proc &optional prompt)
3513 "Read a password from user (compat function).
3514 Consults the auth-source package.
3515 Invokes `password-read' if available, `read-passwd' else."
3516 (let* ((key (tramp-make-tramp-file-name
3517 tramp-current-method tramp-current-user
3518 tramp-current-host ""))
3519 (pw-prompt
3520 (or prompt
3521 (with-current-buffer (process-buffer proc)
3522 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
3523 (format "%s for %s " (capitalize (match-string 1)) key)))))
3524 (with-parsed-tramp-file-name key nil
3525 (prog1
3526 (or
3527 ;; See if auth-sources contains something useful, if it's bound.
3528 (and (boundp 'auth-sources)
3529 (tramp-get-connection-property v "first-password-request" nil)
3530 ;; Try with Tramp's current method.
3531 (tramp-compat-funcall
3532 'auth-source-user-or-password
3533 "password" tramp-current-host tramp-current-method))
3534 ;; Try the password cache.
3535 (when (functionp 'password-read)
3536 (unless (tramp-get-connection-property
3537 v "first-password-request" nil)
3538 (tramp-compat-funcall 'password-cache-remove key))
3539 (let ((password
3540 (tramp-compat-funcall 'password-read pw-prompt key)))
3541 (tramp-compat-funcall 'password-cache-add key password)
3542 password))
3543 ;; Else, get the password interactively.
3544 (read-passwd pw-prompt))
3545 (tramp-set-connection-property v "first-password-request" nil)))))
3546
3547 (defun tramp-clear-passwd (vec)
3548 "Clear password cache for connection related to VEC."
3549 (tramp-compat-funcall
3550 'password-cache-remove
3551 (tramp-make-tramp-file-name
3552 (tramp-file-name-method vec)
3553 (tramp-file-name-user vec)
3554 (tramp-file-name-host vec)
3555 "")))
3556
3557 ;; Snarfed code from time-date.el and parse-time.el
3558
3559 (defconst tramp-half-a-year '(241 17024)
3560 "Evaluated by \"(days-to-time 183)\".")
3561
3562 (defconst tramp-parse-time-months
3563 '(("jan" . 1) ("feb" . 2) ("mar" . 3)
3564 ("apr" . 4) ("may" . 5) ("jun" . 6)
3565 ("jul" . 7) ("aug" . 8) ("sep" . 9)
3566 ("oct" . 10) ("nov" . 11) ("dec" . 12))
3567 "Alist mapping month names to integers.")
3568
3569 (defun tramp-time-less-p (t1 t2)
3570 "Say whether time value T1 is less than time value T2."
3571 (unless t1 (setq t1 '(0 0)))
3572 (unless t2 (setq t2 '(0 0)))
3573 (or (< (car t1) (car t2))
3574 (and (= (car t1) (car t2))
3575 (< (nth 1 t1) (nth 1 t2)))))
3576
3577 (defun tramp-time-subtract (t1 t2)
3578 "Subtract two time values.
3579 Return the difference in the format of a time value."
3580 (unless t1 (setq t1 '(0 0)))
3581 (unless t2 (setq t2 '(0 0)))
3582 (let ((borrow (< (cadr t1) (cadr t2))))
3583 (list (- (car t1) (car t2) (if borrow 1 0))
3584 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3585
3586 (defun tramp-time-diff (t1 t2)
3587 "Return the difference between the two times, in seconds.
3588 T1 and T2 are time values (as returned by `current-time' for example)."
3589 (cond ((and (fboundp 'subtract-time)
3590 (fboundp 'float-time))
3591 (tramp-compat-funcall
3592 'float-time (tramp-compat-funcall 'subtract-time t1 t2)))
3593 ((and (fboundp 'subtract-time)
3594 (fboundp 'time-to-seconds))
3595 (tramp-compat-funcall
3596 'time-to-seconds (tramp-compat-funcall 'subtract-time t1 t2)))
3597 ((fboundp 'itimer-time-difference)
3598 (tramp-compat-funcall
3599 'itimer-time-difference
3600 (if (< (length t1) 3) (append t1 '(0)) t1)
3601 (if (< (length t2) 3) (append t2 '(0)) t2)))
3602 (t
3603 (let ((time (tramp-time-subtract t1 t2)))
3604 (+ (* (car time) 65536.0)
3605 (cadr time)
3606 (/ (or (nth 2 time) 0) 1000000.0))))))
3607
3608 ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
3609 ;; does not deal well with newline characters. Newline is replaced by
3610 ;; backslash newline. But if, say, the string `a backslash newline b'
3611 ;; is passed to a shell, the shell will expand this into "ab",
3612 ;; completely omitting the newline. This is not what was intended.
3613 ;; It does not appear to be possible to make the function
3614 ;; `shell-quote-argument' work with newlines without making it
3615 ;; dependent on the shell used. But within this package, we know that
3616 ;; we will always use a Bourne-like shell, so we use an approach which
3617 ;; groks newlines.
3618 ;;
3619 ;; The approach is simple: we call `shell-quote-argument', then
3620 ;; massage the newline part of the result.
3621 ;;
3622 ;; This function should produce a string which is grokked by a Unix
3623 ;; shell, even if the Emacs is running on Windows. Since this is the
3624 ;; kludges section, we bind `system-type' in such a way that
3625 ;; `shell-quote-arguments' behaves as if on Unix.
3626 ;;
3627 ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
3628 ;; function to work with Bourne-like shells.
3629 ;;
3630 ;; CCC: This function should be rewritten so that
3631 ;; `shell-quote-argument' is not used. This way, we are safe from
3632 ;; changes in `shell-quote-argument'.
3633 ;;;###tramp-autoload
3634 (defun tramp-shell-quote-argument (s)
3635 "Similar to `shell-quote-argument', but groks newlines.
3636 Only works for Bourne-like shells."
3637 (let ((system-type 'not-windows))
3638 (save-match-data
3639 (let ((result (shell-quote-argument s))
3640 (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
3641 (when (and (>= (length result) 2)
3642 (string= (substring result 0 2) "\\~"))
3643 (setq result (substring result 1)))
3644 (while (string-match nl result)
3645 (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
3646 t t result)))
3647 result))))
3648
3649 ;; Checklist for `tramp-unload-hook'
3650 ;; - Unload all `tramp-*' packages
3651 ;; - Reset `file-name-handler-alist'
3652 ;; - Cleanup hooks where Tramp functions are in
3653 ;; - Cleanup advised functions
3654 ;; - Cleanup autoloads
3655 ;;;###autoload
3656 (defun tramp-unload-tramp ()
3657 "Discard Tramp from loading remote files."
3658 (interactive)
3659 ;; ange-ftp settings must be enabled.
3660 (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
3661 ;; Maybe it's not loaded yet.
3662 (ignore-errors (unload-feature 'tramp 'force)))
3663
3664 (provide 'tramp)
3665
3666 ;;; TODO:
3667
3668 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
3669 ;; `shell-quote-argument'.
3670 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
3671 ;; by the files in that directory. Add this here.
3672 ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
3673 ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
3674 ;; * abbreviate-file-name
3675 ;; * Better error checking. At least whenever we see something
3676 ;; strange when doing zerop, we should kill the process and start
3677 ;; again. (Greg Stark)
3678 ;; * Username and hostname completion.
3679 ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
3680 ;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
3681 ;; Code is nearly identical.
3682 ;; * Make `tramp-default-user' obsolete.
3683 ;; * Implement a general server-local-variable mechanism, as there are
3684 ;; probably other variables that need different values for different
3685 ;; servers too. The user could then configure a variable (such as
3686 ;; tramp-server-local-variable-alist) to define any such variables
3687 ;; that they need to, which would then be let bound as appropriate
3688 ;; in tramp functions. (Jason Rumney)
3689 ;; * IMHO, it's a drawback that currently Tramp doesn't support
3690 ;; Unicode in Dired file names by default. Is it possible to
3691 ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
3692 ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
3693 ;; expects only English messages? (Juri Linkov)
3694 ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
3695 ;; * I was wondering it it would be possible to use tramp even if I'm
3696 ;; actually using sshfs. But when I launch a command I would like
3697 ;; to get it executed on the remote machine where the files really
3698 ;; are. (Andrea Crotti)
3699 ;; * Run emerge on two remote files. Bug is described here:
3700 ;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
3701 ;; (Bug#6850)
3702
3703 ;; Functions for file-name-handler-alist:
3704 ;; diff-latest-backup-file -- in diff.el
3705
3706 ;;; tramp.el ends here
3707
3708 ;; Local Variables:
3709 ;; mode: Emacs-Lisp
3710 ;; coding: utf-8
3711 ;; End: