]> code.delx.au - gnu-emacs/blob - lisp/net/tramp.el
merged from trunk
[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,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 ;; (copyright statements below in code to be updated with the above notice)
7
8 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
9 ;; Michael Albinus <michael.albinus@gmx.de>
10 ;; Keywords: comm, processes
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; This package provides remote file editing, similar to ange-ftp.
30 ;; The difference is that ange-ftp uses FTP to transfer files between
31 ;; the local and the remote host, whereas tramp.el uses a combination
32 ;; of rsh and rcp or other work-alike programs, such as ssh/scp.
33 ;;
34 ;; For more detailed instructions, please see the info file.
35 ;;
36 ;; Notes:
37 ;; -----
38 ;;
39 ;; This package only works for Emacs 22.1 and higher, and for XEmacs 21.4
40 ;; and higher. For XEmacs 21, you need the package `fsf-compat' for
41 ;; the `with-timeout' macro.
42 ;;
43 ;; Also see the todo list at the bottom of this file.
44 ;;
45 ;; The current version of Tramp can be retrieved from the following URL:
46 ;; http://ftp.gnu.org/gnu/tramp/
47 ;;
48 ;; There's a mailing list for this, as well. Its name is:
49 ;; tramp-devel@gnu.org
50 ;; You can use the Web to subscribe, under the following URL:
51 ;; http://lists.gnu.org/mailman/listinfo/tramp-devel
52 ;;
53 ;; For the adventurous, the current development sources are available
54 ;; via CVS. You can find instructions about this at the following URL:
55 ;; http://savannah.gnu.org/projects/tramp/
56 ;; Click on "CVS" in the navigation bar near the top.
57 ;;
58 ;; Don't forget to put on your asbestos longjohns, first!
59
60 ;;; Code:
61
62 ;; Since Emacs 23.1, loading messages have been disabled during
63 ;; autoload. However, loading Tramp takes a while, and it could
64 ;; happen while typing a filename in the minibuffer. Therefore, Tramp
65 ;; shall inform about.
66 (when (and load-in-progress (null (current-message)))
67 (message "Loading tramp..."))
68
69 ;; The Tramp version number and bug report address, as prepared by configure.
70 (require 'trampver)
71 (add-hook 'tramp-unload-hook
72 (lambda ()
73 (when (featurep 'trampver)
74 (unload-feature 'trampver 'force))))
75
76 (require 'tramp-compat)
77 (add-hook 'tramp-unload-hook
78 (lambda ()
79 (when (featurep 'tramp-compat)
80 (unload-feature 'tramp-compat 'force))))
81
82 (require 'format-spec)
83 ;; As long as password.el is not part of (X)Emacs, it shouldn't
84 ;; be mandatory
85 (if (featurep 'xemacs)
86 (load "password" 'noerror)
87 (or (require 'password-cache nil 'noerror)
88 (require 'password nil 'noerror))) ; from No Gnus, also in tar ball
89
90 (require 'shell)
91 (require 'advice)
92
93 (eval-and-compile
94 (if (featurep 'xemacs)
95 (load "auth-source" 'noerror)
96 (require 'auth-source nil 'noerror)))
97
98 ;; Requiring 'tramp-cache results in an endless loop.
99 (autoload 'tramp-get-file-property "tramp-cache")
100 (autoload 'tramp-set-file-property "tramp-cache")
101 (autoload 'tramp-flush-file-property "tramp-cache")
102 (autoload 'tramp-flush-directory-property "tramp-cache")
103 (autoload 'tramp-get-connection-property "tramp-cache")
104 (autoload 'tramp-set-connection-property "tramp-cache")
105 (autoload 'tramp-flush-connection-property "tramp-cache")
106 (autoload 'tramp-parse-connection-properties "tramp-cache")
107 (add-hook 'tramp-unload-hook
108 (lambda ()
109 (when (featurep 'tramp-cache)
110 (unload-feature 'tramp-cache 'force))))
111
112 (autoload 'tramp-uuencode-region "tramp-uu"
113 "Implementation of `uuencode' in Lisp.")
114 (add-hook 'tramp-unload-hook
115 (lambda ()
116 (when (featurep 'tramp-uu)
117 (unload-feature 'tramp-uu 'force))))
118
119 (autoload 'uudecode-decode-region "uudecode")
120
121 ;; The following Tramp packages must be loaded after tramp.el, because
122 ;; they require it as well.
123 (eval-after-load "tramp"
124 '(dolist
125 (feature
126 (list
127
128 ;; Tramp interactive commands.
129 'tramp-cmds
130
131 ;; Load foreign FTP method.
132 (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
133
134 ;; tramp-smb uses "smbclient" from Samba. Not available
135 ;; under Cygwin and Windows, because they don't offer
136 ;; "smbclient". And even not necessary there, because Emacs
137 ;; supports UNC file names like "//host/share/localname".
138 (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
139
140 ;; Load foreign FISH method.
141 'tramp-fish
142
143 ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
144 ;; on some system types. We don't call `dbus-ping', because
145 ;; this would load dbus.el.
146 (when (and (featurep 'dbusbind)
147 (condition-case nil
148 (tramp-compat-funcall 'dbus-get-unique-name :session)
149 (error nil))
150 (tramp-compat-process-running-p "gvfs-fuse-daemon"))
151 'tramp-gvfs)
152
153 ;; Load gateways. It needs `make-network-process' from Emacs 22.
154 (when (functionp 'make-network-process) 'tramp-gw)
155
156 ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
157 ;; (from Emacs 23.2).
158 (when (and (locate-library "epa") (locate-library "imap-hash"))
159 'tramp-imap)))
160
161 (when feature
162 ;; We have used just some basic tests, whether a package shall
163 ;; be added. There might still be other errors during loading,
164 ;; which we will catch here.
165 (catch 'tramp-loading
166 (require feature)
167 (add-hook 'tramp-unload-hook
168 `(lambda ()
169 (when (featurep (quote ,feature))
170 (unload-feature (quote ,feature) 'force)))))
171 (unless (featurep feature)
172 (message "Loading %s failed, ignoring this package" feature)))))
173
174 ;;; User Customizable Internal Variables:
175
176 (defgroup tramp nil
177 "Edit remote files with a combination of rsh and rcp or similar programs."
178 :group 'files
179 :group 'comm
180 :version "22.1")
181
182 ;; Maybe we need once a real Tramp mode, with key bindings etc.
183 ;;;###autoload
184 (defcustom tramp-mode t
185 "*Whether Tramp is enabled.
186 If it is set to nil, all remote file names are used literally."
187 :group 'tramp
188 :type 'boolean)
189
190 (defcustom tramp-verbose 3
191 "*Verbosity level for Tramp messages.
192 Any level x includes messages for all levels 1 .. x-1. The levels are
193
194 0 silent (no tramp messages at all)
195 1 errors
196 2 warnings
197 3 connection to remote hosts (default level)
198 4 activities
199 5 internal
200 6 sent and received strings
201 7 file caching
202 8 connection properties
203 10 traces (huge)."
204 :group 'tramp
205 :type 'integer)
206
207 ;; Emacs case.
208 (eval-and-compile
209 (when (boundp 'backup-directory-alist)
210 (defcustom tramp-backup-directory-alist nil
211 "Alist of filename patterns and backup directory names.
212 Each element looks like (REGEXP . DIRECTORY), with the same meaning like
213 in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
214 is a local file name, the backup directory is prepended with Tramp file
215 name prefix \(method, user, host\) of file.
216
217 \(setq tramp-backup-directory-alist backup-directory-alist\)
218
219 gives the same backup policy for Tramp files on their hosts like the
220 policy for local files."
221 :group 'tramp
222 :type '(repeat (cons (regexp :tag "Regexp matching filename")
223 (directory :tag "Backup directory name"))))))
224
225 ;; XEmacs case. We cannot check for `bkup-backup-directory-info', because
226 ;; the package "backup-dir" might not be loaded yet.
227 (eval-and-compile
228 (when (featurep 'xemacs)
229 (defcustom tramp-bkup-backup-directory-info nil
230 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
231 It has the same meaning like `bkup-backup-directory-info' from package
232 `backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
233 file name, the backup directory is prepended with Tramp file name prefix
234 \(method, user, host\) of file.
235
236 \(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
237
238 gives the same backup policy for Tramp files on their hosts like the
239 policy for local files."
240 :type '(repeat
241 (list (regexp :tag "File regexp")
242 (string :tag "Backup Dir")
243 (set :inline t
244 (const ok-create)
245 (const full-path)
246 (const prepend-name)
247 (const search-upward))))
248 :group 'tramp)))
249
250 (defcustom tramp-auto-save-directory nil
251 "*Put auto-save files in this directory, if set.
252 The idea is to use a local directory so that auto-saving is faster."
253 :group 'tramp
254 :type '(choice (const nil) string))
255
256 (defcustom tramp-encoding-shell
257 (if (memq system-type '(windows-nt))
258 (getenv "COMSPEC")
259 "/bin/sh")
260 "*Use this program for encoding and decoding commands on the local host.
261 This shell is used to execute the encoding and decoding command on the
262 local host, so if you want to use `~' in those commands, you should
263 choose a shell here which groks tilde expansion. `/bin/sh' normally
264 does not understand tilde expansion.
265
266 For encoding and deocding, commands like the following are executed:
267
268 /bin/sh -c COMMAND < INPUT > OUTPUT
269
270 This variable can be used to change the \"/bin/sh\" part. See the
271 variable `tramp-encoding-command-switch' for the \"-c\" part.
272
273 Note that this variable is not used for remote commands. There are
274 mechanisms in tramp.el which automatically determine the right shell to
275 use for the remote host."
276 :group 'tramp
277 :type '(file :must-match t))
278
279 (defcustom tramp-encoding-command-switch
280 (if (string-match "cmd\\.exe" tramp-encoding-shell)
281 "/c"
282 "-c")
283 "*Use this switch together with `tramp-encoding-shell' for local commands.
284 See the variable `tramp-encoding-shell' for more information."
285 :group 'tramp
286 :type 'string)
287
288 (defcustom tramp-inline-compress-start-size 4096
289 "*The minimum size of compressing where inline transfer.
290 When inline transfer, compress transfered data of file
291 whose size is this value or above (up to `tramp-copy-size-limit').
292 If it is nil, no compression at all will be applied."
293 :group 'tramp
294 :type '(choice (const nil) integer))
295
296 (defcustom tramp-copy-size-limit 10240
297 "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
298 If it is nil, inline out-of-the-band copy will be used without a check."
299 :group 'tramp
300 :type '(choice (const nil) integer))
301
302 (defcustom tramp-terminal-type "dumb"
303 "*Value of TERM environment variable for logging in to remote host.
304 Because Tramp wants to parse the output of the remote shell, it is easily
305 confused by ANSI color escape sequences and suchlike. Often, shell init
306 files conditionalize this setup based on the TERM environment variable."
307 :group 'tramp
308 :type 'string)
309
310 ;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for
311 ;; root users. It uses the `$' character for other users. In order
312 ;; to guarantee a proper prompt, we use "#$" for the prompt.
313
314 (defvar tramp-end-of-output
315 (format
316 "///%s#$"
317 (md5 (concat (prin1-to-string process-environment) (current-time-string))))
318 "String used to recognize end of output.
319 The '$' character at the end is quoted; the string cannot be
320 detected as prompt when being sent on echoing hosts, therefore.")
321
322 (defconst tramp-initial-end-of-output "#$ "
323 "Prompt when establishing a connection.")
324
325 (defvar tramp-methods
326 `(("rcp" (tramp-login-program "rsh")
327 (tramp-login-args (("%h") ("-l" "%u")))
328 (tramp-remote-sh "/bin/sh")
329 (tramp-copy-program "rcp")
330 (tramp-copy-args (("-p" "%k") ("-r")))
331 (tramp-copy-keep-date t)
332 (tramp-copy-recursive t)
333 (tramp-password-end-of-line nil))
334 ("scp" (tramp-login-program "ssh")
335 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
336 ("-e" "none")))
337 (tramp-async-args (("-q")))
338 (tramp-remote-sh "/bin/sh")
339 (tramp-copy-program "scp")
340 (tramp-copy-args (("-P" "%p") ("-p" "%k")
341 ("-q") ("-r")))
342 (tramp-copy-keep-date t)
343 (tramp-copy-recursive t)
344 (tramp-password-end-of-line nil)
345 (tramp-gw-args (("-o"
346 "GlobalKnownHostsFile=/dev/null")
347 ("-o" "UserKnownHostsFile=/dev/null")
348 ("-o" "StrictHostKeyChecking=no")))
349 (tramp-default-port 22))
350 ("scp1" (tramp-login-program "ssh")
351 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
352 ("-1" "-e" "none")))
353 (tramp-async-args (("-q")))
354 (tramp-remote-sh "/bin/sh")
355 (tramp-copy-program "scp")
356 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
357 ("-q") ("-r")))
358 (tramp-copy-keep-date t)
359 (tramp-copy-recursive t)
360 (tramp-password-end-of-line nil)
361 (tramp-gw-args (("-o"
362 "GlobalKnownHostsFile=/dev/null")
363 ("-o" "UserKnownHostsFile=/dev/null")
364 ("-o" "StrictHostKeyChecking=no")))
365 (tramp-default-port 22))
366 ("scp2" (tramp-login-program "ssh")
367 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
368 ("-2" "-e" "none")))
369 (tramp-async-args (("-q")))
370 (tramp-remote-sh "/bin/sh")
371 (tramp-copy-program "scp")
372 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
373 ("-q") ("-r")))
374 (tramp-copy-keep-date t)
375 (tramp-copy-recursive t)
376 (tramp-password-end-of-line nil)
377 (tramp-gw-args (("-o"
378 "GlobalKnownHostsFile=/dev/null")
379 ("-o" "UserKnownHostsFile=/dev/null")
380 ("-o" "StrictHostKeyChecking=no")))
381 (tramp-default-port 22))
382 ("scp1_old"
383 (tramp-login-program "ssh1")
384 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
385 ("-e" "none")))
386 (tramp-remote-sh "/bin/sh")
387 (tramp-copy-program "scp1")
388 (tramp-copy-args (("-p" "%k") ("-r")))
389 (tramp-copy-keep-date t)
390 (tramp-copy-recursive t)
391 (tramp-password-end-of-line nil))
392 ("scp2_old"
393 (tramp-login-program "ssh2")
394 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
395 ("-e" "none")))
396 (tramp-remote-sh "/bin/sh")
397 (tramp-copy-program "scp2")
398 (tramp-copy-args (("-p" "%k") ("-r")))
399 (tramp-copy-keep-date t)
400 (tramp-copy-recursive t)
401 (tramp-password-end-of-line nil))
402 ("sftp" (tramp-login-program "ssh")
403 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
404 ("-e" "none")))
405 (tramp-async-args (("-q")))
406 (tramp-remote-sh "/bin/sh")
407 (tramp-copy-program "sftp")
408 (tramp-copy-args nil)
409 (tramp-copy-keep-date nil)
410 (tramp-password-end-of-line nil))
411 ("rsync" (tramp-login-program "ssh")
412 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
413 ("-e" "none")))
414 (tramp-async-args (("-q")))
415 (tramp-remote-sh "/bin/sh")
416 (tramp-copy-program "rsync")
417 (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
418 (tramp-copy-keep-date t)
419 (tramp-copy-keep-tmpfile t)
420 (tramp-copy-recursive t)
421 (tramp-password-end-of-line nil))
422 ("rsyncc"
423 (tramp-login-program "ssh")
424 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
425 ("-o" "ControlPath=%t.%%r@%%h:%%p")
426 ("-o" "ControlMaster=yes")
427 ("-e" "none")))
428 (tramp-async-args (("-q")))
429 (tramp-remote-sh "/bin/sh")
430 (tramp-copy-program "rsync")
431 (tramp-copy-args (("-t" "%k") ("-r")))
432 (tramp-copy-env (("RSYNC_RSH")
433 (,(concat
434 "ssh"
435 " -o ControlPath=%t.%%r@%%h:%%p"
436 " -o ControlMaster=auto"))))
437 (tramp-copy-keep-date t)
438 (tramp-copy-keep-tmpfile t)
439 (tramp-copy-recursive t)
440 (tramp-password-end-of-line nil))
441 ("remcp" (tramp-login-program "remsh")
442 (tramp-login-args (("%h") ("-l" "%u")))
443 (tramp-remote-sh "/bin/sh")
444 (tramp-copy-program "rcp")
445 (tramp-copy-args (("-p" "%k")))
446 (tramp-copy-keep-date t)
447 (tramp-password-end-of-line nil))
448 ("rsh" (tramp-login-program "rsh")
449 (tramp-login-args (("%h") ("-l" "%u")))
450 (tramp-remote-sh "/bin/sh")
451 (tramp-copy-program nil)
452 (tramp-copy-args nil)
453 (tramp-copy-keep-date nil)
454 (tramp-password-end-of-line nil))
455 ("ssh" (tramp-login-program "ssh")
456 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
457 ("-e" "none")))
458 (tramp-async-args (("-q")))
459 (tramp-remote-sh "/bin/sh")
460 (tramp-copy-program nil)
461 (tramp-copy-args nil)
462 (tramp-copy-keep-date nil)
463 (tramp-password-end-of-line nil)
464 (tramp-gw-args (("-o"
465 "GlobalKnownHostsFile=/dev/null")
466 ("-o" "UserKnownHostsFile=/dev/null")
467 ("-o" "StrictHostKeyChecking=no")))
468 (tramp-default-port 22))
469 ("ssh1" (tramp-login-program "ssh")
470 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
471 ("-1" "-e" "none")))
472 (tramp-async-args (("-q")))
473 (tramp-remote-sh "/bin/sh")
474 (tramp-copy-program nil)
475 (tramp-copy-args nil)
476 (tramp-copy-keep-date nil)
477 (tramp-password-end-of-line nil)
478 (tramp-gw-args (("-o"
479 "GlobalKnownHostsFile=/dev/null")
480 ("-o" "UserKnownHostsFile=/dev/null")
481 ("-o" "StrictHostKeyChecking=no")))
482 (tramp-default-port 22))
483 ("ssh2" (tramp-login-program "ssh")
484 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
485 ("-2" "-e" "none")))
486 (tramp-async-args (("-q")))
487 (tramp-remote-sh "/bin/sh")
488 (tramp-copy-program nil)
489 (tramp-copy-args nil)
490 (tramp-copy-keep-date nil)
491 (tramp-password-end-of-line nil)
492 (tramp-gw-args (("-o"
493 "GlobalKnownHostsFile=/dev/null")
494 ("-o" "UserKnownHostsFile=/dev/null")
495 ("-o" "StrictHostKeyChecking=no")))
496 (tramp-default-port 22))
497 ("ssh1_old"
498 (tramp-login-program "ssh1")
499 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
500 ("-e" "none")))
501 (tramp-async-args (("-q")))
502 (tramp-remote-sh "/bin/sh")
503 (tramp-copy-program nil)
504 (tramp-copy-args nil)
505 (tramp-copy-keep-date nil)
506 (tramp-password-end-of-line nil))
507 ("ssh2_old"
508 (tramp-login-program "ssh2")
509 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
510 ("-e" "none")))
511 (tramp-remote-sh "/bin/sh")
512 (tramp-copy-program nil)
513 (tramp-copy-args nil)
514 (tramp-copy-keep-date nil)
515 (tramp-password-end-of-line nil))
516 ("remsh" (tramp-login-program "remsh")
517 (tramp-login-args (("%h") ("-l" "%u")))
518 (tramp-remote-sh "/bin/sh")
519 (tramp-copy-program nil)
520 (tramp-copy-args nil)
521 (tramp-copy-keep-date nil)
522 (tramp-password-end-of-line nil))
523 ("telnet"
524 (tramp-login-program "telnet")
525 (tramp-login-args (("%h") ("%p")))
526 (tramp-remote-sh "/bin/sh")
527 (tramp-copy-program nil)
528 (tramp-copy-args nil)
529 (tramp-copy-keep-date nil)
530 (tramp-password-end-of-line nil)
531 (tramp-default-port 23))
532 ("su" (tramp-login-program "su")
533 (tramp-login-args (("-") ("%u")))
534 (tramp-remote-sh "/bin/sh")
535 (tramp-copy-program nil)
536 (tramp-copy-args nil)
537 (tramp-copy-keep-date nil)
538 (tramp-password-end-of-line nil))
539 ("sudo" (tramp-login-program "sudo")
540 (tramp-login-args (("-u" "%u")
541 ("-s") ("-H") ("-p" "Password:")))
542 (tramp-remote-sh "/bin/sh")
543 (tramp-copy-program nil)
544 (tramp-copy-args nil)
545 (tramp-copy-keep-date nil)
546 (tramp-password-end-of-line nil))
547 ("scpc" (tramp-login-program "ssh")
548 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
549 ("-o" "ControlPath=%t.%%r@%%h:%%p")
550 ("-o" "ControlMaster=yes")
551 ("-e" "none")))
552 (tramp-async-args (("-q")))
553 (tramp-remote-sh "/bin/sh")
554 (tramp-copy-program "scp")
555 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
556 ("-o" "ControlPath=%t.%%r@%%h:%%p")
557 ("-o" "ControlMaster=auto")))
558 (tramp-copy-keep-date t)
559 (tramp-password-end-of-line nil)
560 (tramp-gw-args (("-o"
561 "GlobalKnownHostsFile=/dev/null")
562 ("-o" "UserKnownHostsFile=/dev/null")
563 ("-o" "StrictHostKeyChecking=no")))
564 (tramp-default-port 22))
565 ("scpx" (tramp-login-program "ssh")
566 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
567 ("-e" "none" "-t" "-t" "/bin/sh")))
568 (tramp-async-args (("-q")))
569 (tramp-remote-sh "/bin/sh")
570 (tramp-copy-program "scp")
571 (tramp-copy-args (("-p" "%k")))
572 (tramp-copy-keep-date t)
573 (tramp-password-end-of-line nil)
574 (tramp-gw-args (("-o"
575 "GlobalKnownHostsFile=/dev/null")
576 ("-o" "UserKnownHostsFile=/dev/null")
577 ("-o" "StrictHostKeyChecking=no")))
578 (tramp-default-port 22))
579 ("sshx" (tramp-login-program "ssh")
580 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
581 ("-e" "none" "-t" "-t" "/bin/sh")))
582 (tramp-async-args (("-q")))
583 (tramp-remote-sh "/bin/sh")
584 (tramp-copy-program nil)
585 (tramp-copy-args nil)
586 (tramp-copy-keep-date nil)
587 (tramp-password-end-of-line nil)
588 (tramp-gw-args (("-o"
589 "GlobalKnownHostsFile=/dev/null")
590 ("-o" "UserKnownHostsFile=/dev/null")
591 ("-o" "StrictHostKeyChecking=no")))
592 (tramp-default-port 22))
593 ("krlogin"
594 (tramp-login-program "krlogin")
595 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
596 (tramp-remote-sh "/bin/sh")
597 (tramp-copy-program nil)
598 (tramp-copy-args nil)
599 (tramp-copy-keep-date nil)
600 (tramp-password-end-of-line nil))
601 ("plink" (tramp-login-program "plink")
602 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
603 ("-ssh")))
604 (tramp-remote-sh "/bin/sh")
605 (tramp-copy-program nil)
606 (tramp-copy-args nil)
607 (tramp-copy-keep-date nil)
608 (tramp-password-end-of-line "xy") ;see docstring for "xy"
609 (tramp-default-port 22))
610 ("plink1"
611 (tramp-login-program "plink")
612 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
613 ("-1" "-ssh")))
614 (tramp-remote-sh "/bin/sh")
615 (tramp-copy-program nil)
616 (tramp-copy-args nil)
617 (tramp-copy-keep-date nil)
618 (tramp-password-end-of-line "xy") ;see docstring for "xy"
619 (tramp-default-port 22))
620 ("plinkx"
621 (tramp-login-program "plink")
622 ;; ("%h") must be a single element, see
623 ;; `tramp-compute-multi-hops'.
624 (tramp-login-args (("-load") ("%h") ("-t")
625 (,(format
626 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
627 tramp-terminal-type
628 tramp-initial-end-of-output))
629 ("/bin/sh")))
630 (tramp-remote-sh "/bin/sh")
631 (tramp-copy-program nil)
632 (tramp-copy-args nil)
633 (tramp-copy-keep-date nil)
634 (tramp-password-end-of-line nil))
635 ("pscp" (tramp-login-program "plink")
636 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
637 ("-ssh")))
638 (tramp-remote-sh "/bin/sh")
639 (tramp-copy-program "pscp")
640 (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
641 (tramp-copy-keep-date t)
642 (tramp-password-end-of-line "xy") ;see docstring for "xy"
643 (tramp-default-port 22))
644 ("psftp" (tramp-login-program "plink")
645 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
646 ("-ssh")))
647 (tramp-remote-sh "/bin/sh")
648 (tramp-copy-program "pscp")
649 (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
650 (tramp-copy-keep-date t)
651 (tramp-password-end-of-line "xy")) ;see docstring for "xy"
652 ("fcp" (tramp-login-program "fsh")
653 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
654 (tramp-remote-sh "/bin/sh -i")
655 (tramp-copy-program "fcp")
656 (tramp-copy-args (("-p" "%k")))
657 (tramp-copy-keep-date t)
658 (tramp-password-end-of-line nil)))
659 "*Alist of methods for remote files.
660 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
661 Each NAME stands for a remote access method. Each PARAM is a
662 pair of the form (KEY VALUE). The following KEYs are defined:
663 * `tramp-remote-sh'
664 This specifies the Bourne shell to use on the remote host. This
665 MUST be a Bourne-like shell. It is normally not necessary to set
666 this to any value other than \"/bin/sh\": Tramp wants to use a shell
667 which groks tilde expansion, but it can search for it. Also note
668 that \"/bin/sh\" exists on all Unixen, this might not be true for
669 the value that you decide to use. You Have Been Warned.
670 * `tramp-login-program'
671 This specifies the name of the program to use for logging in to the
672 remote host. This may be the name of rsh or a workalike program,
673 or the name of telnet or a workalike, or the name of su or a workalike.
674 * `tramp-login-args'
675 This specifies the list of arguments to pass to the above
676 mentioned program. Please note that this is a list of list of arguments,
677 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
678 here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
679 There are some patterns: \"%h\" in this list is replaced by the host
680 name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
681 port number, and \"%%\" can be used to obtain a literal percent character.
682 If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
683 expansion (i.e. no host or no user specified), this list is not used as
684 argument. By this, arguments like (\"-l\" \"%u\") are optional.
685 \"%t\" is replaced by the temporary file name produced with
686 `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
687 parameter of a program, if exists.
688 * `tramp-async-args'
689 When an asynchronous process is started, we know already that
690 the connection works. Therefore, we can pass additional
691 parameters to suppress diagnostic messages, in order not to
692 tamper the process output.
693 * `tramp-copy-program'
694 This specifies the name of the program to use for remotely copying
695 the file; this might be the absolute filename of rcp or the name of
696 a workalike program.
697 * `tramp-copy-args'
698 This specifies the list of parameters to pass to the above mentioned
699 program, the hints for `tramp-login-args' also apply here.
700 * `tramp-copy-keep-date'
701 This specifies whether the copying program when the preserves the
702 timestamp of the original file.
703 * `tramp-copy-keep-tmpfile'
704 This specifies whether a temporary local file shall be kept
705 for optimization reasons (useful for \"rsync\" methods).
706 * `tramp-copy-recursive'
707 Whether the operation copies directories recursively.
708 * `tramp-default-port'
709 The default port of a method is needed in case of gateway connections.
710 Additionally, it is used as indication which method is prepared for
711 passing gateways.
712 * `tramp-gw-args'
713 As the attribute name says, additional arguments are specified here
714 when a method is applied via a gateway.
715 * `tramp-password-end-of-line'
716 This specifies the string to use for terminating the line after
717 submitting the password. If this method parameter is nil, then the
718 value of the normal variable `tramp-default-password-end-of-line'
719 is used. This parameter is necessary because the \"plink\" program
720 requires any two characters after sending the password. These do
721 not have to be newline or carriage return characters. Other login
722 programs are happy with just one character, the newline character.
723 We use \"xy\" as the value for methods using \"plink\".
724
725 What does all this mean? Well, you should specify `tramp-login-program'
726 for all methods; this program is used to log in to the remote site. Then,
727 there are two ways to actually transfer the files between the local and the
728 remote side. One way is using an additional rcp-like program. If you want
729 to do this, set `tramp-copy-program' in the method.
730
731 Another possibility for file transfer is inline transfer, i.e. the
732 file is passed through the same buffer used by `tramp-login-program'. In
733 this case, the file contents need to be protected since the
734 `tramp-login-program' might use escape codes or the connection might not
735 be eight-bit clean. Therefore, file contents are encoded for transit.
736 See the variables `tramp-local-coding-commands' and
737 `tramp-remote-coding-commands' for details.
738
739 So, to summarize: if the method is an out-of-band method, then you
740 must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
741 inline method, then these two parameters should be nil. Methods which
742 are fit for gateways must have `tramp-default-port' at least.
743
744 Notes:
745
746 When using `su' or `sudo' the phrase `open connection to a remote
747 host' sounds strange, but it is used nevertheless, for consistency.
748 No connection is opened to a remote host, but `su' or `sudo' is
749 started on the local host. You should specify a remote host
750 `localhost' or the name of the local host. Another host name is
751 useful only in combination with `tramp-default-proxies-alist'.")
752
753 (defun tramp-detect-ssh-controlmaster ()
754 "Call ssh to detect whether it supports the ControlMaster argument.
755 This function may return nil when the argument is supported, but
756 shouldn't return t when it isn't."
757 (ignore-errors
758 (with-temp-buffer
759 (call-process "ssh" nil t nil "-o" "ControlMaster")
760 (goto-char (point-min))
761 (search-forward-regexp "Missing ControlMaster argument" nil t))))
762
763 (defcustom tramp-default-method
764 ;; An external copy method seems to be preferred, because it is much
765 ;; more performant for large files, and it hasn't too serious delays
766 ;; for small files. But it must be ensured that there aren't
767 ;; permanent password queries. Either a password agent like
768 ;; "ssh-agent" or "Pageant" shall run, or the optional
769 ;; password-cache.el or auth-sources.el packages shall be active for
770 ;; password caching. "scpc" is chosen if we detect that the user is
771 ;; running OpenSSH 4.0 or newer.
772 (cond
773 ;; PuTTY is installed.
774 ((executable-find "pscp")
775 (if (or (fboundp 'password-read)
776 (fboundp 'auth-source-user-or-password)
777 ;; Pageant is running.
778 (tramp-compat-process-running-p "Pageant"))
779 "pscp"
780 "plink"))
781 ;; There is an ssh installation.
782 ((executable-find "scp")
783 (cond
784 ((tramp-detect-ssh-controlmaster) "scpc")
785 ((or (fboundp 'password-read)
786 (fboundp 'auth-source-user-or-password)
787 ;; ssh-agent is running.
788 (getenv "SSH_AUTH_SOCK")
789 (getenv "SSH_AGENT_PID"))
790 "scp")
791 (t "ssh")))
792 ;; Fallback.
793 (t "ftp"))
794 "*Default method to use for transferring files.
795 See `tramp-methods' for possibilities.
796 Also see `tramp-default-method-alist'."
797 :group 'tramp
798 :type 'string)
799
800 (defcustom tramp-default-method-alist
801 '(("\\`localhost\\'" "\\`root\\'" "su"))
802 "*Default method to use for specific host/user pairs.
803 This is an alist of items (HOST USER METHOD). The first matching item
804 specifies the method to use for a file name which does not specify a
805 method. HOST and USER are regular expressions or nil, which is
806 interpreted as a regular expression which always matches. If no entry
807 matches, the variable `tramp-default-method' takes effect.
808
809 If the file name does not specify the user, lookup is done using the
810 empty string for the user name.
811
812 See `tramp-methods' for a list of possibilities for METHOD."
813 :group 'tramp
814 :type '(repeat (list (regexp :tag "Host regexp")
815 (regexp :tag "User regexp")
816 (string :tag "Method"))))
817
818 (defcustom tramp-default-user
819 nil
820 "*Default user to use for transferring files.
821 It is nil by default; otherwise settings in configuration files like
822 \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
823
824 This variable is regarded as obsolete, and will be removed soon."
825 :group 'tramp
826 :type '(choice (const nil) string))
827
828 (defcustom tramp-default-user-alist
829 `(("\\`su\\(do\\)?\\'" nil "root")
830 ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
831 nil ,(user-login-name)))
832 "*Default user to use for specific method/host pairs.
833 This is an alist of items (METHOD HOST USER). The first matching item
834 specifies the user to use for a file name which does not specify a
835 user. METHOD and USER are regular expressions or nil, which is
836 interpreted as a regular expression which always matches. If no entry
837 matches, the variable `tramp-default-user' takes effect.
838
839 If the file name does not specify the method, lookup is done using the
840 empty string for the method name."
841 :group 'tramp
842 :type '(repeat (list (regexp :tag "Method regexp")
843 (regexp :tag "Host regexp")
844 (string :tag "User"))))
845
846 (defcustom tramp-default-host
847 (system-name)
848 "*Default host to use for transferring files.
849 Useful for su and sudo methods mostly."
850 :group 'tramp
851 :type 'string)
852
853 (defcustom tramp-default-proxies-alist nil
854 "*Route to be followed for specific host/user pairs.
855 This is an alist of items (HOST USER PROXY). The first matching
856 item specifies the proxy to be passed for a file name located on
857 a remote target matching USER@HOST. HOST and USER are regular
858 expressions. PROXY must be a Tramp filename without a localname
859 part. Method and user name on PROXY are optional, which is
860 interpreted with the default values. PROXY can contain the
861 patterns %h and %u, which are replaced by the strings matching
862 HOST or USER, respectively.
863
864 HOST, USER or PROXY could also be Lisp forms, which will be
865 evaluated. The result must be a string or nil, which is
866 interpreted as a regular expression which always matches."
867 :group 'tramp
868 :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
869 (choice :tag "User regexp" regexp sexp)
870 (choice :tag "Proxy remote name" string (const nil)))))
871
872 (defconst tramp-local-host-regexp
873 (concat
874 "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$")
875 "*Host names which are regarded as local host.")
876
877 (defconst tramp-completion-function-alist-rsh
878 '((tramp-parse-rhosts "/etc/hosts.equiv")
879 (tramp-parse-rhosts "~/.rhosts"))
880 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
881
882 (defconst tramp-completion-function-alist-ssh
883 '((tramp-parse-rhosts "/etc/hosts.equiv")
884 (tramp-parse-rhosts "/etc/shosts.equiv")
885 (tramp-parse-shosts "/etc/ssh_known_hosts")
886 (tramp-parse-sconfig "/etc/ssh_config")
887 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
888 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
889 (tramp-parse-rhosts "~/.rhosts")
890 (tramp-parse-rhosts "~/.shosts")
891 (tramp-parse-shosts "~/.ssh/known_hosts")
892 (tramp-parse-sconfig "~/.ssh/config")
893 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
894 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
895 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
896
897 (defconst tramp-completion-function-alist-telnet
898 '((tramp-parse-hosts "/etc/hosts"))
899 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
900
901 (defconst tramp-completion-function-alist-su
902 '((tramp-parse-passwd "/etc/passwd"))
903 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
904
905 (defconst tramp-completion-function-alist-putty
906 '((tramp-parse-putty
907 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
908 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
909
910 (defvar tramp-completion-function-alist nil
911 "*Alist of methods for remote files.
912 This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
913 Each NAME stands for a remote access method. Each PAIR is of the form
914 \(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
915 names from FILE for completion. The following predefined FUNCTIONs exists:
916
917 * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
918 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
919 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
920 * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
921 * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
922 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
923 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
924 * `tramp-parse-netrc' for \"~/.netrc\" like files.
925 * `tramp-parse-putty' for PuTTY registry keys.
926
927 FUNCTION can also be a customer defined function. For more details see
928 the info pages.")
929
930 (eval-after-load "tramp"
931 '(progn
932 (tramp-set-completion-function
933 "rcp" tramp-completion-function-alist-rsh)
934 (tramp-set-completion-function
935 "scp" tramp-completion-function-alist-ssh)
936 (tramp-set-completion-function
937 "scp1" tramp-completion-function-alist-ssh)
938 (tramp-set-completion-function
939 "scp2" tramp-completion-function-alist-ssh)
940 (tramp-set-completion-function
941 "scp1_old" tramp-completion-function-alist-ssh)
942 (tramp-set-completion-function
943 "scp2_old" tramp-completion-function-alist-ssh)
944 (tramp-set-completion-function
945 "rsync" tramp-completion-function-alist-ssh)
946 (tramp-set-completion-function
947 "rsyncc" tramp-completion-function-alist-ssh)
948 (tramp-set-completion-function
949 "remcp" tramp-completion-function-alist-rsh)
950 (tramp-set-completion-function
951 "rsh" tramp-completion-function-alist-rsh)
952 (tramp-set-completion-function
953 "ssh" tramp-completion-function-alist-ssh)
954 (tramp-set-completion-function
955 "ssh1" tramp-completion-function-alist-ssh)
956 (tramp-set-completion-function
957 "ssh2" tramp-completion-function-alist-ssh)
958 (tramp-set-completion-function
959 "ssh1_old" tramp-completion-function-alist-ssh)
960 (tramp-set-completion-function
961 "ssh2_old" tramp-completion-function-alist-ssh)
962 (tramp-set-completion-function
963 "remsh" tramp-completion-function-alist-rsh)
964 (tramp-set-completion-function
965 "telnet" tramp-completion-function-alist-telnet)
966 (tramp-set-completion-function
967 "su" tramp-completion-function-alist-su)
968 (tramp-set-completion-function
969 "sudo" tramp-completion-function-alist-su)
970 (tramp-set-completion-function
971 "scpx" tramp-completion-function-alist-ssh)
972 (tramp-set-completion-function
973 "sshx" tramp-completion-function-alist-ssh)
974 (tramp-set-completion-function
975 "krlogin" tramp-completion-function-alist-rsh)
976 (tramp-set-completion-function
977 "plink" tramp-completion-function-alist-ssh)
978 (tramp-set-completion-function
979 "plink1" tramp-completion-function-alist-ssh)
980 (tramp-set-completion-function
981 "plinkx" tramp-completion-function-alist-putty)
982 (tramp-set-completion-function
983 "pscp" tramp-completion-function-alist-ssh)
984 (tramp-set-completion-function
985 "fcp" tramp-completion-function-alist-ssh)))
986
987 (defconst tramp-echo-mark-marker "_echo"
988 "String marker to surround echoed commands.")
989
990 (defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
991 "String length of `tramp-echo-mark-marker'.")
992
993 (defconst tramp-echo-mark
994 (concat tramp-echo-mark-marker
995 (make-string tramp-echo-mark-marker-length ?\b))
996 "String mark to be transmitted around shell commands.
997 Used to separate their echo from the output they produce. This
998 will only be used if we cannot disable remote echo via stty.
999 This string must have no effect on the remote shell except for
1000 producing some echo which can later be detected by
1001 `tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
1002 followed by an equal number of backspaces to erase them will
1003 usually suffice.")
1004
1005 (defconst tramp-echoed-echo-mark-regexp
1006 (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
1007 tramp-echo-mark-marker tramp-echo-mark-marker-length)
1008 "Regexp which matches `tramp-echo-mark' as it gets echoed by
1009 the remote shell.")
1010
1011 (defcustom tramp-rsh-end-of-line "\n"
1012 "*String used for end of line in rsh connections.
1013 I don't think this ever needs to be changed, so please tell me about it
1014 if you need to change this.
1015 Also see the method parameter `tramp-password-end-of-line' and the normal
1016 variable `tramp-default-password-end-of-line'."
1017 :group 'tramp
1018 :type 'string)
1019
1020 (defcustom tramp-default-password-end-of-line
1021 tramp-rsh-end-of-line
1022 "*String used for end of line after sending a password.
1023 This variable provides the default value for the method parameter
1024 `tramp-password-end-of-line', see `tramp-methods' for more details.
1025
1026 It seems that people using plink under Windows need to send
1027 \"\\r\\n\" (carriage-return, then newline) after a password, but just
1028 \"\\n\" after all other lines. This variable can be used for the
1029 password, see `tramp-rsh-end-of-line' for the other cases.
1030
1031 The default value is to use the same value as `tramp-rsh-end-of-line'."
1032 :group 'tramp
1033 :type 'string)
1034
1035 ;; "getconf PATH" yields:
1036 ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
1037 ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
1038 ;; GNU/Linux (Debian, Suse): /bin:/usr/bin
1039 ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
1040 (defcustom tramp-remote-path
1041 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
1042 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
1043 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
1044 "*List of directories to search for executables on remote host.
1045 For every remote host, this variable will be set buffer local,
1046 keeping the list of existing directories on that host.
1047
1048 You can use `~' in this list, but when searching for a shell which groks
1049 tilde expansion, all directory names starting with `~' will be ignored.
1050
1051 `Default Directories' represent the list of directories given by
1052 the command \"getconf PATH\". It is recommended to use this
1053 entry on top of this list, because these are the default
1054 directories for POSIX compatible commands.
1055
1056 `Private Directories' are the settings of the $PATH environment,
1057 as given in your `~/.profile'."
1058 :group 'tramp
1059 :type '(repeat (choice
1060 (const :tag "Default Directories" tramp-default-remote-path)
1061 (const :tag "Private Directories" tramp-own-remote-path)
1062 (string :tag "Directory"))))
1063
1064 (defcustom tramp-remote-process-environment
1065 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
1066 ,(format "TERM=%s" tramp-terminal-type)
1067 "EMACS=t" ;; Deprecated.
1068 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
1069 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
1070 "autocorrect=" "correct=")
1071
1072 "*List of environment variables to be set on the remote host.
1073
1074 Each element should be a string of the form ENVVARNAME=VALUE. An
1075 entry ENVVARNAME= diables the corresponding environment variable,
1076 which might have been set in the init files like ~/.profile.
1077
1078 Special handling is applied to the PATH environment, which should
1079 not be set here. Instead of, it should be set via `tramp-remote-path'."
1080 :group 'tramp
1081 :type '(repeat string))
1082
1083 (defcustom tramp-login-prompt-regexp
1084 ".*ogin\\( .*\\)?: *"
1085 "*Regexp matching login-like prompts.
1086 The regexp should match at end of buffer.
1087
1088 Sometimes the prompt is reported to look like \"login as:\"."
1089 :group 'tramp
1090 :type 'regexp)
1091
1092 (defcustom tramp-shell-prompt-pattern
1093 ;; Allow a prompt to start right after a ^M since it indeed would be
1094 ;; displayed at the beginning of the line (and Zsh uses it). This
1095 ;; regexp works only for GNU Emacs.
1096 (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
1097 "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
1098 "Regexp to match prompts from remote shell.
1099 Normally, Tramp expects you to configure `shell-prompt-pattern'
1100 correctly, but sometimes it happens that you are connecting to a
1101 remote host which sends a different kind of shell prompt. Therefore,
1102 Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
1103 and also things matched by this variable. The default value of this
1104 variable is similar to the default value of `shell-prompt-pattern',
1105 which should work well in many cases.
1106
1107 This regexp must match both `tramp-initial-end-of-output' and
1108 `tramp-end-of-output'."
1109 :group 'tramp
1110 :type 'regexp)
1111
1112 (defcustom tramp-password-prompt-regexp
1113 "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
1114 "*Regexp matching password-like prompts.
1115 The regexp should match at end of buffer.
1116
1117 The `sudo' program appears to insert a `^@' character into the prompt."
1118 :group 'tramp
1119 :type 'regexp)
1120
1121 (defcustom tramp-wrong-passwd-regexp
1122 (concat "^.*"
1123 ;; These strings should be on the last line
1124 (regexp-opt '("Permission denied"
1125 "Login incorrect"
1126 "Login Incorrect"
1127 "Connection refused"
1128 "Connection closed"
1129 "Timeout, server not responding."
1130 "Sorry, try again."
1131 "Name or service not known"
1132 "Host key verification failed."
1133 "No supported authentication methods left to try!") t)
1134 ".*"
1135 "\\|"
1136 "^.*\\("
1137 ;; Here comes a list of regexes, separated by \\|
1138 "Received signal [0-9]+"
1139 "\\).*")
1140 "*Regexp matching a `login failed' message.
1141 The regexp should match at end of buffer."
1142 :group 'tramp
1143 :type 'regexp)
1144
1145 (defcustom tramp-yesno-prompt-regexp
1146 (concat
1147 (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
1148 "\\s-*")
1149 "Regular expression matching all yes/no queries which need to be confirmed.
1150 The confirmation should be done with yes or no.
1151 The regexp should match at end of buffer.
1152 See also `tramp-yn-prompt-regexp'."
1153 :group 'tramp
1154 :type 'regexp)
1155
1156 (defcustom tramp-yn-prompt-regexp
1157 (concat
1158 (regexp-opt '("Store key in cache? (y/n)"
1159 "Update cached key? (y/n, Return cancels connection)") t)
1160 "\\s-*")
1161 "Regular expression matching all y/n queries which need to be confirmed.
1162 The confirmation should be done with y or n.
1163 The regexp should match at end of buffer.
1164 See also `tramp-yesno-prompt-regexp'."
1165 :group 'tramp
1166 :type 'regexp)
1167
1168 (defcustom tramp-terminal-prompt-regexp
1169 (concat "\\("
1170 "TERM = (.*)"
1171 "\\|"
1172 "Terminal type\\? \\[.*\\]"
1173 "\\)\\s-*")
1174 "Regular expression matching all terminal setting prompts.
1175 The regexp should match at end of buffer.
1176 The answer will be provided by `tramp-action-terminal', which see."
1177 :group 'tramp
1178 :type 'regexp)
1179
1180 (defcustom tramp-operation-not-permitted-regexp
1181 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
1182 (regexp-opt '("Operation not permitted") t))
1183 "Regular expression matching keep-date problems in (s)cp operations.
1184 Copying has been performed successfully already, so this message can
1185 be ignored safely."
1186 :group 'tramp
1187 :type 'regexp)
1188
1189 (defcustom tramp-copy-failed-regexp
1190 (concat "\\(.+: "
1191 (regexp-opt '("Permission denied"
1192 "not a regular file"
1193 "is a directory"
1194 "No such file or directory") t)
1195 "\\)\\s-*")
1196 "Regular expression matching copy problems in (s)cp operations."
1197 :group 'tramp
1198 :type 'regexp)
1199
1200 (defcustom tramp-process-alive-regexp
1201 ""
1202 "Regular expression indicating a process has finished.
1203 In fact this expression is empty by intention, it will be used only to
1204 check regularly the status of the associated process.
1205 The answer will be provided by `tramp-action-process-alive',
1206 `tramp-action-out-of-band', which see."
1207 :group 'tramp
1208 :type 'regexp)
1209
1210 (defcustom tramp-temp-name-prefix "tramp."
1211 "*Prefix to use for temporary files.
1212 If this is a relative file name (such as \"tramp.\"), it is considered
1213 relative to the directory name returned by the function
1214 `tramp-compat-temporary-file-directory' (which see). It may also be an
1215 absolute file name; don't forget to include a prefix for the filename
1216 part, though."
1217 :group 'tramp
1218 :type 'string)
1219
1220 (defconst tramp-temp-buffer-name " *tramp temp*"
1221 "Buffer name for a temporary buffer.
1222 It shall be used in combination with `generate-new-buffer-name'.")
1223
1224 (defvar tramp-temp-buffer-file-name nil
1225 "File name of a persistent local temporary file.
1226 Useful for \"rsync\" like methods.")
1227 (make-variable-buffer-local 'tramp-temp-buffer-file-name)
1228
1229 (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
1230 "*Alist specifying extra arguments to pass to the remote shell.
1231 Entries are (REGEXP . ARGS) where REGEXP is a regular expression
1232 matching the shell file name and ARGS is a string specifying the
1233 arguments.
1234
1235 This variable is only used when Tramp needs to start up another shell
1236 for tilde expansion. The extra arguments should typically prevent the
1237 shell from reading its init file."
1238 :group 'tramp
1239 ;; This might be the wrong way to test whether the widget type
1240 ;; `alist' is available. Who knows the right way to test it?
1241 :type (if (get 'alist 'widget-type)
1242 '(alist :key-type string :value-type string)
1243 '(repeat (cons string string))))
1244
1245 ;; XEmacs is distributed with few Lisp packages. Further packages are
1246 ;; installed using EFS. If we use a unified filename format, then
1247 ;; Tramp is required in addition to EFS. (But why can't Tramp just
1248 ;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
1249 ;; just like before.) Another reason for using a separate filename
1250 ;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
1251 ;; Tramp only knows how to deal with `file-name-handler-alist', not
1252 ;; the other places.
1253
1254 ;; Currently, we have the choice between 'ftp, 'sep, and 'url.
1255 ;;;###autoload
1256 (defcustom tramp-syntax
1257 (if (featurep 'xemacs) 'sep 'ftp)
1258 "Tramp filename syntax to be used.
1259
1260 It can have the following values:
1261
1262 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
1263 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
1264 'url -- URL-like syntax."
1265 :group 'tramp
1266 :type (if (featurep 'xemacs)
1267 '(choice (const :tag "EFS" ftp)
1268 (const :tag "XEmacs" sep)
1269 (const :tag "URL" url))
1270 '(choice (const :tag "Ange-FTP" ftp)
1271 (const :tag "URL" url))))
1272
1273 (defconst tramp-prefix-format
1274 (cond ((equal tramp-syntax 'ftp) "/")
1275 ((equal tramp-syntax 'sep) "/[")
1276 ((equal tramp-syntax 'url) "/")
1277 (t (error "Wrong `tramp-syntax' defined")))
1278 "*String matching the very beginning of Tramp file names.
1279 Used in `tramp-make-tramp-file-name'.")
1280
1281 (defconst tramp-prefix-regexp
1282 (concat "^" (regexp-quote tramp-prefix-format))
1283 "*Regexp matching the very beginning of Tramp file names.
1284 Should always start with \"^\". Derived from `tramp-prefix-format'.")
1285
1286 (defconst tramp-method-regexp
1287 "[a-zA-Z_0-9-]+"
1288 "*Regexp matching methods identifiers.")
1289
1290 (defconst tramp-postfix-method-format
1291 (cond ((equal tramp-syntax 'ftp) ":")
1292 ((equal tramp-syntax 'sep) "/")
1293 ((equal tramp-syntax 'url) "://")
1294 (t (error "Wrong `tramp-syntax' defined")))
1295 "*String matching delimeter between method and user or host names.
1296 Used in `tramp-make-tramp-file-name'.")
1297
1298 (defconst tramp-postfix-method-regexp
1299 (regexp-quote tramp-postfix-method-format)
1300 "*Regexp matching delimeter between method and user or host names.
1301 Derived from `tramp-postfix-method-format'.")
1302
1303 (defconst tramp-user-regexp
1304 "[^:/ \t]+"
1305 "*Regexp matching user names.")
1306
1307 (defconst tramp-prefix-domain-format "%"
1308 "*String matching delimeter between user and domain names.")
1309
1310 (defconst tramp-prefix-domain-regexp
1311 (regexp-quote tramp-prefix-domain-format)
1312 "*Regexp matching delimeter between user and domain names.
1313 Derived from `tramp-prefix-domain-format'.")
1314
1315 (defconst tramp-domain-regexp
1316 "[-a-zA-Z0-9_.]+"
1317 "*Regexp matching domain names.")
1318
1319 (defconst tramp-user-with-domain-regexp
1320 (concat "\\(" tramp-user-regexp "\\)"
1321 tramp-prefix-domain-regexp
1322 "\\(" tramp-domain-regexp "\\)")
1323 "*Regexp matching user names with domain names.")
1324
1325 (defconst tramp-postfix-user-format
1326 "@"
1327 "*String matching delimeter between user and host names.
1328 Used in `tramp-make-tramp-file-name'.")
1329
1330 (defconst tramp-postfix-user-regexp
1331 (regexp-quote tramp-postfix-user-format)
1332 "*Regexp matching delimeter between user and host names.
1333 Derived from `tramp-postfix-user-format'.")
1334
1335 (defconst tramp-host-regexp
1336 "[a-zA-Z0-9_.-]+"
1337 "*Regexp matching host names.")
1338
1339 (defconst tramp-prefix-ipv6-format
1340 (cond ((equal tramp-syntax 'ftp) "[")
1341 ((equal tramp-syntax 'sep) "")
1342 ((equal tramp-syntax 'url) "[")
1343 (t (error "Wrong `tramp-syntax' defined")))
1344 "*String matching left hand side of IPv6 addresses.
1345 Used in `tramp-make-tramp-file-name'.")
1346
1347 (defconst tramp-prefix-ipv6-regexp
1348 (regexp-quote tramp-prefix-ipv6-format)
1349 "*Regexp matching left hand side of IPv6 addresses.
1350 Derived from `tramp-prefix-ipv6-format'.")
1351
1352 ;; The following regexp is a bit sloppy. But it shall serve our
1353 ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
1354 ;; "::ffff:192.168.0.1".
1355 (defconst tramp-ipv6-regexp
1356 "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
1357 "*Regexp matching IPv6 addresses.")
1358
1359 (defconst tramp-postfix-ipv6-format
1360 (cond ((equal tramp-syntax 'ftp) "]")
1361 ((equal tramp-syntax 'sep) "")
1362 ((equal tramp-syntax 'url) "]")
1363 (t (error "Wrong `tramp-syntax' defined")))
1364 "*String matching right hand side of IPv6 addresses.
1365 Used in `tramp-make-tramp-file-name'.")
1366
1367 (defconst tramp-postfix-ipv6-regexp
1368 (regexp-quote tramp-postfix-ipv6-format)
1369 "*Regexp matching right hand side of IPv6 addresses.
1370 Derived from `tramp-postfix-ipv6-format'.")
1371
1372 (defconst tramp-prefix-port-format
1373 (cond ((equal tramp-syntax 'ftp) "#")
1374 ((equal tramp-syntax 'sep) "#")
1375 ((equal tramp-syntax 'url) ":")
1376 (t (error "Wrong `tramp-syntax' defined")))
1377 "*String matching delimeter between host names and port numbers.")
1378
1379 (defconst tramp-prefix-port-regexp
1380 (regexp-quote tramp-prefix-port-format)
1381 "*Regexp matching delimeter between host names and port numbers.
1382 Derived from `tramp-prefix-port-format'.")
1383
1384 (defconst tramp-port-regexp
1385 "[0-9]+"
1386 "*Regexp matching port numbers.")
1387
1388 (defconst tramp-host-with-port-regexp
1389 (concat "\\(" tramp-host-regexp "\\)"
1390 tramp-prefix-port-regexp
1391 "\\(" tramp-port-regexp "\\)")
1392 "*Regexp matching host names with port numbers.")
1393
1394 (defconst tramp-postfix-host-format
1395 (cond ((equal tramp-syntax 'ftp) ":")
1396 ((equal tramp-syntax 'sep) "]")
1397 ((equal tramp-syntax 'url) "")
1398 (t (error "Wrong `tramp-syntax' defined")))
1399 "*String matching delimeter between host names and localnames.
1400 Used in `tramp-make-tramp-file-name'.")
1401
1402 (defconst tramp-postfix-host-regexp
1403 (regexp-quote tramp-postfix-host-format)
1404 "*Regexp matching delimeter between host names and localnames.
1405 Derived from `tramp-postfix-host-format'.")
1406
1407 (defconst tramp-localname-regexp
1408 ".*$"
1409 "*Regexp matching localnames.")
1410
1411 ;; File name format.
1412
1413 (defconst tramp-file-name-structure
1414 (list
1415 (concat
1416 tramp-prefix-regexp
1417 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
1418 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
1419 "\\(" "\\(" tramp-host-regexp
1420 "\\|"
1421 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
1422 tramp-postfix-ipv6-regexp "\\)"
1423 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
1424 tramp-postfix-host-regexp
1425 "\\(" tramp-localname-regexp "\\)")
1426 2 4 5 8)
1427
1428 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
1429 the Tramp file name structure.
1430
1431 The first element REGEXP is a regular expression matching a Tramp file
1432 name. The regex should contain parentheses around the method name,
1433 the user name, the host name, and the file name parts.
1434
1435 The second element METHOD is a number, saying which pair of
1436 parentheses matches the method name. The third element USER is
1437 similar, but for the user name. The fourth element HOST is similar,
1438 but for the host name. The fifth element FILE is for the file name.
1439 These numbers are passed directly to `match-string', which see. That
1440 means the opening parentheses are counted to identify the pair.
1441
1442 See also `tramp-file-name-regexp'.")
1443
1444 ;;;###autoload
1445 (defconst tramp-file-name-regexp-unified
1446 "\\`/\\([^[/:]+\\|[^/]+]\\):"
1447 "Value for `tramp-file-name-regexp' for unified remoting.
1448 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1449 Tramp. See `tramp-file-name-structure' for more explanations.")
1450
1451 ;;;###autoload
1452 (defconst tramp-file-name-regexp-separate
1453 "\\`/\\[.*\\]"
1454 "Value for `tramp-file-name-regexp' for separate remoting.
1455 XEmacs uses a separate filename syntax for Tramp and EFS.
1456 See `tramp-file-name-structure' for more explanations.")
1457
1458 ;;;###autoload
1459 (defconst tramp-file-name-regexp-url
1460 "\\`/[^/:]+://"
1461 "Value for `tramp-file-name-regexp' for URL-like remoting.
1462 See `tramp-file-name-structure' for more explanations.")
1463
1464 ;;;###autoload
1465 (defconst tramp-file-name-regexp
1466 (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
1467 ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
1468 ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
1469 (t (error "Wrong `tramp-syntax' defined")))
1470 "*Regular expression matching file names handled by Tramp.
1471 This regexp should match Tramp file names but no other file names.
1472 When tramp.el is loaded, this regular expression is prepended to
1473 `file-name-handler-alist', and that is searched sequentially. Thus,
1474 if the Tramp entry appears rather early in the `file-name-handler-alist'
1475 and is a bit too general, then some files might be considered Tramp
1476 files which are not really Tramp files.
1477
1478 Please note that the entry in `file-name-handler-alist' is made when
1479 this file \(tramp.el\) is loaded. This means that this variable must be set
1480 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1481 updated after changing this variable.
1482
1483 Also see `tramp-file-name-structure'.")
1484
1485 ;;;###autoload
1486 (defconst tramp-root-regexp
1487 (if (memq system-type '(cygwin windows-nt))
1488 "\\`\\([a-zA-Z]:\\)?/"
1489 "\\`/")
1490 "Beginning of an incomplete Tramp file name.
1491 Usually, it is just \"\\\\`/\". On W32 systems, there might be a
1492 volume letter, which will be removed by `tramp-drop-volume-letter'.")
1493
1494 ;;;###autoload
1495 (defconst tramp-completion-file-name-regexp-unified
1496 (concat tramp-root-regexp "[^/]*\\'")
1497 "Value for `tramp-completion-file-name-regexp' for unified remoting.
1498 GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
1499 See `tramp-file-name-structure' for more explanations.")
1500
1501 ;;;###autoload
1502 (defconst tramp-completion-file-name-regexp-separate
1503 (concat tramp-root-regexp "\\([[][^]]*\\)?\\'")
1504 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1505 XEmacs uses a separate filename syntax for Tramp and EFS.
1506 See `tramp-file-name-structure' for more explanations.")
1507
1508 ;;;###autoload
1509 (defconst tramp-completion-file-name-regexp-url
1510 (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'")
1511 "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
1512 See `tramp-file-name-structure' for more explanations.")
1513
1514 ;;;###autoload
1515 (defconst tramp-completion-file-name-regexp
1516 (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
1517 ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
1518 ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
1519 (t (error "Wrong `tramp-syntax' defined")))
1520 "*Regular expression matching file names handled by Tramp completion.
1521 This regexp should match partial Tramp file names only.
1522
1523 Please note that the entry in `file-name-handler-alist' is made when
1524 this file (tramp.el) is loaded. This means that this variable must be set
1525 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1526 updated after changing this variable.
1527
1528 Also see `tramp-file-name-structure'.")
1529
1530 (defconst tramp-actions-before-shell
1531 '((tramp-login-prompt-regexp tramp-action-login)
1532 (tramp-password-prompt-regexp tramp-action-password)
1533 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1534 (shell-prompt-pattern tramp-action-succeed)
1535 (tramp-shell-prompt-pattern tramp-action-succeed)
1536 (tramp-yesno-prompt-regexp tramp-action-yesno)
1537 (tramp-yn-prompt-regexp tramp-action-yn)
1538 (tramp-terminal-prompt-regexp tramp-action-terminal)
1539 (tramp-process-alive-regexp tramp-action-process-alive))
1540 "List of pattern/action pairs.
1541 Whenever a pattern matches, the corresponding action is performed.
1542 Each item looks like (PATTERN ACTION).
1543
1544 The PATTERN should be a symbol, a variable. The value of this
1545 variable gives the regular expression to search for. Note that the
1546 regexp must match at the end of the buffer, \"\\'\" is implicitly
1547 appended to it.
1548
1549 The ACTION should also be a symbol, but a function. When the
1550 corresponding PATTERN matches, the ACTION function is called.")
1551
1552 (defconst tramp-actions-copy-out-of-band
1553 '((tramp-password-prompt-regexp tramp-action-password)
1554 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1555 (tramp-copy-failed-regexp tramp-action-permission-denied)
1556 (tramp-process-alive-regexp tramp-action-out-of-band))
1557 "List of pattern/action pairs.
1558 This list is used for copying/renaming with out-of-band methods.
1559
1560 See `tramp-actions-before-shell' for more info.")
1561
1562 ;; Chunked sending kludge. We set this to 500 for black-listed constellations
1563 ;; known to have a bug in `process-send-string'; some ssh connections appear
1564 ;; to drop bytes when data is sent too quickly. There is also a connection
1565 ;; buffer local variable, which is computed depending on remote host properties
1566 ;; when `tramp-chunksize' is zero or nil.
1567 (defcustom tramp-chunksize
1568 (when (and (not (featurep 'xemacs))
1569 (memq system-type '(hpux)))
1570 500)
1571 ;; Parentheses in docstring starting at beginning of line are escaped.
1572 ;; Fontification is messed up when
1573 ;; `open-paren-in-column-0-is-defun-start' set to t.
1574 "*If non-nil, chunksize for sending input to local process.
1575 It is necessary only on systems which have a buggy `process-send-string'
1576 implementation. The necessity, whether this variable must be set, can be
1577 checked via the following code:
1578
1579 (with-temp-buffer
1580 (let* ((user \"xxx\") (host \"yyy\")
1581 (init 0) (step 50)
1582 (sent init) (received init))
1583 (while (= sent received)
1584 (setq sent (+ sent step))
1585 (erase-buffer)
1586 (let ((proc (start-process (buffer-name) (current-buffer)
1587 \"ssh\" \"-l\" user host \"wc\" \"-c\")))
1588 (when (memq (process-status proc) '(run open))
1589 (process-send-string proc (make-string sent ?\\ ))
1590 (process-send-eof proc)
1591 (process-send-eof proc))
1592 (while (not (progn (goto-char (point-min))
1593 (re-search-forward \"\\\\w+\" (point-max) t)))
1594 (accept-process-output proc 1))
1595 (when (memq (process-status proc) '(run open))
1596 (setq received (string-to-number (match-string 0)))
1597 (delete-process proc)
1598 (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
1599 (sit-for 0))))
1600 (if (> sent (+ init step))
1601 (message \"You should set `tramp-chunksize' to a maximum of %s\"
1602 (- sent step))
1603 (message \"Test does not work\")
1604 (display-buffer (current-buffer))
1605 (sit-for 30))))
1606
1607 In the Emacs normally running Tramp, evaluate the above code
1608 \(replace \"xxx\" and \"yyy\" by the remote user and host name,
1609 respectively\). You can do this, for example, by pasting it into
1610 the `*scratch*' buffer and then hitting C-j with the cursor after the
1611 last closing parenthesis. Note that it works only if you have configured
1612 \"ssh\" to run without password query, see ssh-agent\(1\).
1613
1614 You will see the number of bytes sent successfully to the remote host.
1615 If that number exceeds 1000, you can stop the execution by hitting
1616 C-g, because your Emacs is likely clean.
1617
1618 When it is necessary to set `tramp-chunksize', you might consider to
1619 use an out-of-the-band method \(like \"scp\"\) instead of an internal one
1620 \(like \"ssh\"\), because setting `tramp-chunksize' to non-nil decreases
1621 performance.
1622
1623 If your Emacs is buggy, the code stops and gives you an indication
1624 about the value `tramp-chunksize' should be set. Maybe you could just
1625 experiment a bit, e.g. changing the values of `init' and `step'
1626 in the third line of the code.
1627
1628 Please raise a bug report via \"M-x tramp-bug\" if your system needs
1629 this variable to be set as well."
1630 :group 'tramp
1631 :type '(choice (const nil) integer))
1632
1633 ;; Logging in to a remote host normally requires obtaining a pty. But
1634 ;; Emacs on MacOS X has process-connection-type set to nil by default,
1635 ;; so on those systems Tramp doesn't obtain a pty. Here, we allow
1636 ;; for an override of the system default.
1637 (defcustom tramp-process-connection-type t
1638 "Overrides `process-connection-type' for connections from Tramp.
1639 Tramp binds process-connection-type to the value given here before
1640 opening a connection to a remote host."
1641 :group 'tramp
1642 :type '(choice (const nil) (const t) (const pty)))
1643
1644 (defcustom tramp-completion-reread-directory-timeout 10
1645 "Defines seconds since last remote command before rereading a directory.
1646 A remote directory might have changed its contents. In order to
1647 make it visible during file name completion in the minibuffer,
1648 Tramp flushes its cache and rereads the directory contents when
1649 more than `tramp-completion-reread-directory-timeout' seconds
1650 have been gone since last remote command execution. A value of 0
1651 would require an immediate reread during filename completion, nil
1652 means to use always cached values for the directory contents."
1653 :group 'tramp
1654 :type '(choice (const nil) integer))
1655
1656 ;;; Internal Variables:
1657
1658 (defvar tramp-current-method nil
1659 "Connection method for this *tramp* buffer.")
1660
1661 (defvar tramp-current-user nil
1662 "Remote login name for this *tramp* buffer.")
1663
1664 (defvar tramp-current-host nil
1665 "Remote host for this *tramp* buffer.")
1666
1667 (defconst tramp-uudecode
1668 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1669 cat /tmp/tramp.$$
1670 rm -f /tmp/tramp.$$"
1671 "Shell function to implement `uudecode' to standard output.
1672 Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
1673 for this or `uudecode -p', but some systems don't, and for them
1674 we have this shell function.")
1675
1676 (defconst tramp-perl-file-truename
1677 "%s -e '
1678 use File::Spec;
1679 use Cwd \"realpath\";
1680
1681 sub recursive {
1682 my ($volume, @dirs) = @_;
1683 my $real = realpath(File::Spec->catpath(
1684 $volume, File::Spec->catdir(@dirs), \"\"));
1685 if ($real) {
1686 my ($vol, $dir) = File::Spec->splitpath($real, 1);
1687 return ($vol, File::Spec->splitdir($dir));
1688 }
1689 else {
1690 my $last = pop(@dirs);
1691 ($volume, @dirs) = recursive($volume, @dirs);
1692 push(@dirs, $last);
1693 return ($volume, @dirs);
1694 }
1695 }
1696
1697 $result = realpath($ARGV[0]);
1698 if (!$result) {
1699 my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
1700 ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
1701
1702 $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
1703 }
1704
1705 if ($ARGV[0] =~ /\\/$/) {
1706 $result = $result . \"/\";
1707 }
1708
1709 print \"\\\"$result\\\"\\n\";
1710 ' \"$1\" 2>/dev/null"
1711 "Perl script to produce output suitable for use with `file-truename'
1712 on the remote file system.
1713 Escape sequence %s is replaced with name of Perl binary.
1714 This string is passed to `format', so percent characters need to be doubled.")
1715
1716 (defconst tramp-perl-file-name-all-completions
1717 "%s -e 'sub case {
1718 my $str = shift;
1719 if ($ARGV[2]) {
1720 return lc($str);
1721 }
1722 else {
1723 return $str;
1724 }
1725 }
1726 opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
1727 @files = readdir(d); closedir(d);
1728 foreach $f (@files) {
1729 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
1730 if (-d \"$ARGV[0]/$f\") {
1731 print \"$f/\\n\";
1732 }
1733 else {
1734 print \"$f\\n\";
1735 }
1736 }
1737 }
1738 print \"ok\\n\"
1739 ' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1740 "Perl script to produce output suitable for use with
1741 `file-name-all-completions' on the remote file system. Escape
1742 sequence %s is replaced with name of Perl binary. This string is
1743 passed to `format', so percent characters need to be doubled.")
1744
1745 ;; Perl script to implement `file-attributes' in a Lisp `read'able
1746 ;; output. If you are hacking on this, note that you get *no* output
1747 ;; unless this spits out a complete line, including the '\n' at the
1748 ;; end.
1749 ;; The device number is returned as "-1", because there will be a virtual
1750 ;; device number set in `tramp-handle-file-attributes'.
1751 (defconst tramp-perl-file-attributes
1752 "%s -e '
1753 @stat = lstat($ARGV[0]);
1754 if (!@stat) {
1755 print \"nil\\n\";
1756 exit 0;
1757 }
1758 if (($stat[2] & 0170000) == 0120000)
1759 {
1760 $type = readlink($ARGV[0]);
1761 $type = \"\\\"$type\\\"\";
1762 }
1763 elsif (($stat[2] & 0170000) == 040000)
1764 {
1765 $type = \"t\";
1766 }
1767 else
1768 {
1769 $type = \"nil\"
1770 };
1771 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1772 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1773 printf(
1774 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\",
1775 $type,
1776 $stat[3],
1777 $uid,
1778 $gid,
1779 $stat[8] >> 16 & 0xffff,
1780 $stat[8] & 0xffff,
1781 $stat[9] >> 16 & 0xffff,
1782 $stat[9] & 0xffff,
1783 $stat[10] >> 16 & 0xffff,
1784 $stat[10] & 0xffff,
1785 $stat[7],
1786 $stat[2],
1787 $stat[1] >> 16 & 0xffff,
1788 $stat[1] & 0xffff
1789 );' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1790 "Perl script to produce output suitable for use with `file-attributes'
1791 on the remote file system.
1792 Escape sequence %s is replaced with name of Perl binary.
1793 This string is passed to `format', so percent characters need to be doubled.")
1794
1795 (defconst tramp-perl-directory-files-and-attributes
1796 "%s -e '
1797 chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
1798 opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
1799 @list = readdir(DIR);
1800 closedir(DIR);
1801 $n = scalar(@list);
1802 printf(\"(\\n\");
1803 for($i = 0; $i < $n; $i++)
1804 {
1805 $filename = $list[$i];
1806 @stat = lstat($filename);
1807 if (($stat[2] & 0170000) == 0120000)
1808 {
1809 $type = readlink($filename);
1810 $type = \"\\\"$type\\\"\";
1811 }
1812 elsif (($stat[2] & 0170000) == 040000)
1813 {
1814 $type = \"t\";
1815 }
1816 else
1817 {
1818 $type = \"nil\"
1819 };
1820 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1821 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1822 printf(
1823 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
1824 $filename,
1825 $type,
1826 $stat[3],
1827 $uid,
1828 $gid,
1829 $stat[8] >> 16 & 0xffff,
1830 $stat[8] & 0xffff,
1831 $stat[9] >> 16 & 0xffff,
1832 $stat[9] & 0xffff,
1833 $stat[10] >> 16 & 0xffff,
1834 $stat[10] & 0xffff,
1835 $stat[7],
1836 $stat[2],
1837 $stat[1] >> 16 & 0xffff,
1838 $stat[1] & 0xffff,
1839 $stat[0] >> 16 & 0xffff,
1840 $stat[0] & 0xffff);
1841 }
1842 printf(\")\\n\");' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1843 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1844 output.
1845 Escape sequence %s is replaced with name of Perl binary.
1846 This string is passed to `format', so percent characters need to be doubled.")
1847
1848 ;; ;; These two use uu encoding.
1849 ;; (defvar tramp-perl-encode "%s -e'\
1850 ;; print qq(begin 644 xxx\n);
1851 ;; my $s = q();
1852 ;; my $res = q();
1853 ;; while (read(STDIN, $s, 45)) {
1854 ;; print pack(q(u), $s);
1855 ;; }
1856 ;; print qq(`\n);
1857 ;; print qq(end\n);
1858 ;; '"
1859 ;; "Perl program to use for encoding a file.
1860 ;; Escape sequence %s is replaced with name of Perl binary.")
1861
1862 ;; (defvar tramp-perl-decode "%s -ne '
1863 ;; print unpack q(u), $_;
1864 ;; '"
1865 ;; "Perl program to use for decoding a file.
1866 ;; Escape sequence %s is replaced with name of Perl binary.")
1867
1868 ;; These two use base64 encoding.
1869 (defconst tramp-perl-encode-with-module
1870 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
1871 "Perl program to use for encoding a file.
1872 Escape sequence %s is replaced with name of Perl binary.
1873 This string is passed to `format', so percent characters need to be doubled.
1874 This implementation requires the MIME::Base64 Perl module to be installed
1875 on the remote host.")
1876
1877 (defconst tramp-perl-decode-with-module
1878 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
1879 "Perl program to use for decoding a file.
1880 Escape sequence %s is replaced with name of Perl binary.
1881 This string is passed to `format', so percent characters need to be doubled.
1882 This implementation requires the MIME::Base64 Perl module to be installed
1883 on the remote host.")
1884
1885 (defconst tramp-perl-encode
1886 "%s -e '
1887 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1888 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
1889 # Free Software Foundation, Inc.
1890 use strict;
1891
1892 my %%trans = do {
1893 my $i = 0;
1894 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
1895 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
1896 };
1897
1898 binmode(\\*STDIN);
1899
1900 # We read in chunks of 54 bytes, to generate output lines
1901 # of 72 chars (plus end of line)
1902 $/ = \\54;
1903
1904 while (my $data = <STDIN>) {
1905 my $pad = q();
1906
1907 # Only for the last chunk, and only if did not fill the last three-byte packet
1908 if (eof) {
1909 my $mod = length($data) %% 3;
1910 $pad = q(=) x (3 - $mod) if $mod;
1911 }
1912
1913 # Not the fastest method, but it is simple: unpack to binary string, split
1914 # by groups of 6 bits and convert back from binary to byte; then map into
1915 # the translation table
1916 print
1917 join q(),
1918 map($trans{$_},
1919 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1920 $pad,
1921 qq(\\n);
1922 }' 2>/dev/null"
1923 "Perl program to use for encoding a file.
1924 Escape sequence %s is replaced with name of Perl binary.
1925 This string is passed to `format', so percent characters need to be doubled.")
1926
1927 (defconst tramp-perl-decode
1928 "%s -e '
1929 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1930 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
1931 # Free Software Foundation, Inc.
1932 use strict;
1933
1934 my %%trans = do {
1935 my $i = 0;
1936 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
1937 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
1938 };
1939
1940 my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
1941
1942 binmode(\\*STDOUT);
1943
1944 # We are going to accumulate into $pending to accept any line length
1945 # (we do not check they are <= 76 chars as the RFC says)
1946 my $pending = q();
1947
1948 while (my $data = <STDIN>) {
1949 chomp $data;
1950
1951 # If we find one or two =, we have reached the end and
1952 # any following data is to be discarded
1953 my $finished = $data =~ s/(==?).*/$1/;
1954 $pending .= $data;
1955
1956 my $len = length($pending);
1957 my $chunk = substr($pending, 0, $len & ~3);
1958 $pending = substr($pending, $len & ~3 + 1);
1959
1960 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
1961 # split in 8-bit chunks and convert back to char.
1962 print join q(),
1963 map $bytes{$_},
1964 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1965
1966 last if $finished;
1967 }' 2>/dev/null"
1968 "Perl program to use for decoding a file.
1969 Escape sequence %s is replaced with name of Perl binary.
1970 This string is passed to `format', so percent characters need to be doubled.")
1971
1972 (defconst tramp-vc-registered-read-file-names
1973 "echo \"(\"
1974 for file in \"$@\"; do
1975 if %s $file; then
1976 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
1977 else
1978 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
1979 fi
1980 if %s $file; then
1981 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
1982 else
1983 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
1984 fi
1985 done
1986 echo \")\""
1987 "Script to check existence of VC related files.
1988 It must be send formatted with two strings; the tests for file
1989 existence, and file readability.")
1990
1991 (defconst tramp-file-mode-type-map
1992 '((0 . "-") ; Normal file (SVID-v2 and XPG2)
1993 (1 . "p") ; fifo
1994 (2 . "c") ; character device
1995 (3 . "m") ; multiplexed character device (v7)
1996 (4 . "d") ; directory
1997 (5 . "?") ; Named special file (XENIX)
1998 (6 . "b") ; block device
1999 (7 . "?") ; multiplexed block device (v7)
2000 (8 . "-") ; regular file
2001 (9 . "n") ; network special file (HP-UX)
2002 (10 . "l") ; symlink
2003 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
2004 (12 . "s") ; socket
2005 (13 . "D") ; door special (Solaris)
2006 (14 . "w")) ; whiteout (BSD)
2007 "A list of file types returned from the `stat' system call.
2008 This is used to map a mode number to a permission string.")
2009
2010 ;; New handlers should be added here. The following operations can be
2011 ;; handled using the normal primitives: file-name-sans-versions,
2012 ;; get-file-buffer.
2013 (defconst tramp-file-name-handler-alist
2014 '((load . tramp-handle-load)
2015 (make-symbolic-link . tramp-handle-make-symbolic-link)
2016 (file-name-as-directory . tramp-handle-file-name-as-directory)
2017 (file-name-directory . tramp-handle-file-name-directory)
2018 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
2019 (file-truename . tramp-handle-file-truename)
2020 (file-exists-p . tramp-handle-file-exists-p)
2021 (file-directory-p . tramp-handle-file-directory-p)
2022 (file-executable-p . tramp-handle-file-executable-p)
2023 (file-readable-p . tramp-handle-file-readable-p)
2024 (file-regular-p . tramp-handle-file-regular-p)
2025 (file-symlink-p . tramp-handle-file-symlink-p)
2026 (file-writable-p . tramp-handle-file-writable-p)
2027 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
2028 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
2029 (file-attributes . tramp-handle-file-attributes)
2030 (file-modes . tramp-handle-file-modes)
2031 (directory-files . tramp-handle-directory-files)
2032 (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
2033 (file-name-all-completions . tramp-handle-file-name-all-completions)
2034 (file-name-completion . tramp-handle-file-name-completion)
2035 (add-name-to-file . tramp-handle-add-name-to-file)
2036 (copy-file . tramp-handle-copy-file)
2037 (copy-directory . tramp-handle-copy-directory)
2038 (rename-file . tramp-handle-rename-file)
2039 (set-file-modes . tramp-handle-set-file-modes)
2040 (set-file-times . tramp-handle-set-file-times)
2041 (make-directory . tramp-handle-make-directory)
2042 (delete-directory . tramp-handle-delete-directory)
2043 (delete-file . tramp-handle-delete-file)
2044 (directory-file-name . tramp-handle-directory-file-name)
2045 ;; `executable-find' is not official yet.
2046 (executable-find . tramp-handle-executable-find)
2047 (start-file-process . tramp-handle-start-file-process)
2048 (process-file . tramp-handle-process-file)
2049 (shell-command . tramp-handle-shell-command)
2050 (insert-directory . tramp-handle-insert-directory)
2051 (expand-file-name . tramp-handle-expand-file-name)
2052 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
2053 (file-local-copy . tramp-handle-file-local-copy)
2054 (file-remote-p . tramp-handle-file-remote-p)
2055 (insert-file-contents . tramp-handle-insert-file-contents)
2056 (insert-file-contents-literally
2057 . tramp-handle-insert-file-contents-literally)
2058 (write-region . tramp-handle-write-region)
2059 (find-backup-file-name . tramp-handle-find-backup-file-name)
2060 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
2061 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
2062 (dired-compress-file . tramp-handle-dired-compress-file)
2063 (dired-recursive-delete-directory
2064 . tramp-handle-dired-recursive-delete-directory)
2065 (dired-uncache . tramp-handle-dired-uncache)
2066 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
2067 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
2068 (file-selinux-context . tramp-handle-file-selinux-context)
2069 (set-file-selinux-context . tramp-handle-set-file-selinux-context)
2070 (vc-registered . tramp-handle-vc-registered))
2071 "Alist of handler functions.
2072 Operations not mentioned here will be handled by the normal Emacs functions.")
2073
2074 ;; Handlers for partial Tramp file names. For Emacs just
2075 ;; `file-name-all-completions' is needed.
2076 ;;;###autoload
2077 (defconst tramp-completion-file-name-handler-alist
2078 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
2079 (file-name-completion . tramp-completion-handle-file-name-completion))
2080 "Alist of completion handler functions.
2081 Used for file names matching `tramp-file-name-regexp'. Operations not
2082 mentioned here will be handled by `tramp-file-name-handler-alist' or the
2083 normal Emacs functions.")
2084
2085 ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
2086 (defvar tramp-foreign-file-name-handler-alist
2087 ;; (identity . tramp-sh-file-name-handler) should always be the last
2088 ;; entry, because `identity' always matches.
2089 '((identity . tramp-sh-file-name-handler))
2090 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
2091 If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
2092 calling HANDLER.")
2093
2094 ;;; Internal functions which must come first:
2095
2096 (defsubst tramp-debug-message (vec fmt-string &rest args)
2097 "Append message to debug buffer.
2098 Message is formatted with FMT-STRING as control string and the remaining
2099 ARGS to actually emit the message (if applicable)."
2100 (when (get-buffer (tramp-buffer-name vec))
2101 (with-current-buffer (tramp-get-debug-buffer vec)
2102 (goto-char (point-max))
2103 ;; Headline.
2104 (when (bobp)
2105 (insert
2106 (format
2107 ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
2108 (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
2109 emacs-version tramp-version)))
2110 (unless (bolp)
2111 (insert "\n"))
2112 ;; Timestamp.
2113 (let ((now (current-time)))
2114 (insert (format-time-string "%T." now))
2115 (insert (format "%06d " (nth 2 now))))
2116 ;; Calling function.
2117 (let ((btn 1) btf fn)
2118 (while (not fn)
2119 (setq btf (nth 1 (backtrace-frame btn)))
2120 (if (not btf)
2121 (setq fn "")
2122 (when (symbolp btf)
2123 (setq fn (symbol-name btf))
2124 (unless (and (string-match "^tramp" fn)
2125 (not (string-match
2126 "^tramp\\(-debug\\)?\\(-message\\|-error\\|-compat-funcall\\)$"
2127 fn)))
2128 (setq fn nil)))
2129 (setq btn (1+ btn))))
2130 ;; The following code inserts filename and line number.
2131 ;; Should be deactivated by default, because it is time
2132 ;; consuming.
2133 ; (let ((ffn (find-function-noselect (intern fn))))
2134 ; (insert
2135 ; (format
2136 ; "%s:%d: "
2137 ; (file-name-nondirectory (buffer-file-name (car ffn)))
2138 ; (with-current-buffer (car ffn)
2139 ; (1+ (count-lines (point-min) (cdr ffn)))))))
2140 (insert (format "%s " fn)))
2141 ;; The message.
2142 (insert (apply 'format fmt-string args)))))
2143
2144 (defvar tramp-message-show-message t
2145 "Show Tramp message in the minibuffer.
2146 This variable is used to disable messages from `tramp-error'.
2147 The messages are visible anyway, because an error is raised.")
2148
2149 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
2150 "Emit a message depending on verbosity level.
2151 VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
2152 vector or a process. LEVEL says to be quiet if `tramp-verbose' is
2153 less than LEVEL. The message is emitted only if `tramp-verbose' is
2154 greater than or equal to LEVEL.
2155
2156 The message is also logged into the debug buffer when `tramp-verbose'
2157 is greater than or equal 4.
2158
2159 Calls functions `message' and `tramp-debug-message' with FMT-STRING as
2160 control string and the remaining ARGS to actually emit the message (if
2161 applicable)."
2162 (condition-case nil
2163 (when (<= level tramp-verbose)
2164 ;; Match data must be preserved!
2165 (save-match-data
2166 ;; Display only when there is a minimum level.
2167 (when (and tramp-message-show-message (<= level 3))
2168 (apply 'message
2169 (concat
2170 (cond
2171 ((= level 0) "")
2172 ((= level 1) "")
2173 ((= level 2) "Warning: ")
2174 (t "Tramp: "))
2175 fmt-string)
2176 args))
2177 ;; Log only when there is a minimum level.
2178 (when (>= tramp-verbose 4)
2179 (when (and vec-or-proc
2180 (processp vec-or-proc)
2181 (buffer-name (process-buffer vec-or-proc)))
2182 (with-current-buffer (process-buffer vec-or-proc)
2183 ;; Translate proc to vec.
2184 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
2185 (when (and vec-or-proc (vectorp vec-or-proc))
2186 (apply 'tramp-debug-message
2187 vec-or-proc
2188 (concat (format "(%d) # " level) fmt-string)
2189 args)))))
2190 ;; Suppress all errors.
2191 (error nil)))
2192
2193 (defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
2194 "Emit an error.
2195 VEC-OR-PROC identifies the connection to use, SIGNAL is the
2196 signal identifier to be raised, remaining args passed to
2197 `tramp-message'. Finally, signal SIGNAL is raised."
2198 (let (tramp-message-show-message)
2199 (tramp-message
2200 vec-or-proc 1 "%s"
2201 (error-message-string
2202 (list signal
2203 (get signal 'error-message)
2204 (apply 'format fmt-string args))))
2205 (signal signal (list (apply 'format fmt-string args)))))
2206
2207 (defsubst tramp-error-with-buffer
2208 (buffer vec-or-proc signal fmt-string &rest args)
2209 "Emit an error, and show BUFFER.
2210 If BUFFER is nil, show the connection buffer. Wait for 30\", or until
2211 an input event arrives. The other arguments are passed to `tramp-error'."
2212 (save-window-excursion
2213 (unwind-protect
2214 (apply 'tramp-error vec-or-proc signal fmt-string args)
2215 (when (and vec-or-proc
2216 (not (zerop tramp-verbose))
2217 (not (tramp-completion-mode-p)))
2218 (let ((enable-recursive-minibuffers t))
2219 (pop-to-buffer
2220 (or (and (bufferp buffer) buffer)
2221 (and (processp vec-or-proc) (process-buffer vec-or-proc))
2222 (tramp-get-buffer vec-or-proc)))
2223 (sit-for 30))))))
2224
2225 (defmacro with-parsed-tramp-file-name (filename var &rest body)
2226 "Parse a Tramp filename and make components available in the body.
2227
2228 First arg FILENAME is evaluated and dissected into its components.
2229 Second arg VAR is a symbol. It is used as a variable name to hold
2230 the filename structure. It is also used as a prefix for the variables
2231 holding the components. For example, if VAR is the symbol `foo', then
2232 `foo' will be bound to the whole structure, `foo-method' will be bound to
2233 the method component, and so on for `foo-user', `foo-host', `foo-localname'.
2234
2235 Remaining args are Lisp expressions to be evaluated (inside an implicit
2236 `progn').
2237
2238 If VAR is nil, then we bind `v' to the structure and `method', `user',
2239 `host', `localname' to the components."
2240 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
2241 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
2242 (tramp-file-name-method ,(or var 'v)))
2243 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
2244 (tramp-file-name-user ,(or var 'v)))
2245 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
2246 (tramp-file-name-host ,(or var 'v)))
2247 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
2248 (tramp-file-name-localname ,(or var 'v))))
2249 ,@body))
2250
2251 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
2252 (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
2253 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
2254
2255 (defmacro with-file-property (vec file property &rest body)
2256 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
2257 FILE must be a local file name on a connection identified via VEC."
2258 `(if (file-name-absolute-p ,file)
2259 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
2260 (when (eq value 'undef)
2261 ;; We cannot pass @body as parameter to
2262 ;; `tramp-set-file-property' because it mangles our
2263 ;; debug messages.
2264 (setq value (progn ,@body))
2265 (tramp-set-file-property ,vec ,file ,property value))
2266 value)
2267 ,@body))
2268
2269 (put 'with-file-property 'lisp-indent-function 3)
2270 (put 'with-file-property 'edebug-form-spec t)
2271 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
2272
2273 (defmacro with-connection-property (key property &rest body)
2274 "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
2275 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
2276 (when (eq value 'undef)
2277 ;; We cannot pass ,@body as parameter to
2278 ;; `tramp-set-connection-property' because it mangles our debug
2279 ;; messages.
2280 (setq value (progn ,@body))
2281 (tramp-set-connection-property ,key ,property value))
2282 value))
2283
2284 (put 'with-connection-property 'lisp-indent-function 2)
2285 (put 'with-connection-property 'edebug-form-spec t)
2286 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
2287
2288 (defun tramp-progress-reporter-update (reporter &optional value)
2289 (let* ((parameters (cdr reporter))
2290 (message (aref parameters 3)))
2291 (when (string-match message (or (current-message) ""))
2292 (funcall 'progress-reporter-update reporter value))))
2293
2294 (defmacro with-progress-reporter (vec level message &rest body)
2295 "Executes BODY, spinning a progress reporter with MESSAGE.
2296 If LEVEL does not fit for visible messages, or if this is a
2297 nested call of the macro, there are only traces without a visible
2298 progress reporter."
2299 `(let (pr tm)
2300 (tramp-message ,vec ,level "%s..." ,message)
2301 ;; We start a pulsing progress reporter after 3 seconds. Feature
2302 ;; introduced in Emacs 24.1.
2303 (when (and tramp-message-show-message
2304 ;; Display only when there is a minimum level.
2305 (<= ,level (min tramp-verbose 3)))
2306 (condition-case nil
2307 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
2308 tm (when pr
2309 (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))
2310 (error nil)))
2311 (unwind-protect
2312 ;; Execute the body. Unset `tramp-message-show-message' when
2313 ;; the timer object is created, in order to suppress
2314 ;; concurrent timers.
2315 (let ((tramp-message-show-message
2316 (and tramp-message-show-message (not tm))))
2317 ,@body)
2318 ;; Stop progress reporter.
2319 (if tm (tramp-compat-funcall 'cancel-timer tm))
2320 (tramp-message ,vec ,level "%s...done" ,message))))
2321
2322 (put 'with-progress-reporter 'lisp-indent-function 3)
2323 (put 'with-progress-reporter 'edebug-form-spec t)
2324 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
2325
2326 (eval-and-compile ;; Silence compiler.
2327 (if (memq system-type '(cygwin windows-nt))
2328 (defun tramp-drop-volume-letter (name)
2329 "Cut off unnecessary drive letter from file NAME.
2330 The function `tramp-handle-expand-file-name' calls `expand-file-name'
2331 locally on a remote file name. When the local system is a W32 system
2332 but the remote system is Unix, this introduces a superfluous drive
2333 letter into the file name. This function removes it."
2334 (save-match-data
2335 (if (string-match tramp-root-regexp name)
2336 (replace-match "/" nil t name)
2337 name)))
2338
2339 (defalias 'tramp-drop-volume-letter 'identity)))
2340
2341 (defsubst tramp-make-tramp-temp-file (vec)
2342 "Create a temporary file on the remote host identified by VEC.
2343 Return the local name of the temporary file."
2344 (let ((prefix
2345 (tramp-make-tramp-file-name
2346 (tramp-file-name-method vec)
2347 (tramp-file-name-user vec)
2348 (tramp-file-name-host vec)
2349 (tramp-drop-volume-letter
2350 (expand-file-name
2351 tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
2352 result)
2353 (while (not result)
2354 ;; `make-temp-file' would be the natural choice for
2355 ;; implementation. But it calls `write-region' internally,
2356 ;; which also needs a temporary file - we would end in an
2357 ;; infinite loop.
2358 (setq result (make-temp-name prefix))
2359 (if (file-exists-p result)
2360 (setq result nil)
2361 ;; This creates the file by side effect.
2362 (set-file-times result)
2363 (set-file-modes result (tramp-octal-to-decimal "0700"))))
2364
2365 ;; Return the local part.
2366 (with-parsed-tramp-file-name result nil localname)))
2367
2368
2369 ;;; Config Manipulation Functions:
2370
2371 (defun tramp-set-completion-function (method function-list)
2372 "Sets the list of completion functions for METHOD.
2373 FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
2374 The FUNCTION is intended to parse FILE according its syntax.
2375 It might be a predefined FUNCTION, or a user defined FUNCTION.
2376 Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
2377 `tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
2378 and `tramp-parse-netrc'.
2379
2380 Example:
2381
2382 (tramp-set-completion-function
2383 \"ssh\"
2384 '((tramp-parse-sconfig \"/etc/ssh_config\")
2385 (tramp-parse-sconfig \"~/.ssh/config\")))"
2386
2387 (let ((r function-list)
2388 (v function-list))
2389 (setq tramp-completion-function-alist
2390 (delete (assoc method tramp-completion-function-alist)
2391 tramp-completion-function-alist))
2392
2393 (while v
2394 ;; Remove double entries.
2395 (when (member (car v) (cdr v))
2396 (setcdr v (delete (car v) (cdr v))))
2397 ;; Check for function and file or registry key.
2398 (unless (and (functionp (nth 0 (car v)))
2399 (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
2400 ;; Windows registry.
2401 (and (memq system-type '(cygwin windows-nt))
2402 (zerop
2403 (tramp-local-call-process
2404 "reg" nil nil nil "query" (nth 1 (car v)))))
2405 ;; Configuration file.
2406 (file-exists-p (nth 1 (car v)))))
2407 (setq r (delete (car v) r)))
2408 (setq v (cdr v)))
2409
2410 (when r
2411 (add-to-list 'tramp-completion-function-alist
2412 (cons method r)))))
2413
2414 (defun tramp-get-completion-function (method)
2415 "Returns a list of completion functions for METHOD.
2416 For definition of that list see `tramp-set-completion-function'."
2417 (cons
2418 ;; Hosts visited once shall be remembered.
2419 `(tramp-parse-connection-properties ,method)
2420 ;; The method related defaults.
2421 (cdr (assoc method tramp-completion-function-alist))))
2422
2423
2424 ;;; Fontification of `read-file-name':
2425
2426 ;; rfn-eshadow.el is part of Emacs 22. It is autoloaded.
2427 (defvar tramp-rfn-eshadow-overlay)
2428 (make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
2429
2430 (defun tramp-rfn-eshadow-setup-minibuffer ()
2431 "Set up a minibuffer for `file-name-shadow-mode'.
2432 Adds another overlay hiding filename parts according to Tramp's
2433 special handling of `substitute-in-file-name'."
2434 (when (symbol-value 'minibuffer-completing-file-name)
2435 (setq tramp-rfn-eshadow-overlay
2436 (tramp-compat-funcall
2437 'make-overlay
2438 (tramp-compat-funcall 'minibuffer-prompt-end)
2439 (tramp-compat-funcall 'minibuffer-prompt-end)))
2440 ;; Copy rfn-eshadow-overlay properties.
2441 (let ((props (tramp-compat-funcall
2442 'overlay-properties (symbol-value 'rfn-eshadow-overlay))))
2443 (while props
2444 (tramp-compat-funcall
2445 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))))))
2446
2447 (when (boundp 'rfn-eshadow-setup-minibuffer-hook)
2448 (add-hook 'rfn-eshadow-setup-minibuffer-hook
2449 'tramp-rfn-eshadow-setup-minibuffer)
2450 (add-hook 'tramp-unload-hook
2451 (lambda ()
2452 (remove-hook 'rfn-eshadow-setup-minibuffer-hook
2453 'tramp-rfn-eshadow-setup-minibuffer))))
2454
2455 (defconst tramp-rfn-eshadow-update-overlay-regexp
2456 (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
2457
2458 (defun tramp-rfn-eshadow-update-overlay ()
2459 "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
2460 This is intended to be used as a minibuffer `post-command-hook' for
2461 `file-name-shadow-mode'; the minibuffer should have already
2462 been set up by `rfn-eshadow-setup-minibuffer'."
2463 ;; In remote files name, there is a shadowing just for the local part.
2464 (let ((end (or (tramp-compat-funcall
2465 'overlay-end (symbol-value 'rfn-eshadow-overlay))
2466 (tramp-compat-funcall 'minibuffer-prompt-end))))
2467 (when
2468 (file-remote-p
2469 (tramp-compat-funcall 'buffer-substring-no-properties end (point-max)))
2470 (save-excursion
2471 (save-restriction
2472 (narrow-to-region
2473 (1+ (or (string-match
2474 tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end)
2475 end))
2476 (point-max))
2477 (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
2478 (rfn-eshadow-update-overlay-hook nil))
2479 (tramp-compat-funcall
2480 'move-overlay rfn-eshadow-overlay (point-max) (point-max))
2481 (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))
2482
2483 (when (boundp 'rfn-eshadow-update-overlay-hook)
2484 (add-hook 'rfn-eshadow-update-overlay-hook
2485 'tramp-rfn-eshadow-update-overlay)
2486 (add-hook 'tramp-unload-hook
2487 (lambda ()
2488 (remove-hook 'rfn-eshadow-update-overlay-hook
2489 'tramp-rfn-eshadow-update-overlay))))
2490
2491
2492 ;;; Integration of eshell.el:
2493
2494 (eval-when-compile
2495 (defvar eshell-path-env))
2496
2497 ;; eshell.el keeps the path in `eshell-path-env'. We must change it
2498 ;; when `default-directory' points to another host.
2499 (defun tramp-eshell-directory-change ()
2500 "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
2501 (setq eshell-path-env
2502 (if (file-remote-p default-directory)
2503 (with-parsed-tramp-file-name default-directory nil
2504 (mapconcat
2505 'identity
2506 (tramp-get-remote-path v)
2507 ":"))
2508 (getenv "PATH"))))
2509
2510 (eval-after-load "esh-util"
2511 '(progn
2512 (tramp-eshell-directory-change)
2513 (add-hook 'eshell-directory-change-hook
2514 'tramp-eshell-directory-change)
2515 (add-hook 'tramp-unload-hook
2516 (lambda ()
2517 (remove-hook 'eshell-directory-change-hook
2518 'tramp-eshell-directory-change)))))
2519
2520
2521 ;;; File Name Handler Functions:
2522
2523 (defun tramp-handle-make-symbolic-link
2524 (filename linkname &optional ok-if-already-exists)
2525 "Like `make-symbolic-link' for Tramp files.
2526 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
2527 the symlink. If LINKNAME is a Tramp file, only the localname component is
2528 used as the target of the symlink.
2529
2530 If LINKNAME is a Tramp file and the localname component is relative, then
2531 it is expanded first, before the localname component is taken. Note that
2532 this can give surprising results if the user/host for the source and
2533 target of the symlink differ."
2534 (with-parsed-tramp-file-name linkname l
2535 (let ((ln (tramp-get-remote-ln l))
2536 (cwd (tramp-run-real-handler
2537 'file-name-directory (list l-localname))))
2538 (unless ln
2539 (tramp-error
2540 l 'file-error
2541 "Making a symbolic link. ln(1) does not exist on the remote host."))
2542
2543 ;; Do the 'confirm if exists' thing.
2544 (when (file-exists-p linkname)
2545 ;; What to do?
2546 (if (or (null ok-if-already-exists) ; not allowed to exist
2547 (and (numberp ok-if-already-exists)
2548 (not (yes-or-no-p
2549 (format
2550 "File %s already exists; make it a link anyway? "
2551 l-localname)))))
2552 (tramp-error
2553 l 'file-already-exists "File %s already exists" l-localname)
2554 (delete-file linkname)))
2555
2556 ;; If FILENAME is a Tramp name, use just the localname component.
2557 (when (tramp-tramp-file-p filename)
2558 (setq filename
2559 (tramp-file-name-localname
2560 (tramp-dissect-file-name (expand-file-name filename)))))
2561
2562 ;; Right, they are on the same host, regardless of user, method, etc.
2563 ;; We now make the link on the remote machine. This will occur as the user
2564 ;; that FILENAME belongs to.
2565 (zerop
2566 (tramp-send-command-and-check
2567 l
2568 (format
2569 "cd %s && %s -sf %s %s"
2570 (tramp-shell-quote-argument cwd)
2571 ln
2572 (tramp-shell-quote-argument filename)
2573 (tramp-shell-quote-argument l-localname))
2574 t)))))
2575
2576 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2577 "Like `load' for Tramp files."
2578 (with-parsed-tramp-file-name (expand-file-name file) nil
2579 (unless nosuffix
2580 (cond ((file-exists-p (concat file ".elc"))
2581 (setq file (concat file ".elc")))
2582 ((file-exists-p (concat file ".el"))
2583 (setq file (concat file ".el")))))
2584 (when must-suffix
2585 ;; The first condition is always true for absolute file names.
2586 ;; Included for safety's sake.
2587 (unless (or (file-name-directory file)
2588 (string-match "\\.elc?\\'" file))
2589 (tramp-error
2590 v 'file-error
2591 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2592 (unless noerror
2593 (when (not (file-exists-p file))
2594 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2595 (if (not (file-exists-p file))
2596 nil
2597 (let ((tramp-message-show-message (not nomessage)))
2598 (with-progress-reporter v 0 (format "Loading %s" file)
2599 (let ((local-copy (file-local-copy file)))
2600 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2601 (unwind-protect
2602 (load local-copy noerror t t)
2603 (delete-file local-copy)))))
2604 t)))
2605
2606 ;; Localname manipulation functions that grok Tramp localnames...
2607 (defun tramp-handle-file-name-as-directory (file)
2608 "Like `file-name-as-directory' but aware of Tramp files."
2609 ;; `file-name-as-directory' would be sufficient except localname is
2610 ;; the empty string.
2611 (let ((v (tramp-dissect-file-name file t)))
2612 ;; Run the command on the localname portion only.
2613 (tramp-make-tramp-file-name
2614 (tramp-file-name-method v)
2615 (tramp-file-name-user v)
2616 (tramp-file-name-host v)
2617 (tramp-run-real-handler
2618 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
2619
2620 (defun tramp-handle-file-name-directory (file)
2621 "Like `file-name-directory' but aware of Tramp files."
2622 ;; Everything except the last filename thing is the directory. We
2623 ;; cannot apply `with-parsed-tramp-file-name', because this expands
2624 ;; the remote file name parts. This is a problem when we are in
2625 ;; file name completion.
2626 (let ((v (tramp-dissect-file-name file t)))
2627 ;; Run the command on the localname portion only.
2628 (tramp-make-tramp-file-name
2629 (tramp-file-name-method v)
2630 (tramp-file-name-user v)
2631 (tramp-file-name-host v)
2632 (tramp-run-real-handler
2633 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
2634
2635 (defun tramp-handle-file-name-nondirectory (file)
2636 "Like `file-name-nondirectory' but aware of Tramp files."
2637 (with-parsed-tramp-file-name file nil
2638 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
2639
2640 (defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2641 "Like `file-truename' for Tramp files."
2642 (with-parsed-tramp-file-name (expand-file-name filename) nil
2643 (with-file-property v localname "file-truename"
2644 (let ((result nil)) ; result steps in reverse order
2645 (tramp-message v 4 "Finding true name for `%s'" filename)
2646 (cond
2647 ;; Use GNU readlink --canonicalize-missing where available.
2648 ((tramp-get-remote-readlink v)
2649 (setq result
2650 (tramp-send-command-and-read
2651 v
2652 (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
2653 (tramp-get-remote-readlink v)
2654 (tramp-shell-quote-argument localname)))))
2655
2656 ;; Use Perl implementation.
2657 ((and (tramp-get-remote-perl v)
2658 (tramp-get-connection-property v "perl-file-spec" nil)
2659 (tramp-get-connection-property v "perl-cwd-realpath" nil))
2660 (tramp-maybe-send-script
2661 v tramp-perl-file-truename "tramp_perl_file_truename")
2662 (setq result
2663 (tramp-send-command-and-read
2664 v
2665 (format "tramp_perl_file_truename %s"
2666 (tramp-shell-quote-argument localname)))))
2667
2668 ;; Do it yourself. We bind `directory-sep-char' here for
2669 ;; XEmacs on Windows, which would otherwise use backslash.
2670 (t (let* ((directory-sep-char ?/)
2671 (steps (tramp-compat-split-string localname "/"))
2672 (localnamedir (tramp-run-real-handler
2673 'file-name-as-directory (list localname)))
2674 (is-dir (string= localname localnamedir))
2675 (thisstep nil)
2676 (numchase 0)
2677 ;; Don't make the following value larger than
2678 ;; necessary. People expect an error message in a
2679 ;; timely fashion when something is wrong;
2680 ;; otherwise they might think that Emacs is hung.
2681 ;; Of course, correctness has to come first.
2682 (numchase-limit 20)
2683 symlink-target)
2684 (while (and steps (< numchase numchase-limit))
2685 (setq thisstep (pop steps))
2686 (tramp-message
2687 v 5 "Check %s"
2688 (mapconcat 'identity
2689 (append '("") (reverse result) (list thisstep))
2690 "/"))
2691 (setq symlink-target
2692 (nth 0 (file-attributes
2693 (tramp-make-tramp-file-name
2694 method user host
2695 (mapconcat 'identity
2696 (append '("")
2697 (reverse result)
2698 (list thisstep))
2699 "/")))))
2700 (cond ((string= "." thisstep)
2701 (tramp-message v 5 "Ignoring step `.'"))
2702 ((string= ".." thisstep)
2703 (tramp-message v 5 "Processing step `..'")
2704 (pop result))
2705 ((stringp symlink-target)
2706 ;; It's a symlink, follow it.
2707 (tramp-message v 5 "Follow symlink to %s" symlink-target)
2708 (setq numchase (1+ numchase))
2709 (when (file-name-absolute-p symlink-target)
2710 (setq result nil))
2711 ;; If the symlink was absolute, we'll get a string like
2712 ;; "/user@host:/some/target"; extract the
2713 ;; "/some/target" part from it.
2714 (when (tramp-tramp-file-p symlink-target)
2715 (unless (tramp-equal-remote filename symlink-target)
2716 (tramp-error
2717 v 'file-error
2718 "Symlink target `%s' on wrong host" symlink-target))
2719 (setq symlink-target localname))
2720 (setq steps
2721 (append (tramp-compat-split-string
2722 symlink-target "/")
2723 steps)))
2724 (t
2725 ;; It's a file.
2726 (setq result (cons thisstep result)))))
2727 (when (>= numchase numchase-limit)
2728 (tramp-error
2729 v 'file-error
2730 "Maximum number (%d) of symlinks exceeded" numchase-limit))
2731 (setq result (reverse result))
2732 ;; Combine list to form string.
2733 (setq result
2734 (if result
2735 (mapconcat 'identity (cons "" result) "/")
2736 "/"))
2737 (when (and is-dir (or (string= "" result)
2738 (not (string= (substring result -1) "/"))))
2739 (setq result (concat result "/"))))))
2740
2741 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
2742 (tramp-make-tramp-file-name method user host result)))))
2743
2744 ;; Basic functions.
2745
2746 (defun tramp-handle-file-exists-p (filename)
2747 "Like `file-exists-p' for Tramp files."
2748 (with-parsed-tramp-file-name filename nil
2749 (with-file-property v localname "file-exists-p"
2750 (or (not (null (tramp-get-file-property
2751 v localname "file-attributes-integer" nil)))
2752 (not (null (tramp-get-file-property
2753 v localname "file-attributes-string" nil)))
2754 (zerop (tramp-send-command-and-check
2755 v
2756 (format
2757 "%s %s"
2758 (tramp-get-file-exists-command v)
2759 (tramp-shell-quote-argument localname))))))))
2760
2761 ;; Inodes don't exist for some file systems. Therefore we must
2762 ;; generate virtual ones. Used in `find-buffer-visiting'. The method
2763 ;; applied might be not so efficient (Ange-FTP uses hashes). But
2764 ;; performance isn't the major issue given that file transfer will
2765 ;; take time.
2766 (defvar tramp-inodes nil
2767 "Keeps virtual inodes numbers.")
2768
2769 ;; Devices must distinguish physical file systems. The device numbers
2770 ;; provided by "lstat" aren't unique, because we operate on different hosts.
2771 ;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
2772 ;; EFS use device number "-1". In order to be different, we use device number
2773 ;; (-1 . x), whereby "x" is unique for a given (method user host).
2774 (defvar tramp-devices nil
2775 "Keeps virtual device numbers.")
2776
2777 ;; CCC: This should check for an error condition and signal failure
2778 ;; when something goes wrong.
2779 ;; Daniel Pittman <daniel@danann.net>
2780 (defun tramp-handle-file-attributes (filename &optional id-format)
2781 "Like `file-attributes' for Tramp files."
2782 (unless id-format (setq id-format 'integer))
2783 ;; Don't modify `last-coding-system-used' by accident.
2784 (let ((last-coding-system-used last-coding-system-used))
2785 (with-parsed-tramp-file-name (expand-file-name filename) nil
2786 (with-file-property v localname (format "file-attributes-%s" id-format)
2787 (save-excursion
2788 (tramp-convert-file-attributes
2789 v
2790 (cond
2791 ((tramp-get-remote-stat v)
2792 (tramp-do-file-attributes-with-stat v localname id-format))
2793 ((tramp-get-remote-perl v)
2794 (tramp-do-file-attributes-with-perl v localname id-format))
2795 (t
2796 (tramp-do-file-attributes-with-ls v localname id-format)))))))))
2797
2798 (defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
2799 "Implement `file-attributes' for Tramp files using the ls(1) command."
2800 (let (symlinkp dirp
2801 res-inode res-filemodes res-numlinks
2802 res-uid res-gid res-size res-symlink-target)
2803 (tramp-message vec 5 "file attributes with ls: %s" localname)
2804 (tramp-send-command
2805 vec
2806 (format "(%s %s || %s -h %s) && %s %s %s"
2807 (tramp-get-file-exists-command vec)
2808 (tramp-shell-quote-argument localname)
2809 (tramp-get-test-command vec)
2810 (tramp-shell-quote-argument localname)
2811 (tramp-get-ls-command vec)
2812 (if (eq id-format 'integer) "-ildn" "-ild")
2813 (tramp-shell-quote-argument localname)))
2814 ;; parse `ls -l' output ...
2815 (with-current-buffer (tramp-get-buffer vec)
2816 (when (> (buffer-size) 0)
2817 (goto-char (point-min))
2818 ;; ... inode
2819 (setq res-inode
2820 (condition-case err
2821 (read (current-buffer))
2822 (invalid-read-syntax
2823 (when (and (equal (cadr err)
2824 "Integer constant overflow in reader")
2825 (string-match
2826 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
2827 (car (cddr err))))
2828 (let* ((big (read (substring (car (cddr err)) 0
2829 (match-beginning 1))))
2830 (small (read (match-string 1 (car (cddr err)))))
2831 (twiddle (/ small 65536)))
2832 (cons (+ big twiddle)
2833 (- small (* twiddle 65536))))))))
2834 ;; ... file mode flags
2835 (setq res-filemodes (symbol-name (read (current-buffer))))
2836 ;; ... number links
2837 (setq res-numlinks (read (current-buffer)))
2838 ;; ... uid and gid
2839 (setq res-uid (read (current-buffer)))
2840 (setq res-gid (read (current-buffer)))
2841 (if (eq id-format 'integer)
2842 (progn
2843 (unless (numberp res-uid) (setq res-uid -1))
2844 (unless (numberp res-gid) (setq res-gid -1)))
2845 (progn
2846 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
2847 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
2848 ;; ... size
2849 (setq res-size (read (current-buffer)))
2850 ;; From the file modes, figure out other stuff.
2851 (setq symlinkp (eq ?l (aref res-filemodes 0)))
2852 (setq dirp (eq ?d (aref res-filemodes 0)))
2853 ;; if symlink, find out file name pointed to
2854 (when symlinkp
2855 (search-forward "-> ")
2856 (setq res-symlink-target
2857 (buffer-substring (point) (tramp-compat-line-end-position))))
2858 ;; return data gathered
2859 (list
2860 ;; 0. t for directory, string (name linked to) for symbolic
2861 ;; link, or nil.
2862 (or dirp res-symlink-target)
2863 ;; 1. Number of links to file.
2864 res-numlinks
2865 ;; 2. File uid.
2866 res-uid
2867 ;; 3. File gid.
2868 res-gid
2869 ;; 4. Last access time, as a list of two integers. First
2870 ;; integer has high-order 16 bits of time, second has low 16
2871 ;; bits.
2872 ;; 5. Last modification time, likewise.
2873 ;; 6. Last status change time, likewise.
2874 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2875 ;; 7. Size in bytes (-1, if number is out of range).
2876 res-size
2877 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2878 res-filemodes
2879 ;; 9. t if file's gid would change if file were deleted and
2880 ;; recreated. Will be set in `tramp-convert-file-attributes'
2881 t
2882 ;; 10. inode number.
2883 res-inode
2884 ;; 11. Device number. Will be replaced by a virtual device number.
2885 -1
2886 )))))
2887
2888 (defun tramp-do-file-attributes-with-perl
2889 (vec localname &optional id-format)
2890 "Implement `file-attributes' for Tramp files using a Perl script."
2891 (tramp-message vec 5 "file attributes with perl: %s" localname)
2892 (tramp-maybe-send-script
2893 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
2894 (tramp-send-command-and-read
2895 vec
2896 (format "tramp_perl_file_attributes %s %s"
2897 (tramp-shell-quote-argument localname) id-format)))
2898
2899 (defun tramp-do-file-attributes-with-stat
2900 (vec localname &optional id-format)
2901 "Implement `file-attributes' for Tramp files using stat(1) command."
2902 (tramp-message vec 5 "file attributes with stat: %s" localname)
2903 (tramp-send-command-and-read
2904 vec
2905 (format
2906 ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
2907 ;; parse correctly the sequence "((". Therefore, we add a space.
2908 "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)"
2909 (tramp-get-file-exists-command vec)
2910 (tramp-shell-quote-argument localname)
2911 (tramp-get-test-command vec)
2912 (tramp-shell-quote-argument localname)
2913 (tramp-get-remote-stat vec)
2914 (if (eq id-format 'integer) "%u" "\"%U\"")
2915 (if (eq id-format 'integer) "%g" "\"%G\"")
2916 (tramp-shell-quote-argument localname))))
2917
2918 (defun tramp-handle-set-visited-file-modtime (&optional time-list)
2919 "Like `set-visited-file-modtime' for Tramp files."
2920 (unless (buffer-file-name)
2921 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2922 (buffer-name)))
2923 (if time-list
2924 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2925 (let ((f (buffer-file-name))
2926 coding-system-used)
2927 (with-parsed-tramp-file-name f nil
2928 (let* ((attr (file-attributes f))
2929 ;; '(-1 65535) means file doesn't exists yet.
2930 (modtime (or (nth 5 attr) '(-1 65535))))
2931 (when (boundp 'last-coding-system-used)
2932 (setq coding-system-used (symbol-value 'last-coding-system-used)))
2933 ;; We use '(0 0) as a don't-know value. See also
2934 ;; `tramp-do-file-attributes-with-ls'.
2935 (if (not (equal modtime '(0 0)))
2936 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2937 (progn
2938 (tramp-send-command
2939 v
2940 (format "%s -ild %s"
2941 (tramp-get-ls-command v)
2942 (tramp-shell-quote-argument localname)))
2943 (setq attr (buffer-substring (point)
2944 (progn (end-of-line) (point)))))
2945 (tramp-set-file-property
2946 v localname "visited-file-modtime-ild" attr))
2947 (when (boundp 'last-coding-system-used)
2948 (set 'last-coding-system-used coding-system-used))
2949 nil)))))
2950
2951 ;; This function makes the same assumption as
2952 ;; `tramp-handle-set-visited-file-modtime'.
2953 (defun tramp-handle-verify-visited-file-modtime (buf)
2954 "Like `verify-visited-file-modtime' for Tramp files.
2955 At the time `verify-visited-file-modtime' calls this function, we
2956 already know that the buffer is visiting a file and that
2957 `visited-file-modtime' does not return 0. Do not call this
2958 function directly, unless those two cases are already taken care
2959 of."
2960 (with-current-buffer buf
2961 (let ((f (buffer-file-name)))
2962 ;; There is no file visiting the buffer, or the buffer has no
2963 ;; recorded last modification time, or there is no established
2964 ;; connection.
2965 (if (or (not f)
2966 (eq (visited-file-modtime) 0)
2967 (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
2968 t
2969 (with-parsed-tramp-file-name f nil
2970 (tramp-flush-file-property v localname)
2971 (let* ((attr (file-attributes f))
2972 (modtime (nth 5 attr))
2973 (mt (visited-file-modtime)))
2974
2975 (cond
2976 ;; File exists, and has a known modtime.
2977 ((and attr (not (equal modtime '(0 0))))
2978 (< (abs (tramp-time-diff
2979 modtime
2980 ;; For compatibility, deal with both the old
2981 ;; (HIGH . LOW) and the new (HIGH LOW) return
2982 ;; values of `visited-file-modtime'.
2983 (if (atom (cdr mt))
2984 (list (car mt) (cdr mt))
2985 mt)))
2986 2))
2987 ;; Modtime has the don't know value.
2988 (attr
2989 (tramp-send-command
2990 v
2991 (format "%s -ild %s"
2992 (tramp-get-ls-command v)
2993 (tramp-shell-quote-argument localname)))
2994 (with-current-buffer (tramp-get-buffer v)
2995 (setq attr (buffer-substring
2996 (point) (progn (end-of-line) (point)))))
2997 (equal
2998 attr
2999 (tramp-get-file-property
3000 v localname "visited-file-modtime-ild" "")))
3001 ;; If file does not exist, say it is not modified if and
3002 ;; only if that agrees with the buffer's record.
3003 (t (equal mt '(-1 65535))))))))))
3004
3005 (defun tramp-handle-set-file-modes (filename mode)
3006 "Like `set-file-modes' for Tramp files."
3007 (with-parsed-tramp-file-name filename nil
3008 (tramp-flush-file-property v localname)
3009 (unless (zerop (tramp-send-command-and-check
3010 v
3011 (format "chmod %s %s"
3012 (tramp-decimal-to-octal mode)
3013 (tramp-shell-quote-argument localname))))
3014 ;; FIXME: extract the proper text from chmod's stderr.
3015 (tramp-error
3016 v 'file-error "Error while changing file's mode %s" filename))))
3017
3018 (defun tramp-handle-set-file-times (filename &optional time)
3019 "Like `set-file-times' for Tramp files."
3020 (zerop
3021 (if (file-remote-p filename)
3022 (with-parsed-tramp-file-name filename nil
3023 (tramp-flush-file-property v localname)
3024 (let ((time (if (or (null time) (equal time '(0 0)))
3025 (current-time)
3026 time))
3027 ;; With GNU Emacs, `format-time-string' has an optional
3028 ;; parameter UNIVERSAL. This is preferred, because we
3029 ;; could handle the case when the remote host is
3030 ;; located in a different time zone as the local host.
3031 (utc (not (featurep 'xemacs))))
3032 (tramp-send-command-and-check
3033 v (format "%s touch -t %s %s"
3034 (if utc "TZ=UTC; export TZ;" "")
3035 (if utc
3036 (format-time-string "%Y%m%d%H%M.%S" time t)
3037 (format-time-string "%Y%m%d%H%M.%S" time))
3038 (tramp-shell-quote-argument localname)))))
3039
3040 ;; We handle also the local part, because in older Emacsen,
3041 ;; without `set-file-times', this function is an alias for this.
3042 ;; We are local, so we don't need the UTC settings.
3043 (tramp-local-call-process
3044 "touch" nil nil nil "-t"
3045 (format-time-string "%Y%m%d%H%M.%S" time)
3046 (tramp-shell-quote-argument filename)))))
3047
3048 (defun tramp-set-file-uid-gid (filename &optional uid gid)
3049 "Set the ownership for FILENAME.
3050 If UID and GID are provided, these values are used; otherwise uid
3051 and gid of the corresponding user is taken. Both parameters must be integers."
3052 ;; Modern Unices allow chown only for root. So we might need
3053 ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
3054 ;; working with su(do)? when it is needed, so it shall succeed in
3055 ;; the majority of cases.
3056 ;; Don't modify `last-coding-system-used' by accident.
3057 (let ((last-coding-system-used last-coding-system-used))
3058 (if (file-remote-p filename)
3059 (with-parsed-tramp-file-name filename nil
3060 (if (and (zerop (user-uid)) (tramp-local-host-p v))
3061 ;; If we are root on the local host, we can do it directly.
3062 (tramp-set-file-uid-gid localname uid gid)
3063 (let ((uid (or (and (integerp uid) uid)
3064 (tramp-get-remote-uid v 'integer)))
3065 (gid (or (and (integerp gid) gid)
3066 (tramp-get-remote-gid v 'integer))))
3067 (tramp-send-command
3068 v (format
3069 "chown %d:%d %s" uid gid
3070 (tramp-shell-quote-argument localname))))))
3071
3072 ;; We handle also the local part, because there doesn't exist
3073 ;; `set-file-uid-gid'. On W32 "chown" might not work.
3074 (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
3075 (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
3076 (tramp-local-call-process
3077 "chown" nil nil nil
3078 (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
3079
3080 (defun tramp-remote-selinux-p (vec)
3081 "Check, whether SELINUX is enabled on the remote host."
3082 (with-connection-property (tramp-get-connection-process vec) "selinux-p"
3083 (let ((result (tramp-find-executable
3084 vec "getenforce" (tramp-get-remote-path vec) t t)))
3085 (and result
3086 (string-equal
3087 (tramp-send-command-and-read
3088 vec (format "echo \\\"`%S`\\\"" result))
3089 "Enforcing")))))
3090
3091 (defun tramp-handle-file-selinux-context (filename)
3092 "Like `file-selinux-context' for Tramp files."
3093 (with-parsed-tramp-file-name filename nil
3094 (with-file-property v localname "file-selinux-context"
3095 (let ((context '(nil nil nil nil))
3096 (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
3097 "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
3098 (when (and (tramp-remote-selinux-p v)
3099 (zerop (tramp-send-command-and-check
3100 v (format
3101 "%s -d -Z %s"
3102 (tramp-get-ls-command v)
3103 (tramp-shell-quote-argument localname)))))
3104 (with-current-buffer (tramp-get-connection-buffer v)
3105 (goto-char (point-min))
3106 (when (re-search-forward regexp (tramp-compat-line-end-position) t)
3107 (setq context (list (match-string 1) (match-string 2)
3108 (match-string 3) (match-string 4))))))
3109 ;; Return the context.
3110 context))))
3111
3112 (defun tramp-handle-set-file-selinux-context (filename context)
3113 "Like `set-file-selinux-context' for Tramp files."
3114 (with-parsed-tramp-file-name filename nil
3115 (if (and (consp context)
3116 (tramp-remote-selinux-p v)
3117 (zerop (tramp-send-command-and-check
3118 v (format "chcon %s %s %s %s %s"
3119 (if (stringp (nth 0 context))
3120 (format "--user=%s" (nth 0 context)) "")
3121 (if (stringp (nth 1 context))
3122 (format "--role=%s" (nth 1 context)) "")
3123 (if (stringp (nth 2 context))
3124 (format "--type=%s" (nth 2 context)) "")
3125 (if (stringp (nth 3 context))
3126 (format "--range=%s" (nth 3 context)) "")
3127 (tramp-shell-quote-argument localname)))))
3128 (tramp-set-file-property v localname "file-selinux-context" context)
3129 (tramp-set-file-property v localname "file-selinux-context" 'undef)))
3130 ;; We always return nil.
3131 nil)
3132
3133 ;; Simple functions using the `test' command.
3134
3135 (defun tramp-handle-file-executable-p (filename)
3136 "Like `file-executable-p' for Tramp files."
3137 (with-parsed-tramp-file-name filename nil
3138 (with-file-property v localname "file-executable-p"
3139 ;; Examine `file-attributes' cache to see if request can be
3140 ;; satisfied without remote operation.
3141 (or (tramp-check-cached-permissions v ?x)
3142 (zerop (tramp-run-test "-x" filename))))))
3143
3144 (defun tramp-handle-file-readable-p (filename)
3145 "Like `file-readable-p' for Tramp files."
3146 (with-parsed-tramp-file-name filename nil
3147 (with-file-property v localname "file-readable-p"
3148 ;; Examine `file-attributes' cache to see if request can be
3149 ;; satisfied without remote operation.
3150 (or (tramp-check-cached-permissions v ?r)
3151 (zerop (tramp-run-test "-r" filename))))))
3152
3153 ;; When the remote shell is started, it looks for a shell which groks
3154 ;; tilde expansion. Here, we assume that all shells which grok tilde
3155 ;; expansion will also provide a `test' command which groks `-nt' (for
3156 ;; newer than). If this breaks, tell me about it and I'll try to do
3157 ;; something smarter about it.
3158 (defun tramp-handle-file-newer-than-file-p (file1 file2)
3159 "Like `file-newer-than-file-p' for Tramp files."
3160 (cond ((not (file-exists-p file1))
3161 nil)
3162 ((not (file-exists-p file2))
3163 t)
3164 ;; We are sure both files exist at this point.
3165 (t
3166 (save-excursion
3167 ;; We try to get the mtime of both files. If they are not
3168 ;; equal to the "dont-know" value, then we subtract the times
3169 ;; and obtain the result.
3170 (let ((fa1 (file-attributes file1))
3171 (fa2 (file-attributes file2)))
3172 (if (and (not (equal (nth 5 fa1) '(0 0)))
3173 (not (equal (nth 5 fa2) '(0 0))))
3174 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
3175 ;; If one of them is the dont-know value, then we can
3176 ;; still try to run a shell command on the remote host.
3177 ;; However, this only works if both files are Tramp
3178 ;; files and both have the same method, same user, same
3179 ;; host.
3180 (unless (tramp-equal-remote file1 file2)
3181 (with-parsed-tramp-file-name
3182 (if (tramp-tramp-file-p file1) file1 file2) nil
3183 (tramp-error
3184 v 'file-error
3185 "Files %s and %s must have same method, user, host"
3186 file1 file2)))
3187 (with-parsed-tramp-file-name file1 nil
3188 (zerop (tramp-run-test2
3189 (tramp-get-test-nt-command v) file1 file2)))))))))
3190
3191 ;; Functions implemented using the basic functions above.
3192
3193 (defun tramp-handle-file-modes (filename)
3194 "Like `file-modes' for Tramp files."
3195 (let ((truename (or (file-truename filename) filename)))
3196 (when (file-exists-p truename)
3197 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
3198
3199 (defun tramp-default-file-modes (filename)
3200 "Return file modes of FILENAME as integer.
3201 If the file modes of FILENAME cannot be determined, return the
3202 value of `default-file-modes', without execute permissions."
3203 (or (file-modes filename)
3204 (logand (default-file-modes) (tramp-octal-to-decimal "0666"))))
3205
3206 (defun tramp-handle-file-directory-p (filename)
3207 "Like `file-directory-p' for Tramp files."
3208 ;; Care must be taken that this function returns `t' for symlinks
3209 ;; pointing to directories. Surely the most obvious implementation
3210 ;; would be `test -d', but that returns false for such symlinks.
3211 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
3212 ;; I now think he's right. So we could be using `test -d', couldn't
3213 ;; we?
3214 ;;
3215 ;; Alternatives: `cd %s', `test -d %s'
3216 (with-parsed-tramp-file-name filename nil
3217 (with-file-property v localname "file-directory-p"
3218 (zerop (tramp-run-test "-d" filename)))))
3219
3220 (defun tramp-handle-file-regular-p (filename)
3221 "Like `file-regular-p' for Tramp files."
3222 (and (file-exists-p filename)
3223 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
3224
3225 (defun tramp-handle-file-symlink-p (filename)
3226 "Like `file-symlink-p' for Tramp files."
3227 (with-parsed-tramp-file-name filename nil
3228 (let ((x (car (file-attributes filename))))
3229 (when (stringp x)
3230 ;; When Tramp is running on VMS, then `file-name-absolute-p'
3231 ;; might do weird things.
3232 (if (file-name-absolute-p x)
3233 (tramp-make-tramp-file-name method user host x)
3234 x)))))
3235
3236 (defun tramp-handle-file-writable-p (filename)
3237 "Like `file-writable-p' for Tramp files."
3238 (with-parsed-tramp-file-name filename nil
3239 (with-file-property v localname "file-writable-p"
3240 (if (file-exists-p filename)
3241 ;; Examine `file-attributes' cache to see if request can be
3242 ;; satisfied without remote operation.
3243 (or (tramp-check-cached-permissions v ?w)
3244 (zerop (tramp-run-test "-w" filename)))
3245 ;; If file doesn't exist, check if directory is writable.
3246 (and (zerop (tramp-run-test
3247 "-d" (file-name-directory filename)))
3248 (zerop (tramp-run-test
3249 "-w" (file-name-directory filename))))))))
3250
3251 (defun tramp-handle-file-ownership-preserved-p (filename)
3252 "Like `file-ownership-preserved-p' for Tramp files."
3253 (with-parsed-tramp-file-name filename nil
3254 (with-file-property v localname "file-ownership-preserved-p"
3255 (let ((attributes (file-attributes filename)))
3256 ;; Return t if the file doesn't exist, since it's true that no
3257 ;; information would be lost by an (attempted) delete and create.
3258 (or (null attributes)
3259 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
3260
3261 ;; Other file name ops.
3262
3263 (defun tramp-handle-directory-file-name (directory)
3264 "Like `directory-file-name' for Tramp files."
3265 ;; If localname component of filename is "/", leave it unchanged.
3266 ;; Otherwise, remove any trailing slash from localname component.
3267 ;; Method, host, etc, are unchanged. Does it make sense to try
3268 ;; to avoid parsing the filename?
3269 (with-parsed-tramp-file-name directory nil
3270 (if (and (not (zerop (length localname)))
3271 (eq (aref localname (1- (length localname))) ?/)
3272 (not (string= localname "/")))
3273 (substring directory 0 -1)
3274 directory)))
3275
3276 ;; Directory listings.
3277
3278 (defun tramp-handle-directory-files
3279 (directory &optional full match nosort files-only)
3280 "Like `directory-files' for Tramp files."
3281 ;; FILES-ONLY is valid for XEmacs only.
3282 (when (file-directory-p directory)
3283 (setq directory (file-name-as-directory (expand-file-name directory)))
3284 (let ((temp (nreverse (file-name-all-completions "" directory)))
3285 result item)
3286
3287 (while temp
3288 (setq item (directory-file-name (pop temp)))
3289 (when (and (or (null match) (string-match match item))
3290 (or (null files-only)
3291 ;; Files only.
3292 (and (equal files-only t) (file-regular-p item))
3293 ;; Directories only.
3294 (file-directory-p item)))
3295 (push (if full (concat directory item) item)
3296 result)))
3297 (if nosort result (sort result 'string<)))))
3298
3299 (defun tramp-handle-directory-files-and-attributes
3300 (directory &optional full match nosort id-format)
3301 "Like `directory-files-and-attributes' for Tramp files."
3302 (unless id-format (setq id-format 'integer))
3303 (when (file-directory-p directory)
3304 (setq directory (expand-file-name directory))
3305 (let* ((temp
3306 (copy-tree
3307 (with-parsed-tramp-file-name directory nil
3308 (with-file-property
3309 v localname
3310 (format "directory-files-and-attributes-%s" id-format)
3311 (save-excursion
3312 (mapcar
3313 (lambda (x)
3314 (cons (car x)
3315 (tramp-convert-file-attributes v (cdr x))))
3316 (cond
3317 ((tramp-get-remote-stat v)
3318 (tramp-do-directory-files-and-attributes-with-stat
3319 v localname id-format))
3320 ((tramp-get-remote-perl v)
3321 (tramp-do-directory-files-and-attributes-with-perl
3322 v localname id-format)))))))))
3323 result item)
3324
3325 (while temp
3326 (setq item (pop temp))
3327 (when (or (null match) (string-match match (car item)))
3328 (when full
3329 (setcar item (expand-file-name (car item) directory)))
3330 (push item result)))
3331
3332 (if nosort
3333 result
3334 (sort result (lambda (x y) (string< (car x) (car y))))))))
3335
3336 (defun tramp-do-directory-files-and-attributes-with-perl
3337 (vec localname &optional id-format)
3338 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
3339 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
3340 (tramp-maybe-send-script
3341 vec tramp-perl-directory-files-and-attributes
3342 "tramp_perl_directory_files_and_attributes")
3343 (let ((object
3344 (tramp-send-command-and-read
3345 vec
3346 (format "tramp_perl_directory_files_and_attributes %s %s"
3347 (tramp-shell-quote-argument localname) id-format))))
3348 (when (stringp object) (tramp-error vec 'file-error object))
3349 object))
3350
3351 (defun tramp-do-directory-files-and-attributes-with-stat
3352 (vec localname &optional id-format)
3353 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
3354 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
3355 (tramp-send-command-and-read
3356 vec
3357 (format
3358 (concat
3359 ;; We must care about filenames with spaces, or starting with
3360 ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
3361 ;; but it does not work on all remote systems. Therefore, we
3362 ;; quote the filenames via sed.
3363 "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
3364 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); "
3365 "echo \")\"")
3366 (tramp-shell-quote-argument localname)
3367 (tramp-get-ls-command vec)
3368 (tramp-get-remote-stat vec)
3369 (if (eq id-format 'integer) "%u" "\"%U\"")
3370 (if (eq id-format 'integer) "%g" "\"%G\""))))
3371
3372 ;; This function should return "foo/" for directories and "bar" for
3373 ;; files.
3374 (defun tramp-handle-file-name-all-completions (filename directory)
3375 "Like `file-name-all-completions' for Tramp files."
3376 (unless (save-match-data (string-match "/" filename))
3377 (with-parsed-tramp-file-name (expand-file-name directory) nil
3378
3379 (all-completions
3380 filename
3381 (mapcar
3382 'list
3383 (or
3384 ;; Try cache first
3385 (and
3386 ;; Ignore if expired
3387 (or (not (integerp tramp-completion-reread-directory-timeout))
3388 (<= (tramp-time-diff
3389 (current-time)
3390 (tramp-get-file-property
3391 v localname "last-completion" '(0 0 0)))
3392 tramp-completion-reread-directory-timeout))
3393
3394 ;; Try cache entries for filename, filename with last
3395 ;; character removed, filename with last two characters
3396 ;; removed, ..., and finally the empty string - all
3397 ;; concatenated to the local directory name
3398
3399 ;; This is inefficient for very long filenames, pity
3400 ;; `reduce' is not available...
3401 (car
3402 (apply
3403 'append
3404 (mapcar
3405 (lambda (x)
3406 (let ((cache-hit
3407 (tramp-get-file-property
3408 v
3409 (concat localname (substring filename 0 x))
3410 "file-name-all-completions"
3411 nil)))
3412 (when cache-hit (list cache-hit))))
3413 (tramp-compat-number-sequence (length filename) 0 -1)))))
3414
3415 ;; Cache expired or no matching cache entry found so we need
3416 ;; to perform a remote operation
3417 (let (result)
3418 ;; Get a list of directories and files, including reliably
3419 ;; tagging the directories with a trailing '/'. Because I
3420 ;; rock. --daniel@danann.net
3421
3422 ;; Changed to perform `cd' in the same remote op and only
3423 ;; get entries starting with `filename'. Capture any `cd'
3424 ;; error messages. Ensure any `cd' and `echo' aliases are
3425 ;; ignored.
3426 (tramp-send-command
3427 v
3428 (if (tramp-get-remote-perl v)
3429 (progn
3430 (tramp-maybe-send-script
3431 v tramp-perl-file-name-all-completions
3432 "tramp_perl_file_name_all_completions")
3433 (format "tramp_perl_file_name_all_completions %s %s %d"
3434 (tramp-shell-quote-argument localname)
3435 (tramp-shell-quote-argument filename)
3436 (if (symbol-value
3437 ;; `read-file-name-completion-ignore-case'
3438 ;; is introduced with Emacs 22.1.
3439 (if (boundp
3440 'read-file-name-completion-ignore-case)
3441 'read-file-name-completion-ignore-case
3442 'completion-ignore-case))
3443 1 0)))
3444
3445 (format (concat
3446 "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
3447 ;; `ls' with wildcard might fail with `Argument
3448 ;; list too long' error in some corner cases; if
3449 ;; `ls' fails after `cd' succeeded, chances are
3450 ;; that's the case, so let's retry without
3451 ;; wildcard. This will return "too many" entries
3452 ;; but that isn't harmful.
3453 " || %s -a 2>/dev/null)"
3454 " | while read f; do"
3455 " if %s -d \"$f\" 2>/dev/null;"
3456 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
3457 " && \\echo ok) || \\echo fail")
3458 (tramp-shell-quote-argument localname)
3459 (tramp-get-ls-command v)
3460 ;; When `filename' is empty, just `ls' without
3461 ;; filename argument is more efficient than `ls *'
3462 ;; for very large directories and might avoid the
3463 ;; `Argument list too long' error.
3464 ;;
3465 ;; With and only with wildcard, we need to add
3466 ;; `-d' to prevent `ls' from descending into
3467 ;; sub-directories.
3468 (if (zerop (length filename))
3469 "."
3470 (concat (tramp-shell-quote-argument filename) "* -d"))
3471 (tramp-get-ls-command v)
3472 (tramp-get-test-command v))))
3473
3474 ;; Now grab the output.
3475 (with-current-buffer (tramp-get-buffer v)
3476 (goto-char (point-max))
3477
3478 ;; Check result code, found in last line of output
3479 (forward-line -1)
3480 (if (looking-at "^fail$")
3481 (progn
3482 ;; Grab error message from line before last line
3483 ;; (it was put there by `cd 2>&1')
3484 (forward-line -1)
3485 (tramp-error
3486 v 'file-error
3487 "tramp-handle-file-name-all-completions: %s"
3488 (buffer-substring
3489 (point) (tramp-compat-line-end-position))))
3490 ;; For peace of mind, if buffer doesn't end in `fail'
3491 ;; then it should end in `ok'. If neither are in the
3492 ;; buffer something went seriously wrong on the remote
3493 ;; side.
3494 (unless (looking-at "^ok$")
3495 (tramp-error
3496 v 'file-error
3497 "\
3498 tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
3499 (tramp-shell-quote-argument localname) (buffer-string))))
3500
3501 (while (zerop (forward-line -1))
3502 (push (buffer-substring
3503 (point) (tramp-compat-line-end-position))
3504 result)))
3505
3506 ;; Because the remote op went through OK we know the
3507 ;; directory we `cd'-ed to exists
3508 (tramp-set-file-property
3509 v localname "file-exists-p" t)
3510
3511 ;; Because the remote op went through OK we know every
3512 ;; file listed by `ls' exists.
3513 (mapc (lambda (entry)
3514 (tramp-set-file-property
3515 v (concat localname entry) "file-exists-p" t))
3516 result)
3517
3518 (tramp-set-file-property
3519 v localname "last-completion" (current-time))
3520
3521 ;; Store result in the cache
3522 (tramp-set-file-property
3523 v (concat localname filename)
3524 "file-name-all-completions"
3525 result))))))))
3526
3527 (defun tramp-handle-file-name-completion
3528 (filename directory &optional predicate)
3529 "Like `file-name-completion' for Tramp files."
3530 (unless (tramp-tramp-file-p directory)
3531 (error
3532 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
3533 directory))
3534 (try-completion
3535 filename
3536 (mapcar 'list (file-name-all-completions filename directory))
3537 (when predicate
3538 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
3539
3540 ;; cp, mv and ln
3541
3542 (defun tramp-handle-add-name-to-file
3543 (filename newname &optional ok-if-already-exists)
3544 "Like `add-name-to-file' for Tramp files."
3545 (unless (tramp-equal-remote filename newname)
3546 (with-parsed-tramp-file-name
3547 (if (tramp-tramp-file-p filename) filename newname) nil
3548 (tramp-error
3549 v 'file-error
3550 "add-name-to-file: %s"
3551 "only implemented for same method, same user, same host")))
3552 (with-parsed-tramp-file-name filename v1
3553 (with-parsed-tramp-file-name newname v2
3554 (let ((ln (when v1 (tramp-get-remote-ln v1))))
3555 (when (and (not ok-if-already-exists)
3556 (file-exists-p newname)
3557 (not (numberp ok-if-already-exists))
3558 (y-or-n-p
3559 (format
3560 "File %s already exists; make it a new name anyway? "
3561 newname)))
3562 (tramp-error
3563 v2 'file-error
3564 "add-name-to-file: file %s already exists" newname))
3565 (tramp-flush-file-property v2 (file-name-directory v2-localname))
3566 (tramp-flush-file-property v2 v2-localname)
3567 (tramp-barf-unless-okay
3568 v1
3569 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
3570 (tramp-shell-quote-argument v2-localname))
3571 "error with add-name-to-file, see buffer `%s' for details"
3572 (buffer-name))))))
3573
3574 (defun tramp-handle-copy-file
3575 (filename newname &optional ok-if-already-exists keep-date
3576 preserve-uid-gid preserve-selinux-context)
3577 "Like `copy-file' for Tramp files."
3578 (setq filename (expand-file-name filename))
3579 (setq newname (expand-file-name newname))
3580 (cond
3581 ;; At least one file a Tramp file?
3582 ((or (tramp-tramp-file-p filename)
3583 (tramp-tramp-file-p newname))
3584 (tramp-do-copy-or-rename-file
3585 'copy filename newname ok-if-already-exists keep-date
3586 preserve-uid-gid preserve-selinux-context))
3587 ;; Compat section.
3588 (preserve-selinux-context
3589 (tramp-run-real-handler
3590 'copy-file
3591 (list filename newname ok-if-already-exists keep-date
3592 preserve-uid-gid preserve-selinux-context)))
3593 (preserve-uid-gid
3594 (tramp-run-real-handler
3595 'copy-file
3596 (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
3597 (t
3598 (tramp-run-real-handler
3599 'copy-file (list filename newname ok-if-already-exists keep-date)))))
3600
3601 (defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
3602 "Like `copy-directory' for Tramp files."
3603 (let ((t1 (tramp-tramp-file-p dirname))
3604 (t2 (tramp-tramp-file-p newname)))
3605 (with-parsed-tramp-file-name (if t1 dirname newname) nil
3606 (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
3607 ;; When DIRNAME and NEWNAME are remote, they must have
3608 ;; the same method.
3609 (or (null t1) (null t2)
3610 (string-equal
3611 (tramp-file-name-method (tramp-dissect-file-name dirname))
3612 (tramp-file-name-method (tramp-dissect-file-name newname)))))
3613 ;; scp or rsync DTRT.
3614 (progn
3615 (setq dirname (directory-file-name (expand-file-name dirname))
3616 newname (directory-file-name (expand-file-name newname)))
3617 (if (and (file-directory-p newname)
3618 (not (string-equal (file-name-nondirectory dirname)
3619 (file-name-nondirectory newname))))
3620 (setq newname
3621 (expand-file-name
3622 (file-name-nondirectory dirname) newname)))
3623 (if (not (file-directory-p (file-name-directory newname)))
3624 (make-directory (file-name-directory newname) parents))
3625 (tramp-do-copy-or-rename-file-out-of-band
3626 'copy dirname newname keep-date))
3627 ;; We must do it file-wise.
3628 (tramp-run-real-handler
3629 'copy-directory (list dirname newname keep-date parents)))
3630
3631 ;; When newname did exist, we have wrong cached values.
3632 (when t2
3633 (with-parsed-tramp-file-name newname nil
3634 (tramp-flush-file-property v (file-name-directory localname))
3635 (tramp-flush-file-property v localname))))))
3636
3637 (defun tramp-handle-rename-file
3638 (filename newname &optional ok-if-already-exists)
3639 "Like `rename-file' for Tramp files."
3640 ;; Check if both files are local -- invoke normal rename-file.
3641 ;; Otherwise, use Tramp from local system.
3642 (setq filename (expand-file-name filename))
3643 (setq newname (expand-file-name newname))
3644 ;; At least one file a Tramp file?
3645 (if (or (tramp-tramp-file-p filename)
3646 (tramp-tramp-file-p newname))
3647 (tramp-do-copy-or-rename-file
3648 'rename filename newname ok-if-already-exists t t)
3649 (tramp-run-real-handler
3650 'rename-file (list filename newname ok-if-already-exists))))
3651
3652 (defun tramp-do-copy-or-rename-file
3653 (op filename newname &optional ok-if-already-exists keep-date
3654 preserve-uid-gid preserve-selinux-context)
3655 "Copy or rename a remote file.
3656 OP must be `copy' or `rename' and indicates the operation to perform.
3657 FILENAME specifies the file to copy or rename, NEWNAME is the name of
3658 the new file (for copy) or the new name of the file (for rename).
3659 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
3660 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3661 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3662 the uid and gid if both files are on the same host.
3663 PRESERVE-SELINUX-CONTEXT activates selinux commands.
3664
3665 This function is invoked by `tramp-handle-copy-file' and
3666 `tramp-handle-rename-file'. It is an error if OP is neither of `copy'
3667 and `rename'. FILENAME and NEWNAME must be absolute file names."
3668 (unless (memq op '(copy rename))
3669 (error "Unknown operation `%s', must be `copy' or `rename'" op))
3670 (let ((t1 (tramp-tramp-file-p filename))
3671 (t2 (tramp-tramp-file-p newname))
3672 (context (and preserve-selinux-context
3673 (apply 'file-selinux-context (list filename))))
3674 pr tm)
3675
3676 (with-parsed-tramp-file-name (if t1 filename newname) nil
3677 (when (and (not ok-if-already-exists) (file-exists-p newname))
3678 (tramp-error
3679 v 'file-already-exists "File %s already exists" newname))
3680
3681 (with-progress-reporter
3682 v 0 (format "%s %s to %s"
3683 (if (eq op 'copy) "Copying" "Renaming")
3684 filename newname)
3685
3686 (cond
3687 ;; Both are Tramp files.
3688 ((and t1 t2)
3689 (with-parsed-tramp-file-name filename v1
3690 (with-parsed-tramp-file-name newname v2
3691 (cond
3692 ;; Shortcut: if method, host, user are the same for
3693 ;; both files, we invoke `cp' or `mv' on the remote
3694 ;; host directly.
3695 ((tramp-equal-remote filename newname)
3696 (tramp-do-copy-or-rename-file-directly
3697 op filename newname
3698 ok-if-already-exists keep-date preserve-uid-gid))
3699
3700 ;; Try out-of-band operation.
3701 ((tramp-method-out-of-band-p
3702 v1 (nth 7 (file-attributes filename)))
3703 (tramp-do-copy-or-rename-file-out-of-band
3704 op filename newname keep-date))
3705
3706 ;; No shortcut was possible. So we copy the file
3707 ;; first. If the operation was `rename', we go back
3708 ;; and delete the original file (if the copy was
3709 ;; successful). The approach is simple-minded: we
3710 ;; create a new buffer, insert the contents of the
3711 ;; source file into it, then write out the buffer to
3712 ;; the target file. The advantage is that it doesn't
3713 ;; matter which filename handlers are used for the
3714 ;; source and target file.
3715 (t
3716 (tramp-do-copy-or-rename-file-via-buffer
3717 op filename newname keep-date))))))
3718
3719 ;; One file is a Tramp file, the other one is local.
3720 ((or t1 t2)
3721 (cond
3722 ;; Fast track on local machine.
3723 ((tramp-local-host-p v)
3724 (tramp-do-copy-or-rename-file-directly
3725 op filename newname
3726 ok-if-already-exists keep-date preserve-uid-gid))
3727
3728 ;; If the Tramp file has an out-of-band method, the
3729 ;; corresponding copy-program can be invoked.
3730 ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
3731 (tramp-do-copy-or-rename-file-out-of-band
3732 op filename newname keep-date))
3733
3734 ;; Use the inline method via a Tramp buffer.
3735 (t (tramp-do-copy-or-rename-file-via-buffer
3736 op filename newname keep-date))))
3737
3738 (t
3739 ;; One of them must be a Tramp file.
3740 (error "Tramp implementation says this cannot happen")))
3741
3742 ;; Handle `preserve-selinux-context'.
3743 (when context (apply 'set-file-selinux-context (list newname context)))
3744
3745 ;; In case of `rename', we must flush the cache of the source file.
3746 (when (and t1 (eq op 'rename))
3747 (with-parsed-tramp-file-name filename v1
3748 (tramp-flush-file-property v1 (file-name-directory localname))
3749 (tramp-flush-file-property v1 localname)))
3750
3751 ;; When newname did exist, we have wrong cached values.
3752 (when t2
3753 (with-parsed-tramp-file-name newname v2
3754 (tramp-flush-file-property v2 (file-name-directory localname))
3755 (tramp-flush-file-property v2 localname)))))))
3756
3757 (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
3758 "Use an Emacs buffer to copy or rename a file.
3759 First arg OP is either `copy' or `rename' and indicates the operation.
3760 FILENAME is the source file, NEWNAME the target file.
3761 KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
3762 (with-temp-buffer
3763 ;; We must disable multibyte, because binary data shall not be
3764 ;; converted.
3765 (set-buffer-multibyte nil)
3766 (let ((coding-system-for-read 'binary)
3767 (jka-compr-inhibit t))
3768 (insert-file-contents-literally filename))
3769 ;; We don't want the target file to be compressed, so we let-bind
3770 ;; `jka-compr-inhibit' to t.
3771 (let ((coding-system-for-write 'binary)
3772 (jka-compr-inhibit t))
3773 (write-region (point-min) (point-max) newname)))
3774 ;; KEEP-DATE handling.
3775 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
3776 ;; Set the mode.
3777 (set-file-modes newname (tramp-default-file-modes filename))
3778 ;; If the operation was `rename', delete the original file.
3779 (unless (eq op 'copy) (delete-file filename)))
3780
3781 (defun tramp-do-copy-or-rename-file-directly
3782 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
3783 "Invokes `cp' or `mv' on the remote system.
3784 OP must be one of `copy' or `rename', indicating `cp' or `mv',
3785 respectively. FILENAME specifies the file to copy or rename,
3786 NEWNAME is the name of the new file (for copy) or the new name of
3787 the file (for rename). Both files must reside on the same host.
3788 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3789 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3790 the uid and gid from FILENAME."
3791 (let ((t1 (tramp-tramp-file-p filename))
3792 (t2 (tramp-tramp-file-p newname))
3793 (file-times (nth 5 (file-attributes filename)))
3794 (file-modes (tramp-default-file-modes filename)))
3795 (with-parsed-tramp-file-name (if t1 filename newname) nil
3796 (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
3797 ((eq op 'copy) "cp -f")
3798 ((eq op 'rename) "mv -f")
3799 (t (tramp-error
3800 v 'file-error
3801 "Unknown operation `%s', must be `copy' or `rename'"
3802 op))))
3803 (localname1
3804 (if t1
3805 (tramp-file-name-handler 'file-remote-p filename 'localname)
3806 filename))
3807 (localname2
3808 (if t2
3809 (tramp-file-name-handler 'file-remote-p newname 'localname)
3810 newname))
3811 (prefix (file-remote-p (if t1 filename newname)))
3812 cmd-result)
3813
3814 (cond
3815 ;; Both files are on a remote host, with same user.
3816 ((and t1 t2)
3817 (setq cmd-result
3818 (tramp-send-command-and-check
3819 v
3820 (format "%s %s %s" cmd
3821 (tramp-shell-quote-argument localname1)
3822 (tramp-shell-quote-argument localname2))))
3823 (with-current-buffer (tramp-get-buffer v)
3824 (goto-char (point-min))
3825 (unless
3826 (or
3827 (and keep-date
3828 ;; Mask cp -f error.
3829 (re-search-forward
3830 tramp-operation-not-permitted-regexp nil t))
3831 (zerop cmd-result))
3832 (tramp-error-with-buffer
3833 nil v 'file-error
3834 "Copying directly failed, see buffer `%s' for details."
3835 (buffer-name)))))
3836
3837 ;; We are on the local host.
3838 ((or t1 t2)
3839 (cond
3840 ;; We can do it directly.
3841 ((let (file-name-handler-alist)
3842 (and (file-readable-p localname1)
3843 (file-writable-p (file-name-directory localname2))
3844 (or (file-directory-p localname2)
3845 (file-writable-p localname2))))
3846 (if (eq op 'copy)
3847 (tramp-compat-copy-file
3848 localname1 localname2 ok-if-already-exists
3849 keep-date preserve-uid-gid)
3850 (tramp-run-real-handler
3851 'rename-file (list localname1 localname2 ok-if-already-exists))))
3852
3853 ;; We can do it directly with `tramp-send-command'
3854 ((and (file-readable-p (concat prefix localname1))
3855 (file-writable-p
3856 (file-name-directory (concat prefix localname2)))
3857 (or (file-directory-p (concat prefix localname2))
3858 (file-writable-p (concat prefix localname2))))
3859 (tramp-do-copy-or-rename-file-directly
3860 op (concat prefix localname1) (concat prefix localname2)
3861 ok-if-already-exists keep-date t)
3862 ;; We must change the ownership to the local user.
3863 (tramp-set-file-uid-gid
3864 (concat prefix localname2)
3865 (tramp-get-local-uid 'integer)
3866 (tramp-get-local-gid 'integer)))
3867
3868 ;; We need a temporary file in between.
3869 (t
3870 ;; Create the temporary file.
3871 (let ((tmpfile (tramp-compat-make-temp-file localname1)))
3872 (unwind-protect
3873 (progn
3874 (cond
3875 (t1
3876 (or
3877 (zerop
3878 (tramp-send-command-and-check
3879 v (format
3880 "%s %s %s" cmd
3881 (tramp-shell-quote-argument localname1)
3882 (tramp-shell-quote-argument tmpfile))))
3883 (tramp-error-with-buffer
3884 nil v 'file-error
3885 "Copying directly failed, see buffer `%s' for details."
3886 (tramp-get-buffer v)))
3887 ;; We must change the ownership as remote user.
3888 ;; Since this does not work reliable, we also
3889 ;; give read permissions.
3890 (set-file-modes
3891 (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
3892 (tramp-set-file-uid-gid
3893 (concat prefix tmpfile)
3894 (tramp-get-local-uid 'integer)
3895 (tramp-get-local-gid 'integer)))
3896 (t2
3897 (if (eq op 'copy)
3898 (tramp-compat-copy-file
3899 localname1 tmpfile t
3900 keep-date preserve-uid-gid)
3901 (tramp-run-real-handler
3902 'rename-file
3903 (list localname1 tmpfile t)))
3904 ;; We must change the ownership as local user.
3905 ;; Since this does not work reliable, we also
3906 ;; give read permissions.
3907 (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
3908 (tramp-set-file-uid-gid
3909 tmpfile
3910 (tramp-get-remote-uid v 'integer)
3911 (tramp-get-remote-gid v 'integer))))
3912
3913 ;; Move the temporary file to its destination.
3914 (cond
3915 (t2
3916 (or
3917 (zerop
3918 (tramp-send-command-and-check
3919 v (format
3920 "cp -f -p %s %s"
3921 (tramp-shell-quote-argument tmpfile)
3922 (tramp-shell-quote-argument localname2))))
3923 (tramp-error-with-buffer
3924 nil v 'file-error
3925 "Copying directly failed, see buffer `%s' for details."
3926 (tramp-get-buffer v))))
3927 (t1
3928 (tramp-run-real-handler
3929 'rename-file
3930 (list tmpfile localname2 ok-if-already-exists)))))
3931
3932 ;; Save exit.
3933 (condition-case nil
3934 (delete-file tmpfile)
3935 (error)))))))))
3936
3937 ;; Set the time and mode. Mask possible errors.
3938 (condition-case nil
3939 (when keep-date
3940 (set-file-times newname file-times)
3941 (set-file-modes newname file-modes))
3942 (error)))))
3943
3944 (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
3945 "Invoke rcp program to copy.
3946 The method used must be an out-of-band method."
3947 (let ((t1 (tramp-tramp-file-p filename))
3948 (t2 (tramp-tramp-file-p newname))
3949 copy-program copy-args copy-env copy-keep-date port spec
3950 source target)
3951
3952 (with-parsed-tramp-file-name (if t1 filename newname) nil
3953 (if (and t1 t2)
3954
3955 ;; Both are Tramp files. We shall optimize it, when the
3956 ;; methods for filename and newname are the same.
3957 (let* ((dir-flag (file-directory-p filename))
3958 (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
3959 (if dir-flag
3960 (setq tmpfile
3961 (expand-file-name
3962 (file-name-nondirectory newname) tmpfile)))
3963 (unwind-protect
3964 (progn
3965 (tramp-do-copy-or-rename-file-out-of-band
3966 op filename tmpfile keep-date)
3967 (tramp-do-copy-or-rename-file-out-of-band
3968 'rename tmpfile newname keep-date))
3969 ;; Save exit.
3970 (condition-case nil
3971 (if dir-flag
3972 (tramp-compat-delete-directory
3973 (expand-file-name ".." tmpfile) 'recursive)
3974 (delete-file tmpfile))
3975 (error))))
3976
3977 ;; Expand hops. Might be necessary for gateway methods.
3978 (setq v (car (tramp-compute-multi-hops v)))
3979 (aset v 3 localname)
3980
3981 ;; Check which ones of source and target are Tramp files.
3982 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
3983 target (funcall
3984 (if (and (file-directory-p filename)
3985 (string-equal
3986 (file-name-nondirectory filename)
3987 (file-name-nondirectory newname)))
3988 'file-name-directory
3989 'identity)
3990 (if t2 (tramp-make-copy-program-file-name v) newname)))
3991
3992 ;; Check for port number. Until now, there's no need for handling
3993 ;; like method, user, host.
3994 (setq host (tramp-file-name-real-host v)
3995 port (tramp-file-name-port v)
3996 port (or (and port (number-to-string port)) ""))
3997
3998 ;; Compose copy command.
3999 (setq spec (format-spec-make
4000 ?h host ?u user ?p port
4001 ?t (tramp-get-connection-property
4002 (tramp-get-connection-process v) "temp-file" "")
4003 ?k (if keep-date " " ""))
4004 copy-program (tramp-get-method-parameter
4005 method 'tramp-copy-program)
4006 copy-keep-date (tramp-get-method-parameter
4007 method 'tramp-copy-keep-date)
4008 copy-args
4009 (delq
4010 nil
4011 (mapcar
4012 (lambda (x)
4013 (setq
4014 x
4015 ;; " " is indication for keep-date argument.
4016 (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
4017 (unless (member "" x) (mapconcat 'identity x " ")))
4018 (tramp-get-method-parameter method 'tramp-copy-args)))
4019 copy-env
4020 (delq
4021 nil
4022 (mapcar
4023 (lambda (x)
4024 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
4025 (unless (member "" x) (mapconcat 'identity x " ")))
4026 (tramp-get-method-parameter method 'tramp-copy-env))))
4027
4028 ;; Check for program.
4029 (when (and (fboundp 'executable-find)
4030 (not (let ((default-directory
4031 (tramp-compat-temporary-file-directory)))
4032 (executable-find copy-program))))
4033 (tramp-error
4034 v 'file-error "Cannot find copy program: %s" copy-program))
4035
4036 ;; Set variables for computing the prompt for reading
4037 ;; password.
4038 (setq tramp-current-method (tramp-file-name-method v)
4039 tramp-current-user (tramp-file-name-user v)
4040 tramp-current-host (tramp-file-name-host v))
4041
4042 (unwind-protect
4043 (with-temp-buffer
4044 ;; The default directory must be remote.
4045 (let ((default-directory
4046 (file-name-directory (if t1 filename newname)))
4047 (process-environment (copy-sequence process-environment)))
4048 ;; Set the transfer process properties.
4049 (tramp-set-connection-property
4050 v "process-name" (buffer-name (current-buffer)))
4051 (tramp-set-connection-property
4052 v "process-buffer" (current-buffer))
4053 (while copy-env
4054 (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
4055 (setenv (pop copy-env) (pop copy-env)))
4056
4057 ;; Use an asynchronous process. By this, password can
4058 ;; be handled. The default directory must be local, in
4059 ;; order to apply the correct `copy-program'. We don't
4060 ;; set a timeout, because the copying of large files can
4061 ;; last longer than 60 secs.
4062 (let ((p (let ((default-directory
4063 (tramp-compat-temporary-file-directory)))
4064 (apply 'start-process
4065 (tramp-get-connection-property
4066 v "process-name" nil)
4067 (tramp-get-connection-property
4068 v "process-buffer" nil)
4069 copy-program
4070 (append copy-args (list source target))))))
4071 (tramp-message
4072 v 6 "%s" (mapconcat 'identity (process-command p) " "))
4073 (tramp-set-process-query-on-exit-flag p nil)
4074 (tramp-process-actions p v tramp-actions-copy-out-of-band))))
4075
4076 ;; Reset the transfer process properties.
4077 (tramp-set-connection-property v "process-name" nil)
4078 (tramp-set-connection-property v "process-buffer" nil))
4079
4080 ;; Handle KEEP-DATE argument.
4081 (when (and keep-date (not copy-keep-date))
4082 (set-file-times newname (nth 5 (file-attributes filename))))
4083
4084 ;; Set the mode.
4085 (unless (and keep-date copy-keep-date)
4086 (ignore-errors
4087 (set-file-modes newname (tramp-default-file-modes filename)))))
4088
4089 ;; If the operation was `rename', delete the original file.
4090 (unless (eq op 'copy)
4091 (if (file-regular-p filename)
4092 (delete-file filename)
4093 (tramp-compat-delete-directory filename 'recursive))))))
4094
4095 (defun tramp-handle-make-directory (dir &optional parents)
4096 "Like `make-directory' for Tramp files."
4097 (setq dir (expand-file-name dir))
4098 (with-parsed-tramp-file-name dir nil
4099 (tramp-flush-directory-property v (file-name-directory localname))
4100 (save-excursion
4101 (tramp-barf-unless-okay
4102 v
4103 (format "%s %s"
4104 (if parents "mkdir -p" "mkdir")
4105 (tramp-shell-quote-argument localname))
4106 "Couldn't make directory %s" dir))))
4107
4108 (defun tramp-handle-delete-directory (directory &optional recursive)
4109 "Like `delete-directory' for Tramp files."
4110 (setq directory (expand-file-name directory))
4111 (with-parsed-tramp-file-name directory nil
4112 (tramp-flush-file-property v (file-name-directory localname))
4113 (tramp-flush-directory-property v localname)
4114 (unless (zerop (tramp-send-command-and-check
4115 v
4116 (format
4117 "%s %s"
4118 (if recursive "rm -rf" "rmdir")
4119 (tramp-shell-quote-argument localname))))
4120 (tramp-error v 'file-error "Couldn't delete %s" directory))))
4121
4122 (defun tramp-handle-delete-file (filename &optional trash)
4123 "Like `delete-file' for Tramp files."
4124 (setq filename (expand-file-name filename))
4125 (with-parsed-tramp-file-name filename nil
4126 (tramp-flush-file-property v (file-name-directory localname))
4127 (tramp-flush-file-property v localname)
4128 (unless
4129 (zerop
4130 (tramp-send-command-and-check
4131 v (format "%s %s"
4132 (or (and trash (tramp-get-remote-trash v)) "rm -f")
4133 (tramp-shell-quote-argument localname))))
4134 (tramp-error v 'file-error "Couldn't delete %s" filename))))
4135
4136 ;; Dired.
4137
4138 ;; CCC: This does not seem to be enough. Something dies when
4139 ;; we try and delete two directories under Tramp :/
4140 (defun tramp-handle-dired-recursive-delete-directory (filename)
4141 "Recursively delete the directory given.
4142 This is like `dired-recursive-delete-directory' for Tramp files."
4143 (with-parsed-tramp-file-name filename nil
4144 ;; Run a shell command 'rm -r <localname>'
4145 ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
4146 (unless (file-exists-p filename)
4147 (tramp-error v 'file-error "No such directory: %s" filename))
4148 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
4149 (tramp-send-command
4150 v
4151 (format "rm -rf %s" (tramp-shell-quote-argument localname))
4152 ;; Don't read the output, do it explicitely.
4153 nil t)
4154 ;; Wait for the remote system to return to us...
4155 ;; This might take a while, allow it plenty of time.
4156 (tramp-wait-for-output (tramp-get-connection-process v) 120)
4157 ;; Make sure that it worked...
4158 (tramp-flush-file-property v (file-name-directory localname))
4159 (tramp-flush-directory-property v localname)
4160 (and (file-exists-p filename)
4161 (tramp-error
4162 v 'file-error "Failed to recursively delete %s" filename))))
4163
4164 (defun tramp-handle-dired-compress-file (file &rest ok-flag)
4165 "Like `dired-compress-file' for Tramp files."
4166 ;; OK-FLAG is valid for XEmacs only, but not implemented.
4167 ;; Code stolen mainly from dired-aux.el.
4168 (with-parsed-tramp-file-name file nil
4169 (tramp-flush-file-property v localname)
4170 (save-excursion
4171 (let ((suffixes
4172 (if (not (featurep 'xemacs))
4173 ;; Emacs case
4174 (symbol-value 'dired-compress-file-suffixes)
4175 ;; XEmacs has `dired-compression-method-alist', which is
4176 ;; transformed into `dired-compress-file-suffixes' structure.
4177 (mapcar
4178 (lambda (x)
4179 (list (concat (regexp-quote (nth 1 x)) "\\'")
4180 nil
4181 (mapconcat 'identity (nth 3 x) " ")))
4182 (symbol-value 'dired-compression-method-alist))))
4183 suffix)
4184 ;; See if any suffix rule matches this file name.
4185 (while suffixes
4186 (let (case-fold-search)
4187 (if (string-match (car (car suffixes)) localname)
4188 (setq suffix (car suffixes) suffixes nil))
4189 (setq suffixes (cdr suffixes))))
4190
4191 (cond ((file-symlink-p file)
4192 nil)
4193 ((and suffix (nth 2 suffix))
4194 ;; We found an uncompression rule.
4195 (with-progress-reporter v 0 (format "Uncompressing %s" file)
4196 (when (zerop
4197 (tramp-send-command-and-check
4198 v (concat (nth 2 suffix) " "
4199 (tramp-shell-quote-argument localname))))
4200 ;; `dired-remove-file' is not defined in XEmacs.
4201 (tramp-compat-funcall 'dired-remove-file file)
4202 (string-match (car suffix) file)
4203 (concat (substring file 0 (match-beginning 0))))))
4204 (t
4205 ;; We don't recognize the file as compressed, so compress it.
4206 ;; Try gzip.
4207 (with-progress-reporter v 0 (format "Compressing %s" file)
4208 (when (zerop
4209 (tramp-send-command-and-check
4210 v (concat "gzip -f "
4211 (tramp-shell-quote-argument localname))))
4212 ;; `dired-remove-file' is not defined in XEmacs.
4213 (tramp-compat-funcall 'dired-remove-file file)
4214 (cond ((file-exists-p (concat file ".gz"))
4215 (concat file ".gz"))
4216 ((file-exists-p (concat file ".z"))
4217 (concat file ".z"))
4218 (t nil))))))))))
4219
4220 (defun tramp-handle-dired-uncache (dir &optional dir-p)
4221 "Like `dired-uncache' for Tramp files."
4222 ;; DIR-P is valid for XEmacs only.
4223 (with-parsed-tramp-file-name
4224 (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
4225 (tramp-flush-file-property v localname)))
4226
4227 ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
4228 ;; not sure at all that this is the right way to do it, but let's hope
4229 ;; it works for now, and wait for a guru to point out the Right Way to
4230 ;; achieve this.
4231 ;;(eval-when-compile
4232 ;; (unless (fboundp 'dired-insert-set-properties)
4233 ;; (fset 'dired-insert-set-properties 'ignore)))
4234 ;; Gerd suggests this:
4235 (eval-when-compile (require 'dired))
4236 ;; Note that dired is required at run-time, too, when it is needed.
4237 ;; It is only needed on XEmacs for the function
4238 ;; `dired-insert-set-properties'.
4239
4240 (defun tramp-handle-insert-directory
4241 (filename switches &optional wildcard full-directory-p)
4242 "Like `insert-directory' for Tramp files."
4243 (setq filename (expand-file-name filename))
4244 (with-parsed-tramp-file-name filename nil
4245 (if (and (featurep 'ls-lisp)
4246 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
4247 (tramp-run-real-handler
4248 'insert-directory (list filename switches wildcard full-directory-p))
4249 (when (stringp switches)
4250 (setq switches (split-string switches)))
4251 (when (and (member "--dired" switches)
4252 (not (tramp-get-ls-command-with-dired v)))
4253 (setq switches (delete "--dired" switches)))
4254 (when wildcard
4255 (setq wildcard (tramp-run-real-handler
4256 'file-name-nondirectory (list localname)))
4257 (setq localname (tramp-run-real-handler
4258 'file-name-directory (list localname))))
4259 (unless full-directory-p
4260 (setq switches (add-to-list 'switches "-d" 'append)))
4261 (setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
4262 (when wildcard
4263 (setq switches (concat switches " " wildcard)))
4264 (tramp-message
4265 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
4266 switches filename (if wildcard "yes" "no")
4267 (if full-directory-p "yes" "no"))
4268 ;; If `full-directory-p', we just say `ls -l FILENAME'.
4269 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
4270 (if full-directory-p
4271 (tramp-send-command
4272 v
4273 (format "%s %s %s 2>/dev/null"
4274 (tramp-get-ls-command v)
4275 switches
4276 (if wildcard
4277 localname
4278 (tramp-shell-quote-argument (concat localname ".")))))
4279 (tramp-barf-unless-okay
4280 v
4281 (format "cd %s" (tramp-shell-quote-argument
4282 (tramp-run-real-handler
4283 'file-name-directory (list localname))))
4284 "Couldn't `cd %s'"
4285 (tramp-shell-quote-argument
4286 (tramp-run-real-handler 'file-name-directory (list localname))))
4287 (tramp-send-command
4288 v
4289 (format "%s %s %s"
4290 (tramp-get-ls-command v)
4291 switches
4292 (if (or wildcard
4293 (zerop (length
4294 (tramp-run-real-handler
4295 'file-name-nondirectory (list localname)))))
4296 ""
4297 (tramp-shell-quote-argument
4298 (tramp-run-real-handler
4299 'file-name-nondirectory (list localname)))))))
4300 (let ((beg (point)))
4301 ;; We cannot use `insert-buffer-substring' because the Tramp
4302 ;; buffer changes its contents before insertion due to calling
4303 ;; `expand-file' and alike.
4304 (insert
4305 (with-current-buffer (tramp-get-buffer v)
4306 (buffer-string)))
4307
4308 ;; Check for "--dired" output.
4309 (forward-line -2)
4310 (when (looking-at "//SUBDIRED//")
4311 (forward-line -1))
4312 (when (looking-at "//DIRED//\\s-+")
4313 (let ((databeg (match-end 0))
4314 (end (tramp-compat-line-end-position)))
4315 ;; Now read the numeric positions of file names.
4316 (goto-char databeg)
4317 (while (< (point) end)
4318 (let ((start (+ beg (read (current-buffer))))
4319 (end (+ beg (read (current-buffer)))))
4320 (if (memq (char-after end) '(?\n ?\ ))
4321 ;; End is followed by \n or by " -> ".
4322 (put-text-property start end 'dired-filename t))))))
4323 ;; Remove trailing lines.
4324 (goto-char (tramp-compat-line-beginning-position))
4325 (while (looking-at "//")
4326 (forward-line 1)
4327 (delete-region (match-beginning 0) (point)))
4328
4329 ;; The inserted file could be from somewhere else.
4330 (when (and (not wildcard) (not full-directory-p))
4331 (goto-char (point-max))
4332 (when (file-symlink-p filename)
4333 (goto-char (search-backward "->" beg 'noerror)))
4334 (search-backward
4335 (if (zerop (length (file-name-nondirectory filename)))
4336 "."
4337 (file-name-nondirectory filename))
4338 beg 'noerror)
4339 (replace-match (file-relative-name filename) t))
4340
4341 (goto-char (point-max))))))
4342
4343 (defun tramp-handle-unhandled-file-name-directory (filename)
4344 "Like `unhandled-file-name-directory' for Tramp files."
4345 ;; With Emacs 23, we could simply return `nil'. But we must keep it
4346 ;; for backward compatibility.
4347 (expand-file-name "~/"))
4348
4349 ;; Canonicalization of file names.
4350
4351 (defun tramp-handle-expand-file-name (name &optional dir)
4352 "Like `expand-file-name' for Tramp files.
4353 If the localname part of the given filename starts with \"/../\" then
4354 the result will be a local, non-Tramp, filename."
4355 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
4356 (setq dir (or dir default-directory "/"))
4357 ;; Unless NAME is absolute, concat DIR and NAME.
4358 (unless (file-name-absolute-p name)
4359 (setq name (concat (file-name-as-directory dir) name)))
4360 ;; If NAME is not a Tramp file, run the real handler.
4361 (if (not (tramp-connectable-p name))
4362 (tramp-run-real-handler 'expand-file-name (list name nil))
4363 ;; Dissect NAME.
4364 (with-parsed-tramp-file-name name nil
4365 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
4366 (setq localname (concat "~/" localname)))
4367 ;; Tilde expansion if necessary. This needs a shell which
4368 ;; groks tilde expansion! The function `tramp-find-shell' is
4369 ;; supposed to find such a shell on the remote host. Please
4370 ;; tell me about it when this doesn't work on your system.
4371 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
4372 (let ((uname (match-string 1 localname))
4373 (fname (match-string 2 localname)))
4374 ;; We cannot simply apply "~/", because under sudo "~/" is
4375 ;; expanded to the local user home directory but to the
4376 ;; root home directory. On the other hand, using always
4377 ;; the default user name for tilde expansion is not
4378 ;; appropriate either, because ssh and companions might
4379 ;; use a user name from the config file.
4380 (when (and (string-equal uname "~")
4381 (string-match "\\`su\\(do\\)?\\'" method))
4382 (setq uname (concat uname user)))
4383 (setq uname
4384 (with-connection-property v uname
4385 (tramp-send-command
4386 v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
4387 (with-current-buffer (tramp-get-buffer v)
4388 (goto-char (point-min))
4389 (buffer-substring
4390 (point) (tramp-compat-line-end-position)))))
4391 (setq localname (concat uname fname))))
4392 ;; There might be a double slash, for example when "~/"
4393 ;; expands to "/". Remove this.
4394 (while (string-match "//" localname)
4395 (setq localname (replace-match "/" t t localname)))
4396 ;; No tilde characters in file name, do normal
4397 ;; `expand-file-name' (this does "/./" and "/../"). We bind
4398 ;; `directory-sep-char' here for XEmacs on Windows, which would
4399 ;; otherwise use backslash. `default-directory' is bound,
4400 ;; because on Windows there would be problems with UNC shares or
4401 ;; Cygwin mounts.
4402 (let ((directory-sep-char ?/)
4403 (default-directory (tramp-compat-temporary-file-directory)))
4404 (tramp-make-tramp-file-name
4405 method user host
4406 (tramp-drop-volume-letter
4407 (tramp-run-real-handler
4408 'expand-file-name (list localname))))))))
4409
4410 (defun tramp-replace-environment-variables (filename)
4411 "Replace environment variables in FILENAME.
4412 Return the string with the replaced variables."
4413 (save-match-data
4414 (let ((idx (string-match "$\\(\\w+\\)" filename)))
4415 ;; `$' is coded as `$$'.
4416 (when (and idx
4417 (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
4418 (getenv (match-string 1 filename)))
4419 (setq filename
4420 (replace-match
4421 (substitute-in-file-name (match-string 0 filename))
4422 t nil filename)))
4423 filename)))
4424
4425 (defun tramp-handle-substitute-in-file-name (filename)
4426 "Like `substitute-in-file-name' for Tramp files.
4427 \"//\" and \"/~\" substitute only in the local filename part.
4428 If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
4429 beginning of local filename are not substituted."
4430 ;; First, we must replace environment variables.
4431 (setq filename (tramp-replace-environment-variables filename))
4432 (with-parsed-tramp-file-name filename nil
4433 (if (equal tramp-syntax 'url)
4434 ;; We need to check localname only. The other parts cannot contain
4435 ;; "//" or "/~".
4436 (if (and (> (length localname) 1)
4437 (or (string-match "//" localname)
4438 (string-match "/~" localname 1)))
4439 (tramp-run-real-handler 'substitute-in-file-name (list filename))
4440 (tramp-make-tramp-file-name
4441 (when method (substitute-in-file-name method))
4442 (when user (substitute-in-file-name user))
4443 (when host (substitute-in-file-name host))
4444 (when localname
4445 (tramp-run-real-handler
4446 'substitute-in-file-name (list localname)))))
4447 ;; Ignore in LOCALNAME everything before "//" or "/~".
4448 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
4449 (setq filename
4450 (concat (file-remote-p filename)
4451 (replace-match "\\1" nil nil localname)))
4452 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
4453 (when (string-match "~$" filename)
4454 (setq filename (concat filename "/"))))
4455 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
4456
4457 ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
4458 ;; which calls corresponding functions (see minibuf.el).
4459 (when (fboundp 'minibuffer-electric-separator)
4460 (mapc
4461 (lambda (x)
4462 (eval
4463 `(defadvice ,x
4464 (around ,(intern (format "tramp-advice-%s" x)) activate)
4465 "Invoke `substitute-in-file-name' for Tramp files."
4466 (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
4467 (tramp-tramp-file-p (buffer-substring)))
4468 ;; We don't need to handle `last-input-event', because
4469 ;; due to the key map we know it must be ?/ or ?~.
4470 (let ((s (concat (buffer-substring (point-min) (point))
4471 (string last-command-char))))
4472 (delete-region (point-min) (point))
4473 (insert (substitute-in-file-name s))
4474 (setq ad-return-value last-command-char))
4475 ad-do-it)))
4476 (eval
4477 `(add-hook
4478 'tramp-unload-hook
4479 (lambda ()
4480 (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x)))
4481 (ad-activate ',x)))))
4482
4483 '(minibuffer-electric-separator
4484 minibuffer-electric-tilde)))
4485
4486
4487 ;;; Remote commands:
4488
4489 (defun tramp-handle-executable-find (command)
4490 "Like `executable-find' for Tramp files."
4491 (with-parsed-tramp-file-name default-directory nil
4492 (tramp-find-executable v command (tramp-get-remote-path v) t)))
4493
4494 ;; We use BUFFER also as connection buffer during setup. Because of
4495 ;; this, its original contents must be saved, and restored once
4496 ;; connection has been setup.
4497 (defun tramp-handle-start-file-process (name buffer program &rest args)
4498 "Like `start-file-process' for Tramp files."
4499 (with-parsed-tramp-file-name default-directory nil
4500 (unless (stringp program)
4501 (tramp-error
4502 v 'file-error "pty association is not supported for `%s'" name))
4503 (unwind-protect
4504 (let ((command (format "cd %s; exec %s"
4505 (tramp-shell-quote-argument localname)
4506 (mapconcat 'tramp-shell-quote-argument
4507 (cons program args) " ")))
4508 (name1 name)
4509 (i 0))
4510 (unless buffer
4511 ;; BUFFER can be nil. We use a temporary buffer.
4512 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
4513 (while (get-process name1)
4514 ;; NAME must be unique as process name.
4515 (setq i (1+ i)
4516 name1 (format "%s<%d>" name i)))
4517 (setq name name1)
4518 ;; Set the new process properties.
4519 (tramp-set-connection-property v "process-name" name)
4520 (tramp-set-connection-property v "process-buffer" buffer)
4521 ;; Activate narrowing in order to save BUFFER contents.
4522 ;; Clear also the modification time; otherwise we might be
4523 ;; interrupted by `verify-visited-file-modtime'.
4524 (with-current-buffer (tramp-get-connection-buffer v)
4525 (clear-visited-file-modtime)
4526 (narrow-to-region (point-max) (point-max)))
4527 ;; Send the command. `tramp-send-command' opens a new
4528 ;; connection.
4529 (tramp-send-command v command nil t) ; nooutput
4530 ;; Set query flag for this process.
4531 (tramp-set-process-query-on-exit-flag
4532 (tramp-get-connection-process v) t)
4533 ;; Return process.
4534 (tramp-get-connection-process v))
4535 ;; Save exit.
4536 (with-current-buffer (tramp-get-connection-buffer v)
4537 (if (string-match tramp-temp-buffer-name (buffer-name))
4538 (progn
4539 (set-process-buffer (tramp-get-connection-process v) nil)
4540 (kill-buffer (current-buffer)))
4541 (widen)
4542 (goto-char (point-max))))
4543 (tramp-set-connection-property v "process-name" nil)
4544 (tramp-set-connection-property v "process-buffer" nil))))
4545
4546 (defun tramp-handle-process-file
4547 (program &optional infile destination display &rest args)
4548 "Like `process-file' for Tramp files."
4549 ;; The implementation is not complete yet.
4550 (when (and (numberp destination) (zerop destination))
4551 (error "Implementation does not handle immediate return"))
4552
4553 (with-parsed-tramp-file-name default-directory nil
4554 (let (command input tmpinput stderr tmpstderr outbuf ret)
4555 ;; Compute command.
4556 (setq command (mapconcat 'tramp-shell-quote-argument
4557 (cons program args) " "))
4558 ;; Determine input.
4559 (if (null infile)
4560 (setq input "/dev/null")
4561 (setq infile (expand-file-name infile))
4562 (if (tramp-equal-remote default-directory infile)
4563 ;; INFILE is on the same remote host.
4564 (setq input (with-parsed-tramp-file-name infile nil localname))
4565 ;; INFILE must be copied to remote host.
4566 (setq input (tramp-make-tramp-temp-file v)
4567 tmpinput (tramp-make-tramp-file-name method user host input))
4568 (copy-file infile tmpinput t)))
4569 (when input (setq command (format "%s <%s" command input)))
4570
4571 ;; Determine output.
4572 (cond
4573 ;; Just a buffer.
4574 ((bufferp destination)
4575 (setq outbuf destination))
4576 ;; A buffer name.
4577 ((stringp destination)
4578 (setq outbuf (get-buffer-create destination)))
4579 ;; (REAL-DESTINATION ERROR-DESTINATION)
4580 ((consp destination)
4581 ;; output.
4582 (cond
4583 ((bufferp (car destination))
4584 (setq outbuf (car destination)))
4585 ((stringp (car destination))
4586 (setq outbuf (get-buffer-create (car destination))))
4587 ((car destination)
4588 (setq outbuf (current-buffer))))
4589 ;; stderr.
4590 (cond
4591 ((stringp (cadr destination))
4592 (setcar (cdr destination) (expand-file-name (cadr destination)))
4593 (if (tramp-equal-remote default-directory (cadr destination))
4594 ;; stderr is on the same remote host.
4595 (setq stderr (with-parsed-tramp-file-name
4596 (cadr destination) nil localname))
4597 ;; stderr must be copied to remote host. The temporary
4598 ;; file must be deleted after execution.
4599 (setq stderr (tramp-make-tramp-temp-file v)
4600 tmpstderr (tramp-make-tramp-file-name
4601 method user host stderr))))
4602 ;; stderr to be discarded.
4603 ((null (cadr destination))
4604 (setq stderr "/dev/null"))))
4605 ;; 't
4606 (destination
4607 (setq outbuf (current-buffer))))
4608 (when stderr (setq command (format "%s 2>%s" command stderr)))
4609
4610 ;; Send the command. It might not return in time, so we protect it.
4611 (condition-case nil
4612 (unwind-protect
4613 (setq ret
4614 (tramp-send-command-and-check
4615 v (format "\\cd %s; %s"
4616 (tramp-shell-quote-argument localname)
4617 command)
4618 nil t))
4619 ;; We should show the output anyway.
4620 (when outbuf
4621 (with-current-buffer outbuf
4622 (insert
4623 (with-current-buffer (tramp-get-connection-buffer v)
4624 (buffer-string))))
4625 (when display (display-buffer outbuf))))
4626 ;; When the user did interrupt, we should do it also. We use
4627 ;; return code -1 as marker.
4628 (quit
4629 (kill-buffer (tramp-get-connection-buffer v))
4630 (setq ret -1))
4631 ;; Handle errors.
4632 (error
4633 (kill-buffer (tramp-get-connection-buffer v))
4634 (setq ret 1)))
4635
4636 ;; Provide error file.
4637 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
4638
4639 ;; Cleanup. We remove all file cache values for the connection,
4640 ;; because the remote process could have changed them.
4641 (when tmpinput (delete-file tmpinput))
4642
4643 ;; `process-file-side-effects' has been introduced with GNU
4644 ;; Emacs 23.2. If set to `nil', no remote file will be changed
4645 ;; by `program'. If it doesn't exist, we assume its default
4646 ;; value 't'.
4647 (unless (and (boundp 'process-file-side-effects)
4648 (not (symbol-value 'process-file-side-effects)))
4649 (tramp-flush-directory-property v ""))
4650
4651 ;; Return exit status.
4652 (if (equal ret -1)
4653 (keyboard-quit)
4654 ret))))
4655
4656 (defun tramp-local-call-process
4657 (program &optional infile destination display &rest args)
4658 "Calls `call-process' on the local host.
4659 This is needed because for some Emacs flavors Tramp has
4660 defadviced `call-process' to behave like `process-file'. The
4661 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
4662 (let ((default-directory
4663 (if (file-remote-p default-directory)
4664 (tramp-compat-temporary-file-directory)
4665 default-directory)))
4666 (if (executable-find program)
4667 (apply 'call-process program infile destination display args)
4668 1)))
4669
4670 (defun tramp-handle-call-process-region
4671 (start end program &optional delete buffer display &rest args)
4672 "Like `call-process-region' for Tramp files."
4673 (let ((tmpfile (tramp-compat-make-temp-file "")))
4674 (write-region start end tmpfile)
4675 (when delete (delete-region start end))
4676 (unwind-protect
4677 (apply 'call-process program tmpfile buffer display args)
4678 (delete-file tmpfile))))
4679
4680 (defun tramp-handle-shell-command
4681 (command &optional output-buffer error-buffer)
4682 "Like `shell-command' for Tramp files."
4683 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
4684 ;; We cannot use `shell-file-name' and `shell-command-switch',
4685 ;; they are variables of the local host.
4686 (args (list "/bin/sh" "-c" (substring command 0 asynchronous)))
4687 current-buffer-p
4688 (output-buffer
4689 (cond
4690 ((bufferp output-buffer) output-buffer)
4691 ((stringp output-buffer) (get-buffer-create output-buffer))
4692 (output-buffer
4693 (setq current-buffer-p t)
4694 (current-buffer))
4695 (t (get-buffer-create
4696 (if asynchronous
4697 "*Async Shell Command*"
4698 "*Shell Command Output*")))))
4699 (error-buffer
4700 (cond
4701 ((bufferp error-buffer) error-buffer)
4702 ((stringp error-buffer) (get-buffer-create error-buffer))))
4703 (buffer
4704 (if (and (not asynchronous) error-buffer)
4705 (with-parsed-tramp-file-name default-directory nil
4706 (list output-buffer (tramp-make-tramp-temp-file v)))
4707 output-buffer))
4708 (p (get-buffer-process output-buffer)))
4709
4710 ;; Check whether there is another process running. Tramp does not
4711 ;; support 2 (asynchronous) processes in parallel.
4712 (when p
4713 (if (yes-or-no-p "A command is running. Kill it? ")
4714 (condition-case nil
4715 (kill-process p)
4716 (error nil))
4717 (error "Shell command in progress")))
4718
4719 (if current-buffer-p
4720 (progn
4721 (barf-if-buffer-read-only)
4722 (push-mark nil t))
4723 (with-current-buffer output-buffer
4724 (setq buffer-read-only nil)
4725 (erase-buffer)))
4726
4727 (if (and (not current-buffer-p) (integerp asynchronous))
4728 (prog1
4729 ;; Run the process.
4730 (apply 'start-file-process "*Async Shell*" buffer args)
4731 ;; Display output.
4732 (pop-to-buffer output-buffer)
4733 (setq mode-line-process '(":%s"))
4734 (require 'shell) (shell-mode))
4735
4736 (prog1
4737 ;; Run the process.
4738 (apply 'process-file (car args) nil buffer nil (cdr args))
4739 ;; Insert error messages if they were separated.
4740 (when (listp buffer)
4741 (with-current-buffer error-buffer
4742 (insert-file-contents (cadr buffer)))
4743 (delete-file (cadr buffer)))
4744 (if current-buffer-p
4745 ;; This is like exchange-point-and-mark, but doesn't
4746 ;; activate the mark. It is cleaner to avoid activation,
4747 ;; even though the command loop would deactivate the mark
4748 ;; because we inserted text.
4749 (goto-char (prog1 (mark t)
4750 (set-marker (mark-marker) (point)
4751 (current-buffer))))
4752 ;; There's some output, display it.
4753 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
4754 (if (functionp 'display-message-or-buffer)
4755 (tramp-compat-funcall 'display-message-or-buffer output-buffer)
4756 (pop-to-buffer output-buffer))))))))
4757
4758 ;; File Editing.
4759
4760 (defvar tramp-handle-file-local-copy-hook nil
4761 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.")
4762
4763 (defun tramp-handle-file-local-copy (filename)
4764 "Like `file-local-copy' for Tramp files."
4765
4766 (with-parsed-tramp-file-name filename nil
4767 (unless (file-exists-p filename)
4768 (tramp-error
4769 v 'file-error
4770 "Cannot make local copy of non-existing file `%s'" filename))
4771
4772 (let* ((size (nth 7 (file-attributes filename)))
4773 (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
4774 (loc-dec (tramp-get-inline-coding v "local-decoding" size))
4775 (tmpfile (tramp-compat-make-temp-file filename)))
4776
4777 (condition-case err
4778 (cond
4779 ;; `copy-file' handles direct copy and out-of-band methods.
4780 ((or (tramp-local-host-p v)
4781 (tramp-method-out-of-band-p v size))
4782 (copy-file filename tmpfile t t))
4783
4784 ;; Use inline encoding for file transfer.
4785 (rem-enc
4786 (save-excursion
4787 (with-progress-reporter
4788 v 3 (format "Encoding remote file %s" filename)
4789 (tramp-barf-unless-okay
4790 v (format rem-enc (tramp-shell-quote-argument localname))
4791 "Encoding remote file failed"))
4792
4793 (if (functionp loc-dec)
4794 ;; If local decoding is a function, we call it. We
4795 ;; must disable multibyte, because
4796 ;; `uudecode-decode-region' doesn't handle it
4797 ;; correctly.
4798 (with-temp-buffer
4799 (set-buffer-multibyte nil)
4800 (insert-buffer-substring (tramp-get-buffer v))
4801 (with-progress-reporter
4802 v 3 (format "Decoding remote file %s with function %s"
4803 filename loc-dec)
4804 (funcall loc-dec (point-min) (point-max))
4805 ;; Unset `file-name-handler-alist'. Otherwise,
4806 ;; epa-file gets confused.
4807 (let (file-name-handler-alist
4808 (coding-system-for-write 'binary))
4809 (write-region (point-min) (point-max) tmpfile))))
4810
4811 ;; If tramp-decoding-function is not defined for this
4812 ;; method, we invoke tramp-decoding-command instead.
4813 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
4814 ;; Unset `file-name-handler-alist'. Otherwise,
4815 ;; epa-file gets confused.
4816 (let (file-name-handler-alist
4817 (coding-system-for-write 'binary))
4818 (write-region (point-min) (point-max) tmpfile2))
4819 (with-progress-reporter
4820 v 3 (format "Decoding remote file %s with command %s"
4821 filename loc-dec)
4822 (unwind-protect
4823 (tramp-call-local-coding-command
4824 loc-dec tmpfile2 tmpfile)
4825 (delete-file tmpfile2)))))
4826
4827 ;; Set proper permissions.
4828 (set-file-modes tmpfile (tramp-default-file-modes filename))
4829 ;; Set local user ownership.
4830 (tramp-set-file-uid-gid tmpfile)))
4831
4832 ;; Oops, I don't know what to do.
4833 (t (tramp-error
4834 v 'file-error "Wrong method specification for `%s'" method)))
4835
4836 ;; Error handling.
4837 ((error quit)
4838 (delete-file tmpfile)
4839 (signal (car err) (cdr err))))
4840
4841 (run-hooks 'tramp-handle-file-local-copy-hook)
4842 tmpfile)))
4843
4844 (defun tramp-handle-file-remote-p (filename &optional identification connected)
4845 "Like `file-remote-p' for Tramp files."
4846 (let ((tramp-verbose 3))
4847 (when (tramp-tramp-file-p filename)
4848 (let* ((v (tramp-dissect-file-name filename))
4849 (p (tramp-get-connection-process v))
4850 (c (and p (processp p) (memq (process-status p) '(run open)))))
4851 ;; We expand the file name only, if there is already a connection.
4852 (with-parsed-tramp-file-name
4853 (if c (expand-file-name filename) filename) nil
4854 (and (or (not connected) c)
4855 (cond
4856 ((eq identification 'method) method)
4857 ((eq identification 'user) user)
4858 ((eq identification 'host) host)
4859 ((eq identification 'localname) localname)
4860 (t (tramp-make-tramp-file-name method user host "")))))))))
4861
4862 (defun tramp-find-file-name-coding-system-alist (filename tmpname)
4863 "Like `find-operation-coding-system' for Tramp filenames.
4864 Tramp's `insert-file-contents' and `write-region' work over
4865 temporary file names. If `file-coding-system-alist' contains an
4866 expression, which matches more than the file name suffix, the
4867 coding system might not be determined. This function repairs it."
4868 (let (result)
4869 (dolist (elt file-coding-system-alist result)
4870 (when (and (consp elt) (string-match (car elt) filename))
4871 ;; We found a matching entry in `file-coding-system-alist'.
4872 ;; So we add a similar entry, but with the temporary file name
4873 ;; as regexp.
4874 (add-to-list
4875 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
4876
4877 (defun tramp-handle-insert-file-contents
4878 (filename &optional visit beg end replace)
4879 "Like `insert-file-contents' for Tramp files."
4880 (barf-if-buffer-read-only)
4881 (setq filename (expand-file-name filename))
4882 (let (result local-copy remote-copy)
4883 (with-parsed-tramp-file-name filename nil
4884 (unwind-protect
4885 (if (not (file-exists-p filename))
4886 ;; We don't raise a Tramp error, because it might be
4887 ;; suppressed, like in `find-file-noselect-1'.
4888 (signal 'file-error
4889 (list "File not found on remote host" filename))
4890
4891 (if (and (tramp-local-host-p v)
4892 (let (file-name-handler-alist)
4893 (file-readable-p localname)))
4894 ;; Short track: if we are on the local host, we can
4895 ;; run directly.
4896 (setq result
4897 (tramp-run-real-handler
4898 'insert-file-contents
4899 (list localname visit beg end replace)))
4900
4901 ;; When we shall insert only a part of the file, we copy
4902 ;; this part.
4903 (when (or beg end)
4904 (setq remote-copy (tramp-make-tramp-temp-file v))
4905 (tramp-send-command
4906 v
4907 (cond
4908 ((and beg end)
4909 (format "tail -c +%d %s | head -c +%d >%s"
4910 (1+ beg) (tramp-shell-quote-argument localname)
4911 (- end beg) remote-copy))
4912 (beg
4913 (format "tail -c +%d %s >%s"
4914 (1+ beg) (tramp-shell-quote-argument localname)
4915 remote-copy))
4916 (end
4917 (format "head -c +%d %s >%s"
4918 (1+ end) (tramp-shell-quote-argument localname)
4919 remote-copy)))))
4920
4921 ;; `insert-file-contents-literally' takes care to avoid
4922 ;; calling jka-compr. By let-binding
4923 ;; `inhibit-file-name-operation', we propagate that care
4924 ;; to the `file-local-copy' operation.
4925 (setq local-copy
4926 (let ((inhibit-file-name-operation
4927 (when (eq inhibit-file-name-operation
4928 'insert-file-contents)
4929 'file-local-copy)))
4930 (cond
4931 ((stringp remote-copy)
4932 (file-local-copy
4933 (tramp-make-tramp-file-name
4934 method user host remote-copy)))
4935 ((stringp tramp-temp-buffer-file-name)
4936 (copy-file filename tramp-temp-buffer-file-name 'ok)
4937 tramp-temp-buffer-file-name)
4938 (t (file-local-copy filename)))))
4939
4940 ;; When the file is not readable for the owner, it
4941 ;; cannot be inserted, even it is redable for the group
4942 ;; or for everybody.
4943 (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
4944
4945 (when (and (null remote-copy)
4946 (tramp-get-method-parameter
4947 method 'tramp-copy-keep-tmpfile))
4948 ;; We keep the local file for performance reasons,
4949 ;; useful for "rsync".
4950 (setq tramp-temp-buffer-file-name local-copy)
4951 (put 'tramp-temp-buffer-file-name 'permanent-local t))
4952
4953 (with-progress-reporter
4954 v 3 (format "Inserting local temp file `%s'" local-copy)
4955 ;; We must ensure that `file-coding-system-alist'
4956 ;; matches `local-copy'.
4957 (let ((file-coding-system-alist
4958 (tramp-find-file-name-coding-system-alist
4959 filename local-copy)))
4960 (setq result
4961 (insert-file-contents
4962 local-copy nil nil nil replace))))))
4963
4964 ;; Save exit.
4965 (progn
4966 (when visit
4967 (setq buffer-file-name filename)
4968 (setq buffer-read-only (not (file-writable-p filename)))
4969 (set-visited-file-modtime)
4970 (set-buffer-modified-p nil))
4971 (when (and (stringp local-copy)
4972 (or remote-copy (null tramp-temp-buffer-file-name)))
4973 (delete-file local-copy))
4974 (when (stringp remote-copy)
4975 (delete-file
4976 (tramp-make-tramp-file-name method user host remote-copy))))))
4977
4978 ;; Result.
4979 (list (expand-file-name filename)
4980 (cadr result))))
4981
4982 ;; This is needed for XEmacs only. Code stolen from files.el.
4983 (defun tramp-handle-insert-file-contents-literally
4984 (filename &optional visit beg end replace)
4985 "Like `insert-file-contents-literally' for Tramp files."
4986 (let ((format-alist nil)
4987 (after-insert-file-functions nil)
4988 (coding-system-for-read 'no-conversion)
4989 (coding-system-for-write 'no-conversion)
4990 (find-buffer-file-type-function
4991 (if (fboundp 'find-buffer-file-type)
4992 (symbol-function 'find-buffer-file-type)
4993 nil))
4994 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
4995 (inhibit-file-name-operation 'insert-file-contents))
4996 (unwind-protect
4997 (progn
4998 (fset 'find-buffer-file-type (lambda (filename) t))
4999 (insert-file-contents filename visit beg end replace))
5000 ;; Save exit.
5001 (if find-buffer-file-type-function
5002 (fset 'find-buffer-file-type find-buffer-file-type-function)
5003 (fmakunbound 'find-buffer-file-type)))))
5004
5005 (defun tramp-handle-find-backup-file-name (filename)
5006 "Like `find-backup-file-name' for Tramp files."
5007 (with-parsed-tramp-file-name filename nil
5008 ;; We set both variables. It doesn't matter whether it is
5009 ;; Emacs or XEmacs.
5010 (let ((backup-directory-alist
5011 ;; Emacs case.
5012 (when (boundp 'backup-directory-alist)
5013 (if (symbol-value 'tramp-backup-directory-alist)
5014 (mapcar
5015 (lambda (x)
5016 (cons
5017 (car x)
5018 (if (and (stringp (cdr x))
5019 (file-name-absolute-p (cdr x))
5020 (not (tramp-file-name-p (cdr x))))
5021 (tramp-make-tramp-file-name method user host (cdr x))
5022 (cdr x))))
5023 (symbol-value 'tramp-backup-directory-alist))
5024 (symbol-value 'backup-directory-alist))))
5025
5026 (bkup-backup-directory-info
5027 ;; XEmacs case.
5028 (when (boundp 'bkup-backup-directory-info)
5029 (if (symbol-value 'tramp-bkup-backup-directory-info)
5030 (mapcar
5031 (lambda (x)
5032 (nconc
5033 (list (car x))
5034 (list
5035 (if (and (stringp (car (cdr x)))
5036 (file-name-absolute-p (car (cdr x)))
5037 (not (tramp-file-name-p (car (cdr x)))))
5038 (tramp-make-tramp-file-name
5039 method user host (car (cdr x)))
5040 (car (cdr x))))
5041 (cdr (cdr x))))
5042 (symbol-value 'tramp-bkup-backup-directory-info))
5043 (symbol-value 'bkup-backup-directory-info)))))
5044
5045 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
5046
5047 (defun tramp-handle-make-auto-save-file-name ()
5048 "Like `make-auto-save-file-name' for Tramp files.
5049 Returns a file name in `tramp-auto-save-directory' for autosaving this file."
5050 (let ((tramp-auto-save-directory tramp-auto-save-directory)
5051 (buffer-file-name
5052 (tramp-subst-strs-in-string
5053 '(("_" . "|")
5054 ("/" . "_a")
5055 (":" . "_b")
5056 ("|" . "__")
5057 ("[" . "_l")
5058 ("]" . "_r"))
5059 (buffer-file-name))))
5060 ;; File name must be unique. This is ensured with Emacs 22 (see
5061 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
5062 ;; all other cases we must do it ourselves.
5063 (when (boundp 'auto-save-file-name-transforms)
5064 (mapc
5065 (lambda (x)
5066 (when (and (string-match (car x) buffer-file-name)
5067 (not (car (cddr x))))
5068 (setq tramp-auto-save-directory
5069 (or tramp-auto-save-directory
5070 (tramp-compat-temporary-file-directory)))))
5071 (symbol-value 'auto-save-file-name-transforms)))
5072 ;; Create directory.
5073 (when tramp-auto-save-directory
5074 (setq buffer-file-name
5075 (expand-file-name buffer-file-name tramp-auto-save-directory))
5076 (unless (file-exists-p tramp-auto-save-directory)
5077 (make-directory tramp-auto-save-directory t)))
5078 ;; Run plain `make-auto-save-file-name'. There might be an advice when
5079 ;; it is not a magic file name operation (since Emacs 22).
5080 ;; We must deactivate it temporarily.
5081 (if (not (ad-is-active 'make-auto-save-file-name))
5082 (tramp-run-real-handler 'make-auto-save-file-name nil)
5083 ;; else
5084 (ad-deactivate 'make-auto-save-file-name)
5085 (prog1
5086 (tramp-run-real-handler 'make-auto-save-file-name nil)
5087 (ad-activate 'make-auto-save-file-name)))))
5088
5089 (defvar tramp-handle-write-region-hook nil
5090 "Normal hook to be run at the end of `tramp-handle-write-region'.")
5091
5092 ;; CCC grok LOCKNAME
5093 (defun tramp-handle-write-region
5094 (start end filename &optional append visit lockname confirm)
5095 "Like `write-region' for Tramp files."
5096 (setq filename (expand-file-name filename))
5097 (with-parsed-tramp-file-name filename nil
5098 ;; Following part commented out because we don't know what to do about
5099 ;; file locking, and it does not appear to be a problem to ignore it.
5100 ;; Ange-ftp ignores it, too.
5101 ;; (when (and lockname (stringp lockname))
5102 ;; (setq lockname (expand-file-name lockname)))
5103 ;; (unless (or (eq lockname nil)
5104 ;; (string= lockname filename))
5105 ;; (error
5106 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
5107
5108 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
5109 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
5110 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
5111 (tramp-error v 'file-error "File not overwritten")))
5112
5113 (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
5114 (tramp-get-remote-uid v 'integer)))
5115 (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
5116 (tramp-get-remote-gid v 'integer))))
5117
5118 (if (and (tramp-local-host-p v)
5119 ;; `file-writable-p' calls `file-expand-file-name'. We
5120 ;; cannot use `tramp-run-real-handler' therefore.
5121 (let (file-name-handler-alist)
5122 (and
5123 (file-writable-p (file-name-directory localname))
5124 (or (file-directory-p localname)
5125 (file-writable-p localname)))))
5126 ;; Short track: if we are on the local host, we can run directly.
5127 (tramp-run-real-handler
5128 'write-region
5129 (list start end localname append 'no-message lockname confirm))
5130
5131 (let ((modes (save-excursion (tramp-default-file-modes filename)))
5132 ;; We use this to save the value of
5133 ;; `last-coding-system-used' after writing the tmp
5134 ;; file. At the end of the function, we set
5135 ;; `last-coding-system-used' to this saved value. This
5136 ;; way, any intermediary coding systems used while
5137 ;; talking to the remote shell or suchlike won't hose
5138 ;; this variable. This approach was snarfed from
5139 ;; ange-ftp.el.
5140 coding-system-used
5141 ;; Write region into a tmp file. This isn't really
5142 ;; needed if we use an encoding function, but currently
5143 ;; we use it always because this makes the logic
5144 ;; simpler.
5145 (tmpfile (or tramp-temp-buffer-file-name
5146 (tramp-compat-make-temp-file filename))))
5147
5148 ;; If `append' is non-nil, we copy the file locally, and let
5149 ;; the native `write-region' implementation do the job.
5150 (when append (copy-file filename tmpfile 'ok))
5151
5152 ;; We say `no-message' here because we don't want the
5153 ;; visited file modtime data to be clobbered from the temp
5154 ;; file. We call `set-visited-file-modtime' ourselves later
5155 ;; on. We must ensure that `file-coding-system-alist'
5156 ;; matches `tmpfile'.
5157 (let (file-name-handler-alist
5158 (file-coding-system-alist
5159 (tramp-find-file-name-coding-system-alist filename tmpfile)))
5160 (condition-case err
5161 (tramp-run-real-handler
5162 'write-region
5163 (list start end tmpfile append 'no-message lockname confirm))
5164 ((error quit)
5165 (setq tramp-temp-buffer-file-name nil)
5166 (delete-file tmpfile)
5167 (signal (car err) (cdr err))))
5168
5169 ;; Now, `last-coding-system-used' has the right value. Remember it.
5170 (when (boundp 'last-coding-system-used)
5171 (setq coding-system-used
5172 (symbol-value 'last-coding-system-used))))
5173
5174 ;; The permissions of the temporary file should be set. If
5175 ;; filename does not exist (eq modes nil) it has been
5176 ;; renamed to the backup file. This case `save-buffer'
5177 ;; handles permissions.
5178 ;; Ensure, that it is still readable.
5179 (when modes
5180 (set-file-modes
5181 tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400"))))
5182
5183 ;; This is a bit lengthy due to the different methods
5184 ;; possible for file transfer. First, we check whether the
5185 ;; method uses an rcp program. If so, we call it.
5186 ;; Otherwise, both encoding and decoding command must be
5187 ;; specified. However, if the method _also_ specifies an
5188 ;; encoding function, then that is used for encoding the
5189 ;; contents of the tmp file.
5190 (let* ((size (nth 7 (file-attributes tmpfile)))
5191 (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
5192 (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
5193 (cond
5194 ;; `copy-file' handles direct copy and out-of-band methods.
5195 ((or (tramp-local-host-p v)
5196 (tramp-method-out-of-band-p v size))
5197 (if (and (not (stringp start))
5198 (= (or end (point-max)) (point-max))
5199 (= (or start (point-min)) (point-min))
5200 (tramp-get-method-parameter
5201 method 'tramp-copy-keep-tmpfile))
5202 (progn
5203 (setq tramp-temp-buffer-file-name tmpfile)
5204 (condition-case err
5205 ;; We keep the local file for performance
5206 ;; reasons, useful for "rsync".
5207 (copy-file tmpfile filename t)
5208 ((error quit)
5209 (setq tramp-temp-buffer-file-name nil)
5210 (delete-file tmpfile)
5211 (signal (car err) (cdr err)))))
5212 (setq tramp-temp-buffer-file-name nil)
5213 ;; Don't rename, in order to keep context in SELinux.
5214 (unwind-protect
5215 (copy-file tmpfile filename t)
5216 (delete-file tmpfile))))
5217
5218 ;; Use inline file transfer.
5219 (rem-dec
5220 ;; Encode tmpfile.
5221 (unwind-protect
5222 (with-temp-buffer
5223 (set-buffer-multibyte nil)
5224 ;; Use encoding function or command.
5225 (if (functionp loc-enc)
5226 (with-progress-reporter
5227 v 3 (format "Encoding region using function `%s'"
5228 loc-enc)
5229 (let ((coding-system-for-read 'binary))
5230 (insert-file-contents-literally tmpfile))
5231 ;; The following `let' is a workaround for the
5232 ;; base64.el that comes with pgnus-0.84. If
5233 ;; both of the following conditions are
5234 ;; satisfied, it tries to write to a local
5235 ;; file in default-directory, but at this
5236 ;; point, default-directory is remote.
5237 ;; (`call-process-region' can't write to
5238 ;; remote files, it seems.) The file in
5239 ;; question is a tmp file anyway.
5240 (let ((default-directory
5241 (tramp-compat-temporary-file-directory)))
5242 (funcall loc-enc (point-min) (point-max))))
5243
5244 (with-progress-reporter
5245 v 3 (format "Encoding region using command `%s'"
5246 loc-enc)
5247 (unless (zerop (tramp-call-local-coding-command
5248 loc-enc tmpfile t))
5249 (tramp-error
5250 v 'file-error
5251 (concat "Cannot write to `%s', "
5252 "local encoding command `%s' failed")
5253 filename loc-enc))))
5254
5255 ;; Send buffer into remote decoding command which
5256 ;; writes to remote file. Because this happens on
5257 ;; the remote host, we cannot use the function.
5258 (with-progress-reporter
5259 v 3
5260 (format "Decoding region into remote file %s" filename)
5261 (goto-char (point-max))
5262 (unless (bolp) (newline))
5263 (tramp-send-command
5264 v
5265 (format
5266 (concat rem-dec " <<'EOF'\n%sEOF")
5267 (tramp-shell-quote-argument localname)
5268 (buffer-string)))
5269 (tramp-barf-unless-okay
5270 v nil
5271 "Couldn't write region to `%s', decode using `%s' failed"
5272 filename rem-dec)
5273 ;; When `file-precious-flag' is set, the region is
5274 ;; written to a temporary file. Check that the
5275 ;; checksum is equal to that from the local tmpfile.
5276 (when file-precious-flag
5277 (erase-buffer)
5278 (and
5279 ;; cksum runs locally, if possible.
5280 (zerop (tramp-local-call-process "cksum" tmpfile t))
5281 ;; cksum runs remotely.
5282 (zerop
5283 (tramp-send-command-and-check
5284 v
5285 (format
5286 "cksum <%s"
5287 (tramp-shell-quote-argument localname))))
5288 ;; ... they are different.
5289 (not
5290 (string-equal
5291 (buffer-string)
5292 (with-current-buffer (tramp-get-buffer v)
5293 (buffer-string))))
5294 (tramp-error
5295 v 'file-error
5296 (concat "Couldn't write region to `%s',"
5297 " decode using `%s' failed")
5298 filename rem-dec)))))
5299
5300 ;; Save exit.
5301 (delete-file tmpfile)))
5302
5303 ;; That's not expected.
5304 (t
5305 (tramp-error
5306 v 'file-error
5307 (concat "Method `%s' should specify both encoding and "
5308 "decoding command or an rcp program")
5309 method))))
5310
5311 ;; Make `last-coding-system-used' have the right value.
5312 (when coding-system-used
5313 (set 'last-coding-system-used coding-system-used))))
5314
5315 (tramp-flush-file-property v (file-name-directory localname))
5316 (tramp-flush-file-property v localname)
5317
5318 ;; We must protect `last-coding-system-used', now we have set it
5319 ;; to its correct value.
5320 (let (last-coding-system-used (need-chown t))
5321 ;; Set file modification time.
5322 (when (or (eq visit t) (stringp visit))
5323 (let ((file-attr (file-attributes filename)))
5324 (set-visited-file-modtime
5325 ;; We must pass modtime explicitely, because filename can
5326 ;; be different from (buffer-file-name), f.e. if
5327 ;; `file-precious-flag' is set.
5328 (nth 5 file-attr))
5329 (when (and (eq (nth 2 file-attr) uid)
5330 (eq (nth 3 file-attr) gid))
5331 (setq need-chown nil))))
5332
5333 ;; Set the ownership.
5334 (when need-chown
5335 (tramp-set-file-uid-gid filename uid gid))
5336 (when (or (eq visit t) (null visit) (stringp visit))
5337 (tramp-message v 0 "Wrote %s" filename))
5338 (run-hooks 'tramp-handle-write-region-hook)))))
5339
5340 (defvar tramp-vc-registered-file-names nil
5341 "List used to collect file names, which are checked during `vc-registered'.")
5342
5343 ;; VC backends check for the existence of various different special
5344 ;; files. This is very time consuming, because every single check
5345 ;; requires a remote command (the file cache must be invalidated).
5346 ;; Therefore, we apply a kind of optimization. We install the file
5347 ;; name handler `tramp-vc-file-name-handler', which does nothing but
5348 ;; remembers all file names for which `file-exists-p' or
5349 ;; `file-readable-p' has been applied. A first run of `vc-registered'
5350 ;; is performed. Afterwards, a script is applied for all collected
5351 ;; file names, using just one remote command. The result of this
5352 ;; script is used to fill the file cache with actual values. Now we
5353 ;; can reset the file name handlers, and we make a second run of
5354 ;; `vc-registered', which returns the expected result without sending
5355 ;; any other remote command.
5356 (defun tramp-handle-vc-registered (file)
5357 "Like `vc-registered' for Tramp files."
5358 (with-temp-message ""
5359 (with-parsed-tramp-file-name file nil
5360 (with-progress-reporter
5361 v 3 (format "Checking `vc-registered' for %s" file)
5362
5363 ;; There could be new files, created by the vc backend. We
5364 ;; cannot reuse the old cache entries, therefore.
5365 (let (tramp-vc-registered-file-names
5366 (tramp-cache-inhibit-cache (current-time))
5367 (file-name-handler-alist
5368 `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
5369
5370 ;; Here we collect only file names, which need an operation.
5371 (tramp-run-real-handler 'vc-registered (list file))
5372 (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
5373
5374 ;; Send just one command, in order to fill the cache.
5375 (when tramp-vc-registered-file-names
5376 (tramp-maybe-send-script
5377 v
5378 (format tramp-vc-registered-read-file-names
5379 (tramp-get-file-exists-command v)
5380 (format "%s -r" (tramp-get-test-command v)))
5381 "tramp_vc_registered_read_file_names")
5382
5383 (dolist
5384 (elt
5385 (tramp-send-command-and-read
5386 v
5387 (format
5388 "tramp_vc_registered_read_file_names %s"
5389 (mapconcat 'tramp-shell-quote-argument
5390 tramp-vc-registered-file-names
5391 " "))))
5392
5393 (tramp-set-file-property
5394 v (car elt) (cadr elt) (cadr (cdr elt))))))
5395
5396 ;; Second run. Now all `file-exists-p' or `file-readable-p'
5397 ;; calls shall be answered from the file cache. We unset
5398 ;; `process-file-side-effects' in order to keep the cache when
5399 ;; `process-file' calls appear.
5400 (let (process-file-side-effects)
5401 (tramp-run-real-handler 'vc-registered (list file)))))))
5402
5403 ;;;###autoload
5404 (progn (defun tramp-run-real-handler (operation args)
5405 "Invoke normal file name handler for OPERATION.
5406 First arg specifies the OPERATION, second arg is a list of arguments to
5407 pass to the OPERATION."
5408 (let* ((inhibit-file-name-handlers
5409 `(tramp-file-name-handler
5410 tramp-vc-file-name-handler
5411 tramp-completion-file-name-handler
5412 cygwin-mount-name-hook-function
5413 cygwin-mount-map-drive-hook-function
5414 .
5415 ,(and (eq inhibit-file-name-operation operation)
5416 inhibit-file-name-handlers)))
5417 (inhibit-file-name-operation operation))
5418 (apply operation args))))
5419
5420 ;;;###autoload
5421 (progn (defun tramp-completion-run-real-handler (operation args)
5422 "Invoke `tramp-file-name-handler' for OPERATION.
5423 First arg specifies the OPERATION, second arg is a list of arguments to
5424 pass to the OPERATION."
5425 (let* ((inhibit-file-name-handlers
5426 `(tramp-completion-file-name-handler
5427 cygwin-mount-name-hook-function
5428 cygwin-mount-map-drive-hook-function
5429 .
5430 ,(and (eq inhibit-file-name-operation operation)
5431 inhibit-file-name-handlers)))
5432 (inhibit-file-name-operation operation))
5433 (apply operation args))))
5434
5435 ;; We handle here all file primitives. Most of them have the file
5436 ;; name as first parameter; nevertheless we check for them explicitly
5437 ;; in order to be signaled if a new primitive appears. This
5438 ;; scenario is needed because there isn't a way to decide by
5439 ;; syntactical means whether a foreign method must be called. It would
5440 ;; ease the life if `file-name-handler-alist' would support a decision
5441 ;; function as well but regexp only.
5442 (defun tramp-file-name-for-operation (operation &rest args)
5443 "Return file name related to OPERATION file primitive.
5444 ARGS are the arguments OPERATION has been called with."
5445 (cond
5446 ;; FILE resp DIRECTORY.
5447 ((member operation
5448 (list 'access-file 'byte-compiler-base-file-name 'delete-directory
5449 'delete-file 'diff-latest-backup-file 'directory-file-name
5450 'directory-files 'directory-files-and-attributes
5451 'dired-compress-file 'dired-uncache
5452 'file-accessible-directory-p 'file-attributes
5453 'file-directory-p 'file-executable-p 'file-exists-p
5454 'file-local-copy 'file-remote-p 'file-modes
5455 'file-name-as-directory 'file-name-directory
5456 'file-name-nondirectory 'file-name-sans-versions
5457 'file-ownership-preserved-p 'file-readable-p
5458 'file-regular-p 'file-symlink-p 'file-truename
5459 'file-writable-p 'find-backup-file-name 'find-file-noselect
5460 'get-file-buffer 'insert-directory 'insert-file-contents
5461 'load 'make-directory 'make-directory-internal
5462 'set-file-modes 'substitute-in-file-name
5463 'unhandled-file-name-directory 'vc-registered
5464 ;; Emacs 22+ only.
5465 'set-file-times
5466 ;; Emacs 24+ only.
5467 'file-selinux-context 'set-file-selinux-context
5468 ;; XEmacs only.
5469 'abbreviate-file-name 'create-file-buffer
5470 'dired-file-modtime 'dired-make-compressed-filename
5471 'dired-recursive-delete-directory 'dired-set-file-modtime
5472 'dired-shell-unhandle-file-name 'dired-uucode-file
5473 'insert-file-contents-literally 'make-temp-name 'recover-file
5474 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
5475 (if (file-name-absolute-p (nth 0 args))
5476 (nth 0 args)
5477 (expand-file-name (nth 0 args))))
5478 ;; FILE DIRECTORY resp FILE1 FILE2.
5479 ((member operation
5480 (list 'add-name-to-file 'copy-file 'expand-file-name
5481 'file-name-all-completions 'file-name-completion
5482 'file-newer-than-file-p 'make-symbolic-link 'rename-file
5483 ;; Emacs 23+ only.
5484 'copy-directory
5485 ;; XEmacs only.
5486 'dired-make-relative-symlink
5487 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
5488 (save-match-data
5489 (cond
5490 ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
5491 ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
5492 (t (buffer-file-name (current-buffer))))))
5493 ;; START END FILE.
5494 ((eq operation 'write-region)
5495 (nth 2 args))
5496 ;; BUFFER.
5497 ((member operation
5498 (list 'set-visited-file-modtime 'verify-visited-file-modtime
5499 ;; Emacs 22+ only.
5500 'make-auto-save-file-name
5501 ;; XEmacs only.
5502 'backup-buffer))
5503 (buffer-file-name
5504 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
5505 ;; COMMAND.
5506 ((member operation
5507 (list ;; not in Emacs 23+.
5508 'dired-call-process
5509 ;; Emacs only.
5510 'shell-command
5511 ;; Emacs 22+ only.
5512 'process-file
5513 ;; Emacs 23+ only.
5514 'start-file-process
5515 ;; XEmacs only.
5516 'dired-print-file 'dired-shell-call-process
5517 ;; nowhere yet.
5518 'executable-find 'start-process
5519 'call-process 'call-process-region))
5520 default-directory)
5521 ;; Unknown file primitive.
5522 (t (error "unknown file I/O primitive: %s" operation))))
5523
5524 (defun tramp-find-foreign-file-name-handler (filename)
5525 "Return foreign file name handler if exists."
5526 (when (tramp-tramp-file-p filename)
5527 (let ((v (tramp-dissect-file-name filename t))
5528 (handler tramp-foreign-file-name-handler-alist)
5529 elt res)
5530 ;; When we are not fully sure that filename completion is safe,
5531 ;; we should not return a handler.
5532 (when (or (tramp-file-name-method v) (tramp-file-name-user v)
5533 (and (tramp-file-name-host v)
5534 (not (member (tramp-file-name-host v)
5535 (mapcar 'car tramp-methods))))
5536 (not (tramp-completion-mode-p)))
5537 (while handler
5538 (setq elt (car handler)
5539 handler (cdr handler))
5540 (when (funcall (car elt) filename)
5541 (setq handler nil
5542 res (cdr elt))))
5543 res))))
5544
5545 ;; Main function.
5546 ;;;###autoload
5547 (defun tramp-file-name-handler (operation &rest args)
5548 "Invoke Tramp file name handler.
5549 Falls back to normal file name handler if no Tramp file name handler exists."
5550 (if tramp-mode
5551 (save-match-data
5552 (let* ((filename
5553 (tramp-replace-environment-variables
5554 (apply 'tramp-file-name-for-operation operation args)))
5555 (completion (tramp-completion-mode-p))
5556 (foreign (tramp-find-foreign-file-name-handler filename)))
5557 (with-parsed-tramp-file-name filename nil
5558 ;; Call the backend function.
5559 (if foreign
5560 (condition-case err
5561 (apply foreign operation args)
5562 (error
5563 (cond
5564 ;; When we are in completion mode, some failed
5565 ;; operations shall return at least a default
5566 ;; value in order to give the user a chance to
5567 ;; correct the file name in the minibuffer.
5568 ((and completion (zerop (length localname))
5569 (memq operation '(file-exists-p file-directory-p)))
5570 t)
5571 ((and completion (zerop (length localname))
5572 (memq operation
5573 '(expand-file-name file-name-as-directory)))
5574 filename)
5575 ;; Propagate the error.
5576 (t (signal (car err) (cdr err))))))
5577 ;; Nothing to do for us.
5578 (tramp-run-real-handler operation args)))))
5579
5580 ;; When `tramp-mode' is not enabled, we don't do anything.
5581 (tramp-run-real-handler operation args)))
5582
5583 ;; In Emacs, there is some concurrency due to timers. If a timer
5584 ;; interrupts Tramp and wishes to use the same connection buffer as
5585 ;; the "main" Emacs, then garbage might occur in the connection
5586 ;; buffer. Therefore, we need to make sure that a timer does not use
5587 ;; the same connection buffer as the "main" Emacs. We implement a
5588 ;; cheap global lock, instead of locking each connection buffer
5589 ;; separately. The global lock is based on two variables,
5590 ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
5591 ;; (with setq) to indicate a lock. But Tramp also calls itself during
5592 ;; processing of a single file operation, so we need to allow
5593 ;; recursive calls. That's where the `tramp-locker' variable comes in
5594 ;; -- it is let-bound to t during the execution of the current
5595 ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
5596 ;; then we should just proceed because we have been called
5597 ;; recursively. But if `tramp-locker' is nil, then we are a timer
5598 ;; interrupting the "main" Emacs, and then we signal an error.
5599
5600 (defvar tramp-locked nil
5601 "If non-nil, then Tramp is currently busy.
5602 Together with `tramp-locker', this implements a locking mechanism
5603 preventing reentrant calls of Tramp.")
5604
5605 (defvar tramp-locker nil
5606 "If non-nil, then a caller has locked Tramp.
5607 Together with `tramp-locked', this implements a locking mechanism
5608 preventing reentrant calls of Tramp.")
5609
5610 (defun tramp-sh-file-name-handler (operation &rest args)
5611 "Invoke remote-shell Tramp file name handler.
5612 Fall back to normal file name handler if no Tramp handler exists."
5613 (when (and tramp-locked (not tramp-locker))
5614 (setq tramp-locked nil)
5615 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
5616 (let ((tl tramp-locked))
5617 (unwind-protect
5618 (progn
5619 (setq tramp-locked t)
5620 (let ((tramp-locker t))
5621 (save-match-data
5622 (let ((fn (assoc operation tramp-file-name-handler-alist)))
5623 (if fn
5624 (apply (cdr fn) args)
5625 (tramp-run-real-handler operation args))))))
5626 (setq tramp-locked tl))))
5627
5628 (defun tramp-vc-file-name-handler (operation &rest args)
5629 "Invoke special file name handler, which collects files to be handled."
5630 (save-match-data
5631 (let ((filename
5632 (tramp-replace-environment-variables
5633 (apply 'tramp-file-name-for-operation operation args)))
5634 (fn (assoc operation tramp-file-name-handler-alist)))
5635 (with-parsed-tramp-file-name filename nil
5636 (cond
5637 ;; That's what we want: file names, for which checks are
5638 ;; applied. We assume, that VC uses only `file-exists-p' and
5639 ;; `file-readable-p' checks; otherwise we must extend the
5640 ;; list. We do not perform any action, but return nil, in
5641 ;; order to keep `vc-registered' running.
5642 ((and fn (memq operation '(file-exists-p file-readable-p)))
5643 (add-to-list 'tramp-vc-registered-file-names localname 'append)
5644 nil)
5645 ;; Tramp file name handlers like `expand-file-name'. They
5646 ;; must still work.
5647 (fn
5648 (save-match-data (apply (cdr fn) args)))
5649 ;; Default file name handlers, we don't care.
5650 (t (tramp-run-real-handler operation args)))))))
5651
5652 ;;;###autoload
5653 (progn (defun tramp-completion-file-name-handler (operation &rest args)
5654 "Invoke Tramp file name completion handler.
5655 Falls back to normal file name handler if no Tramp file name handler exists."
5656 ;; We bind `directory-sep-char' here for XEmacs on Windows, which
5657 ;; would otherwise use backslash.
5658 (let ((directory-sep-char ?/)
5659 (fn (assoc operation tramp-completion-file-name-handler-alist)))
5660 (if (and
5661 ;; When `tramp-mode' is not enabled, we don't do anything.
5662 fn tramp-mode
5663 ;; For other syntaxes than `sep', the regexp matches many common
5664 ;; situations where the user doesn't actually want to use Tramp.
5665 ;; So to avoid autoloading Tramp after typing just "/s", we
5666 ;; disable this part of the completion, unless the user implicitly
5667 ;; indicated his interest in using a fancier completion system.
5668 (or (eq tramp-syntax 'sep)
5669 (featurep 'tramp) ;; If it's loaded, we may as well use it.
5670 ;; `partial-completion-mode' does not exist in XEmacs.
5671 ;; It is obsoleted with Emacs 24.1.
5672 (and (boundp 'partial-completion-mode)
5673 (symbol-value 'partial-completion-mode))
5674 ;; FIXME: These may have been loaded even if the user never
5675 ;; intended to use them.
5676 (featurep 'ido)
5677 (featurep 'icicles)))
5678 (save-match-data (apply (cdr fn) args))
5679 (tramp-completion-run-real-handler operation args)))))
5680
5681 ;;;###autoload
5682 (progn (defun tramp-register-file-name-handlers ()
5683 "Add Tramp file name handlers to `file-name-handler-alist'."
5684 ;; Remove autoloaded handlers from file name handler alist. Useful,
5685 ;; if `tramp-syntax' has been changed.
5686 (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
5687 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
5688 (let ((a1 (rassq
5689 'tramp-completion-file-name-handler file-name-handler-alist)))
5690 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
5691 ;; Add the handlers.
5692 (add-to-list 'file-name-handler-alist
5693 (cons tramp-file-name-regexp 'tramp-file-name-handler))
5694 (put 'tramp-file-name-handler 'safe-magic t)
5695 (add-to-list 'file-name-handler-alist
5696 (cons tramp-completion-file-name-regexp
5697 'tramp-completion-file-name-handler))
5698 (put 'tramp-completion-file-name-handler 'safe-magic t)
5699 ;; If jka-compr or epa-file are already loaded, move them to the
5700 ;; front of `file-name-handler-alist'.
5701 (dolist (fnh '(epa-file-handler jka-compr-handler))
5702 (let ((entry (rassoc fnh file-name-handler-alist)))
5703 (when entry
5704 (setq file-name-handler-alist
5705 (cons entry (delete entry file-name-handler-alist))))))))
5706
5707 ;; `tramp-file-name-handler' must be registered before evaluation of
5708 ;; site-start and init files, because there might exist remote files
5709 ;; already, f.e. files kept via recentf-mode.
5710 ;;;###autoload(tramp-register-file-name-handlers)
5711 (tramp-register-file-name-handlers)
5712
5713 ;;;###autoload
5714 (defun tramp-unload-file-name-handlers ()
5715 (setq file-name-handler-alist
5716 (delete (rassoc 'tramp-file-name-handler
5717 file-name-handler-alist)
5718 (delete (rassoc 'tramp-completion-file-name-handler
5719 file-name-handler-alist)
5720 file-name-handler-alist))))
5721
5722 (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
5723
5724 ;;; File name handler functions for completion mode:
5725
5726 (defvar tramp-completion-mode nil
5727 "If non-nil, external packages signal that they are in file name completion.
5728
5729 This is necessary, because Tramp uses a heuristic depending on last
5730 input event. This fails when external packages use other characters
5731 but <TAB>, <SPACE> or ?\\? for file name completion. This variable
5732 should never be set globally, the intention is to let-bind it.")
5733
5734 ;; Necessary because `tramp-file-name-regexp-unified' and
5735 ;; `tramp-completion-file-name-regexp-unified' aren't different. If
5736 ;; nil, `tramp-completion-run-real-handler' is called (i.e. forwarding
5737 ;; to `tramp-file-name-handler'). Otherwise, it takes
5738 ;; `tramp-run-real-handler'. Using `last-input-event' is a little bit
5739 ;; risky, because completing a file might require loading other files,
5740 ;; like "~/.netrc", and for them it shouldn't be decided based on that
5741 ;; variable. On the other hand, those files shouldn't have partial
5742 ;; Tramp file name syntax. Maybe another variable should be introduced
5743 ;; overwriting this check in such cases. Or we change Tramp file name
5744 ;; syntax in order to avoid ambiguities, like in XEmacs ...
5745 (defun tramp-completion-mode-p ()
5746 "Check, whether method / user name / host name completion is active."
5747 (or
5748 ;; Signal from outside. `non-essential' has been introduced in Emacs 24.
5749 (and (boundp 'non-essential) (symbol-value 'non-essential))
5750 tramp-completion-mode
5751 ;; Emacs.
5752 (equal last-input-event 'tab)
5753 (and (natnump last-input-event)
5754 (or
5755 ;; ?\t has event-modifier 'control.
5756 (equal last-input-event ?\t)
5757 (and (not (event-modifiers last-input-event))
5758 (or (equal last-input-event ?\?)
5759 (equal last-input-event ?\ )))))
5760 ;; XEmacs.
5761 (and (featurep 'xemacs)
5762 ;; `last-input-event' might be nil.
5763 (not (null last-input-event))
5764 ;; `last-input-event' may have no character approximation.
5765 (tramp-compat-funcall 'event-to-character last-input-event)
5766 (or
5767 ;; ?\t has event-modifier 'control.
5768 (equal
5769 (tramp-compat-funcall 'event-to-character last-input-event) ?\t)
5770 (and (not (event-modifiers last-input-event))
5771 (or (equal
5772 (tramp-compat-funcall 'event-to-character last-input-event)
5773 ?\?)
5774 (equal
5775 (tramp-compat-funcall 'event-to-character last-input-event)
5776 ?\ )))))))
5777
5778 (defun tramp-connectable-p (filename)
5779 "Check, whether it is possible to connect the remote host w/o side-effects.
5780 This is true, if either the remote host is already connected, or if we are
5781 not in completion mode."
5782 (and (tramp-tramp-file-p filename)
5783 (with-parsed-tramp-file-name filename nil
5784 (or (get-buffer (tramp-buffer-name v))
5785 (not (tramp-completion-mode-p))))))
5786
5787 ;; Method, host name and user name completion.
5788 ;; `tramp-completion-dissect-file-name' returns a list of
5789 ;; tramp-file-name structures. For all of them we return possible completions.
5790 ;;;###autoload
5791 (defun tramp-completion-handle-file-name-all-completions (filename directory)
5792 "Like `file-name-all-completions' for partial Tramp files."
5793
5794 (let* ((fullname (tramp-drop-volume-letter
5795 (expand-file-name filename directory)))
5796 ;; Possible completion structures.
5797 (v (tramp-completion-dissect-file-name fullname))
5798 result result1)
5799
5800 (while v
5801 (let* ((car (car v))
5802 (method (tramp-file-name-method car))
5803 (user (tramp-file-name-user car))
5804 (host (tramp-file-name-host car))
5805 (localname (tramp-file-name-localname car))
5806 (m (tramp-find-method method user host))
5807 (tramp-current-user user) ; see `tramp-parse-passwd'
5808 all-user-hosts)
5809
5810 (unless localname ;; Nothing to complete.
5811
5812 (if (or user host)
5813
5814 ;; Method dependent user / host combinations.
5815 (progn
5816 (mapc
5817 (lambda (x)
5818 (setq all-user-hosts
5819 (append all-user-hosts
5820 (funcall (nth 0 x) (nth 1 x)))))
5821 (tramp-get-completion-function m))
5822
5823 (setq result
5824 (append result
5825 (mapcar
5826 (lambda (x)
5827 (tramp-get-completion-user-host
5828 method user host (nth 0 x) (nth 1 x)))
5829 (delq nil all-user-hosts)))))
5830
5831 ;; Possible methods.
5832 (setq result
5833 (append result (tramp-get-completion-methods m)))))
5834
5835 (setq v (cdr v))))
5836
5837 ;; Unify list, remove nil elements.
5838 (while result
5839 (let ((car (car result)))
5840 (when car
5841 (add-to-list
5842 'result1
5843 (substring car (length (tramp-drop-volume-letter directory)))))
5844 (setq result (cdr result))))
5845
5846 ;; Complete local parts.
5847 (append
5848 result1
5849 (condition-case nil
5850 (apply (if (tramp-connectable-p fullname)
5851 'tramp-completion-run-real-handler
5852 'tramp-run-real-handler)
5853 'file-name-all-completions (list (list filename directory)))
5854 (error nil)))))
5855
5856 ;; Method, host name and user name completion for a file.
5857 ;;;###autoload
5858 (defun tramp-completion-handle-file-name-completion
5859 (filename directory &optional predicate)
5860 "Like `file-name-completion' for Tramp files."
5861 (try-completion
5862 filename
5863 (mapcar 'list (file-name-all-completions filename directory))
5864 (when (and predicate
5865 (tramp-connectable-p (expand-file-name filename directory)))
5866 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
5867
5868 ;; I misuse a little bit the tramp-file-name structure in order to handle
5869 ;; completion possibilities for partial methods / user names / host names.
5870 ;; Return value is a list of tramp-file-name structures according to possible
5871 ;; completions. If "localname" is non-nil it means there
5872 ;; shouldn't be a completion anymore.
5873
5874 ;; Expected results:
5875
5876 ;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
5877 ;; [nil nil "x" nil] [nil "x" nil nil] [nil "x" "y" nil]
5878 ;; [nil "x" nil nil]
5879 ;; ["x" nil nil nil]
5880
5881 ;; "/x:" "/x:y" "/x:y:"
5882 ;; [nil nil "x" ""] [nil nil "x" "y"] ["x" nil "y" ""]
5883 ;; "/[x/" "/[x/y"
5884 ;; ["x" nil "" nil] ["x" nil "y" nil]
5885 ;; ["x" "" nil nil] ["x" "y" nil nil]
5886
5887 ;; "/x:y@" "/x:y@z" "/x:y@z:"
5888 ;; [nil nil "x" "y@"] [nil nil "x" "y@z"] ["x" "y" "z" ""]
5889 ;; "/[x/y@" "/[x/y@z"
5890 ;; ["x" nil "y" nil] ["x" "y" "z" nil]
5891 (defun tramp-completion-dissect-file-name (name)
5892 "Returns a list of `tramp-file-name' structures.
5893 They are collected by `tramp-completion-dissect-file-name1'."
5894
5895 (let* ((result)
5896 (x-nil "\\|\\(\\)")
5897 (tramp-completion-ipv6-regexp
5898 (format
5899 "[^%s]*"
5900 (if (zerop (length tramp-postfix-ipv6-format))
5901 tramp-postfix-host-format
5902 tramp-postfix-ipv6-format)))
5903 ;; "/method" "/[method"
5904 (tramp-completion-file-name-structure1
5905 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
5906 1 nil nil nil))
5907 ;; "/user" "/[user"
5908 (tramp-completion-file-name-structure2
5909 (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$")
5910 nil 1 nil nil))
5911 ;; "/host" "/[host"
5912 (tramp-completion-file-name-structure3
5913 (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$")
5914 nil nil 1 nil))
5915 ;; "/[ipv6" "/[ipv6"
5916 (tramp-completion-file-name-structure4
5917 (list (concat tramp-prefix-regexp
5918 tramp-prefix-ipv6-regexp
5919 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5920 nil nil 1 nil))
5921 ;; "/user@host" "/[user@host"
5922 (tramp-completion-file-name-structure5
5923 (list (concat tramp-prefix-regexp
5924 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5925 "\\(" tramp-host-regexp x-nil "\\)$")
5926 nil 1 2 nil))
5927 ;; "/user@[ipv6" "/[user@ipv6"
5928 (tramp-completion-file-name-structure6
5929 (list (concat tramp-prefix-regexp
5930 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5931 tramp-prefix-ipv6-regexp
5932 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5933 nil 1 2 nil))
5934 ;; "/method:user" "/[method/user" "/method://user"
5935 (tramp-completion-file-name-structure7
5936 (list (concat tramp-prefix-regexp
5937 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5938 "\\(" tramp-user-regexp x-nil "\\)$")
5939 1 2 nil nil))
5940 ;; "/method:host" "/[method/host" "/method://host"
5941 (tramp-completion-file-name-structure8
5942 (list (concat tramp-prefix-regexp
5943 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5944 "\\(" tramp-host-regexp x-nil "\\)$")
5945 1 nil 2 nil))
5946 ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
5947 (tramp-completion-file-name-structure9
5948 (list (concat tramp-prefix-regexp
5949 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5950 tramp-prefix-ipv6-regexp
5951 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5952 1 nil 2 nil))
5953 ;; "/method:user@host" "/[method/user@host" "/method://user@host"
5954 (tramp-completion-file-name-structure10
5955 (list (concat tramp-prefix-regexp
5956 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5957 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5958 "\\(" tramp-host-regexp x-nil "\\)$")
5959 1 2 3 nil))
5960 ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
5961 (tramp-completion-file-name-structure11
5962 (list (concat tramp-prefix-regexp
5963 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5964 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5965 tramp-prefix-ipv6-regexp
5966 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5967 1 2 3 nil))
5968 ;; "/method: "/method:/"
5969 (tramp-completion-file-name-structure12
5970 (list
5971 (if (equal tramp-syntax 'url)
5972 (concat tramp-prefix-regexp
5973 "\\(" tramp-method-regexp "\\)"
5974 "\\(" (substring tramp-postfix-method-regexp 0 1)
5975 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
5976 "\\(" "\\)$")
5977 ;; Should not match if not URL syntax.
5978 (concat tramp-prefix-regexp "/$"))
5979 1 3 nil nil))
5980 ;; "/method: "/method:/"
5981 (tramp-completion-file-name-structure13
5982 (list
5983 (if (equal tramp-syntax 'url)
5984 (concat tramp-prefix-regexp
5985 "\\(" tramp-method-regexp "\\)"
5986 "\\(" (substring tramp-postfix-method-regexp 0 1)
5987 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
5988 "\\(" "\\)$")
5989 ;; Should not match if not URL syntax.
5990 (concat tramp-prefix-regexp "/$"))
5991 1 nil 3 nil)))
5992
5993 (mapc (lambda (regexp)
5994 (add-to-list 'result
5995 (tramp-completion-dissect-file-name1 regexp name)))
5996 (list
5997 tramp-completion-file-name-structure1
5998 tramp-completion-file-name-structure2
5999 tramp-completion-file-name-structure3
6000 tramp-completion-file-name-structure4
6001 tramp-completion-file-name-structure5
6002 tramp-completion-file-name-structure6
6003 tramp-completion-file-name-structure7
6004 tramp-completion-file-name-structure8
6005 tramp-completion-file-name-structure9
6006 tramp-completion-file-name-structure10
6007 tramp-completion-file-name-structure11
6008 tramp-completion-file-name-structure12
6009 tramp-completion-file-name-structure13
6010 tramp-file-name-structure))
6011
6012 (delq nil result)))
6013
6014 (defun tramp-completion-dissect-file-name1 (structure name)
6015 "Returns a `tramp-file-name' structure matching STRUCTURE.
6016 The structure consists of remote method, remote user,
6017 remote host and localname (filename on remote host)."
6018
6019 (save-match-data
6020 (when (string-match (nth 0 structure) name)
6021 (let ((method (and (nth 1 structure)
6022 (match-string (nth 1 structure) name)))
6023 (user (and (nth 2 structure)
6024 (match-string (nth 2 structure) name)))
6025 (host (and (nth 3 structure)
6026 (match-string (nth 3 structure) name)))
6027 (localname (and (nth 4 structure)
6028 (match-string (nth 4 structure) name))))
6029 (vector method user host localname)))))
6030
6031 ;; This function returns all possible method completions, adding the
6032 ;; trailing method delimeter.
6033 (defun tramp-get-completion-methods (partial-method)
6034 "Returns all method completions for PARTIAL-METHOD."
6035 (mapcar
6036 (lambda (method)
6037 (and method
6038 (string-match (concat "^" (regexp-quote partial-method)) method)
6039 (tramp-completion-make-tramp-file-name method nil nil nil)))
6040 (mapcar 'car tramp-methods)))
6041
6042 ;; Compares partial user and host names with possible completions.
6043 (defun tramp-get-completion-user-host (method partial-user partial-host user host)
6044 "Returns the most expanded string for user and host name completion.
6045 PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
6046 (cond
6047
6048 ((and partial-user partial-host)
6049 (if (and host
6050 (string-match (concat "^" (regexp-quote partial-host)) host)
6051 (string-equal partial-user (or user partial-user)))
6052 (setq user partial-user)
6053 (setq user nil
6054 host nil)))
6055
6056 (partial-user
6057 (setq host nil)
6058 (unless
6059 (and user (string-match (concat "^" (regexp-quote partial-user)) user))
6060 (setq user nil)))
6061
6062 (partial-host
6063 (setq user nil)
6064 (unless
6065 (and host (string-match (concat "^" (regexp-quote partial-host)) host))
6066 (setq host nil)))
6067
6068 (t (setq user nil
6069 host nil)))
6070
6071 (unless (zerop (+ (length user) (length host)))
6072 (tramp-completion-make-tramp-file-name method user host nil)))
6073
6074 (defun tramp-parse-rhosts (filename)
6075 "Return a list of (user host) tuples allowed to access.
6076 Either user or host may be nil."
6077 ;; On Windows, there are problems in completion when
6078 ;; `default-directory' is remote.
6079 (let ((default-directory (tramp-compat-temporary-file-directory))
6080 res)
6081 (when (file-readable-p filename)
6082 (with-temp-buffer
6083 (insert-file-contents filename)
6084 (goto-char (point-min))
6085 (while (not (eobp))
6086 (push (tramp-parse-rhosts-group) res))))
6087 res))
6088
6089 (defun tramp-parse-rhosts-group ()
6090 "Return a (user host) tuple allowed to access.
6091 Either user or host may be nil."
6092 (let ((result)
6093 (regexp
6094 (concat
6095 "^\\(" tramp-host-regexp "\\)"
6096 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
6097 (narrow-to-region (point) (tramp-compat-line-end-position))
6098 (when (re-search-forward regexp nil t)
6099 (setq result (append (list (match-string 3) (match-string 1)))))
6100 (widen)
6101 (forward-line 1)
6102 result))
6103
6104 (defun tramp-parse-shosts (filename)
6105 "Return a list of (user host) tuples allowed to access.
6106 User is always nil."
6107 ;; On Windows, there are problems in completion when
6108 ;; `default-directory' is remote.
6109 (let ((default-directory (tramp-compat-temporary-file-directory))
6110 res)
6111 (when (file-readable-p filename)
6112 (with-temp-buffer
6113 (insert-file-contents filename)
6114 (goto-char (point-min))
6115 (while (not (eobp))
6116 (push (tramp-parse-shosts-group) res))))
6117 res))
6118
6119 (defun tramp-parse-shosts-group ()
6120 "Return a (user host) tuple allowed to access.
6121 User is always nil."
6122 (let ((result)
6123 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
6124 (narrow-to-region (point) (tramp-compat-line-end-position))
6125 (when (re-search-forward regexp nil t)
6126 (setq result (list nil (match-string 1))))
6127 (widen)
6128 (or
6129 (> (skip-chars-forward ",") 0)
6130 (forward-line 1))
6131 result))
6132
6133 (defun tramp-parse-sconfig (filename)
6134 "Return a list of (user host) tuples allowed to access.
6135 User is always nil."
6136 ;; On Windows, there are problems in completion when
6137 ;; `default-directory' is remote.
6138 (let ((default-directory (tramp-compat-temporary-file-directory))
6139 res)
6140 (when (file-readable-p filename)
6141 (with-temp-buffer
6142 (insert-file-contents filename)
6143 (goto-char (point-min))
6144 (while (not (eobp))
6145 (push (tramp-parse-sconfig-group) res))))
6146 res))
6147
6148 (defun tramp-parse-sconfig-group ()
6149 "Return a (user host) tuple allowed to access.
6150 User is always nil."
6151 (let ((result)
6152 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
6153 (narrow-to-region (point) (tramp-compat-line-end-position))
6154 (when (re-search-forward regexp nil t)
6155 (setq result (list nil (match-string 1))))
6156 (widen)
6157 (or
6158 (> (skip-chars-forward ",") 0)
6159 (forward-line 1))
6160 result))
6161
6162 (defun tramp-parse-shostkeys (dirname)
6163 "Return a list of (user host) tuples allowed to access.
6164 User is always nil."
6165 ;; On Windows, there are problems in completion when
6166 ;; `default-directory' is remote.
6167 (let* ((default-directory (tramp-compat-temporary-file-directory))
6168 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
6169 (files (when (file-directory-p dirname) (directory-files dirname)))
6170 result)
6171 (while files
6172 (when (string-match regexp (car files))
6173 (push (list nil (match-string 1 (car files))) result))
6174 (setq files (cdr files)))
6175 result))
6176
6177 (defun tramp-parse-sknownhosts (dirname)
6178 "Return a list of (user host) tuples allowed to access.
6179 User is always nil."
6180 ;; On Windows, there are problems in completion when
6181 ;; `default-directory' is remote.
6182 (let* ((default-directory (tramp-compat-temporary-file-directory))
6183 (regexp (concat "^\\(" tramp-host-regexp
6184 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
6185 (files (when (file-directory-p dirname) (directory-files dirname)))
6186 result)
6187 (while files
6188 (when (string-match regexp (car files))
6189 (push (list nil (match-string 1 (car files))) result))
6190 (setq files (cdr files)))
6191 result))
6192
6193 (defun tramp-parse-hosts (filename)
6194 "Return a list of (user host) tuples allowed to access.
6195 User is always nil."
6196 ;; On Windows, there are problems in completion when
6197 ;; `default-directory' is remote.
6198 (let ((default-directory (tramp-compat-temporary-file-directory))
6199 res)
6200 (when (file-readable-p filename)
6201 (with-temp-buffer
6202 (insert-file-contents filename)
6203 (goto-char (point-min))
6204 (while (not (eobp))
6205 (push (tramp-parse-hosts-group) res))))
6206 res))
6207
6208 (defun tramp-parse-hosts-group ()
6209 "Return a (user host) tuple allowed to access.
6210 User is always nil."
6211 (let ((result)
6212 (regexp
6213 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
6214 (narrow-to-region (point) (tramp-compat-line-end-position))
6215 (when (re-search-forward regexp nil t)
6216 (setq result (list nil (match-string 1))))
6217 (widen)
6218 (or
6219 (> (skip-chars-forward " \t") 0)
6220 (forward-line 1))
6221 result))
6222
6223 ;; For su-alike methods it would be desirable to return "root@localhost"
6224 ;; as default. Unfortunately, we have no information whether any user name
6225 ;; has been typed already. So we use `tramp-current-user' as indication,
6226 ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
6227 (defun tramp-parse-passwd (filename)
6228 "Return a list of (user host) tuples allowed to access.
6229 Host is always \"localhost\"."
6230 ;; On Windows, there are problems in completion when
6231 ;; `default-directory' is remote.
6232 (let ((default-directory (tramp-compat-temporary-file-directory))
6233 res)
6234 (if (zerop (length tramp-current-user))
6235 '(("root" nil))
6236 (when (file-readable-p filename)
6237 (with-temp-buffer
6238 (insert-file-contents filename)
6239 (goto-char (point-min))
6240 (while (not (eobp))
6241 (push (tramp-parse-passwd-group) res))))
6242 res)))
6243
6244 (defun tramp-parse-passwd-group ()
6245 "Return a (user host) tuple allowed to access.
6246 Host is always \"localhost\"."
6247 (let ((result)
6248 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
6249 (narrow-to-region (point) (tramp-compat-line-end-position))
6250 (when (re-search-forward regexp nil t)
6251 (setq result (list (match-string 1) "localhost")))
6252 (widen)
6253 (forward-line 1)
6254 result))
6255
6256 (defun tramp-parse-netrc (filename)
6257 "Return a list of (user host) tuples allowed to access.
6258 User may be nil."
6259 ;; On Windows, there are problems in completion when
6260 ;; `default-directory' is remote.
6261 (let ((default-directory (tramp-compat-temporary-file-directory))
6262 res)
6263 (when (file-readable-p filename)
6264 (with-temp-buffer
6265 (insert-file-contents filename)
6266 (goto-char (point-min))
6267 (while (not (eobp))
6268 (push (tramp-parse-netrc-group) res))))
6269 res))
6270
6271 (defun tramp-parse-netrc-group ()
6272 "Return a (user host) tuple allowed to access.
6273 User may be nil."
6274 (let ((result)
6275 (regexp
6276 (concat
6277 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
6278 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
6279 (narrow-to-region (point) (tramp-compat-line-end-position))
6280 (when (re-search-forward regexp nil t)
6281 (setq result (list (match-string 3) (match-string 1))))
6282 (widen)
6283 (forward-line 1)
6284 result))
6285
6286 (defun tramp-parse-putty (registry)
6287 "Return a list of (user host) tuples allowed to access.
6288 User is always nil."
6289 ;; On Windows, there are problems in completion when
6290 ;; `default-directory' is remote.
6291 (let ((default-directory (tramp-compat-temporary-file-directory))
6292 res)
6293 (with-temp-buffer
6294 (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
6295 (goto-char (point-min))
6296 (while (not (eobp))
6297 (push (tramp-parse-putty-group registry) res))))
6298 res))
6299
6300 (defun tramp-parse-putty-group (registry)
6301 "Return a (user host) tuple allowed to access.
6302 User is always nil."
6303 (let ((result)
6304 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
6305 (narrow-to-region (point) (tramp-compat-line-end-position))
6306 (when (re-search-forward regexp nil t)
6307 (setq result (list nil (match-string 1))))
6308 (widen)
6309 (forward-line 1)
6310 result))
6311
6312 ;;; Internal Functions:
6313
6314 (defun tramp-maybe-send-script (vec script name)
6315 "Define in remote shell function NAME implemented as SCRIPT.
6316 Only send the definition if it has not already been done."
6317 (let* ((p (tramp-get-connection-process vec))
6318 (scripts (tramp-get-connection-property p "scripts" nil)))
6319 (unless (member name scripts)
6320 (with-progress-reporter vec 5 (format "Sending script `%s'" name)
6321 ;; The script could contain a call of Perl. This is masked with `%s'.
6322 (tramp-send-command-and-check
6323 vec
6324 (format "%s () {\n%s\n}" name
6325 (format script (tramp-get-remote-perl vec))))
6326 (tramp-set-connection-property p "scripts" (cons name scripts))))))
6327
6328 (defun tramp-set-auto-save ()
6329 (when (and ;; ange-ftp has its own auto-save mechanism
6330 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
6331 'tramp-sh-file-name-handler)
6332 auto-save-default)
6333 (auto-save-mode 1)))
6334 (add-hook 'find-file-hooks 'tramp-set-auto-save t)
6335 (add-hook 'tramp-unload-hook
6336 (lambda ()
6337 (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
6338
6339 (defun tramp-run-test (switch filename)
6340 "Run `test' on the remote system, given a SWITCH and a FILENAME.
6341 Returns the exit code of the `test' program."
6342 (with-parsed-tramp-file-name filename nil
6343 (tramp-send-command-and-check
6344 v
6345 (format
6346 "%s %s %s"
6347 (tramp-get-test-command v)
6348 switch
6349 (tramp-shell-quote-argument localname)))))
6350
6351 (defun tramp-run-test2 (format-string file1 file2)
6352 "Run `test'-like program on the remote system, given FILE1, FILE2.
6353 FORMAT-STRING contains the program name, switches, and place holders.
6354 Returns the exit code of the `test' program. Barfs if the methods,
6355 hosts, or files, disagree."
6356 (unless (tramp-equal-remote file1 file2)
6357 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
6358 (tramp-error
6359 v 'file-error
6360 "tramp-run-test2 only implemented for same method, user, host")))
6361 (with-parsed-tramp-file-name file1 v1
6362 (with-parsed-tramp-file-name file1 v2
6363 (tramp-send-command-and-check
6364 v1
6365 (format format-string
6366 (tramp-shell-quote-argument v1-localname)
6367 (tramp-shell-quote-argument v2-localname))))))
6368
6369 (defun tramp-buffer-name (vec)
6370 "A name for the connection buffer VEC."
6371 ;; We must use `tramp-file-name-real-host', because for gateway
6372 ;; methods the default port will be expanded later on, which would
6373 ;; tamper the name.
6374 (let ((method (tramp-file-name-method vec))
6375 (user (tramp-file-name-user vec))
6376 (host (tramp-file-name-real-host vec)))
6377 (if (not (zerop (length user)))
6378 (format "*tramp/%s %s@%s*" method user host)
6379 (format "*tramp/%s %s*" method host))))
6380
6381 (defun tramp-delete-temp-file-function ()
6382 "Remove temporary files related to current buffer."
6383 (when (stringp tramp-temp-buffer-file-name)
6384 (condition-case nil
6385 (delete-file tramp-temp-buffer-file-name)
6386 (error nil))))
6387
6388 (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
6389 (add-hook 'tramp-cache-unload-hook
6390 (lambda ()
6391 (remove-hook 'kill-buffer-hook
6392 'tramp-delete-temp-file-function)))
6393
6394 (defun tramp-get-buffer (vec)
6395 "Get the connection buffer to be used for VEC."
6396 (or (get-buffer (tramp-buffer-name vec))
6397 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
6398 (setq buffer-undo-list t)
6399 (setq default-directory
6400 (tramp-make-tramp-file-name
6401 (tramp-file-name-method vec)
6402 (tramp-file-name-user vec)
6403 (tramp-file-name-host vec)
6404 "/"))
6405 (current-buffer))))
6406
6407 (defun tramp-get-connection-buffer (vec)
6408 "Get the connection buffer to be used for VEC.
6409 In case a second asynchronous communication has been started, it is different
6410 from `tramp-get-buffer'."
6411 (or (tramp-get-connection-property vec "process-buffer" nil)
6412 (tramp-get-buffer vec)))
6413
6414 (defun tramp-get-connection-process (vec)
6415 "Get the connection process to be used for VEC.
6416 In case a second asynchronous communication has been started, it is different
6417 from the default one."
6418 (get-process
6419 (or (tramp-get-connection-property vec "process-name" nil)
6420 (tramp-buffer-name vec))))
6421
6422 (defun tramp-debug-buffer-name (vec)
6423 "A name for the debug buffer for VEC."
6424 ;; We must use `tramp-file-name-real-host', because for gateway
6425 ;; methods the default port will be expanded later on, which would
6426 ;; tamper the name.
6427 (let ((method (tramp-file-name-method vec))
6428 (user (tramp-file-name-user vec))
6429 (host (tramp-file-name-real-host vec)))
6430 (if (not (zerop (length user)))
6431 (format "*debug tramp/%s %s@%s*" method user host)
6432 (format "*debug tramp/%s %s*" method host))))
6433
6434 (defconst tramp-debug-outline-regexp
6435 "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
6436
6437 (defun tramp-get-debug-buffer (vec)
6438 "Get the debug buffer for VEC."
6439 (with-current-buffer
6440 (get-buffer-create (tramp-debug-buffer-name vec))
6441 (when (bobp)
6442 (setq buffer-undo-list t)
6443 ;; Activate `outline-mode'. This runs `text-mode-hook' and
6444 ;; `outline-mode-hook'. We must prevent that local processes
6445 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
6446 ;; Furthermore, `outline-regexp' must have the correct value
6447 ;; already, because it is used by `font-lock-compile-keywords'.
6448 (let ((default-directory (tramp-compat-temporary-file-directory))
6449 (outline-regexp tramp-debug-outline-regexp))
6450 (outline-mode))
6451 (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
6452 (set (make-local-variable 'outline-level) 'tramp-outline-level))
6453 (current-buffer)))
6454
6455 (defun tramp-outline-level ()
6456 "Return the depth to which a statement is nested in the outline.
6457 Point must be at the beginning of a header line.
6458
6459 The outline level is equal to the verbosity of the Tramp message."
6460 (1+ (string-to-number (match-string 1))))
6461
6462 (defun tramp-find-executable
6463 (vec progname dirlist &optional ignore-tilde ignore-path)
6464 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
6465 First arg VEC specifies the connection, PROGNAME is the program
6466 to search for, and DIRLIST gives the list of directories to
6467 search. If IGNORE-TILDE is non-nil, directory names starting
6468 with `~' will be ignored. If IGNORE-PATH is non-nil, searches
6469 only in DIRLIST.
6470
6471 Returns the absolute file name of PROGNAME, if found, and nil otherwise.
6472
6473 This function expects to be in the right *tramp* buffer."
6474 (with-current-buffer (tramp-get-connection-buffer vec)
6475 (let (result)
6476 ;; Check whether the executable is in $PATH. "which(1)" does not
6477 ;; report always a correct error code; therefore we check the
6478 ;; number of words it returns.
6479 (unless ignore-path
6480 (tramp-send-command vec (format "which \\%s | wc -w" progname))
6481 (goto-char (point-min))
6482 (if (looking-at "^\\s-*1$")
6483 (setq result (concat "\\" progname))))
6484 (unless result
6485 (when ignore-tilde
6486 ;; Remove all ~/foo directories from dirlist. In XEmacs,
6487 ;; `remove' is in CL, and we want to avoid CL dependencies.
6488 (let (newdl d)
6489 (while dirlist
6490 (setq d (car dirlist))
6491 (setq dirlist (cdr dirlist))
6492 (unless (char-equal ?~ (aref d 0))
6493 (setq newdl (cons d newdl))))
6494 (setq dirlist (nreverse newdl))))
6495 (tramp-send-command
6496 vec
6497 (format (concat "while read d; "
6498 "do if test -x $d/%s -a -f $d/%s; "
6499 "then echo tramp_executable $d/%s; "
6500 "break; fi; done <<'EOF'\n"
6501 "%s\nEOF")
6502 progname progname progname (mapconcat 'identity dirlist "\n")))
6503 (goto-char (point-max))
6504 (when (search-backward "tramp_executable " nil t)
6505 (skip-chars-forward "^ ")
6506 (skip-chars-forward " ")
6507 (setq result (buffer-substring
6508 (point) (tramp-compat-line-end-position)))))
6509 result)))
6510
6511 (defun tramp-set-remote-path (vec)
6512 "Sets the remote environment PATH to existing directories.
6513 I.e., for each directory in `tramp-remote-path', it is tested
6514 whether it exists and if so, it is added to the environment
6515 variable PATH."
6516 (tramp-message vec 5 (format "Setting $PATH environment variable"))
6517 (tramp-send-command
6518 vec (format "PATH=%s; export PATH"
6519 (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
6520
6521 ;; ------------------------------------------------------------
6522 ;; -- Communication with external shell --
6523 ;; ------------------------------------------------------------
6524
6525 (defun tramp-find-file-exists-command (vec)
6526 "Find a command on the remote host for checking if a file exists.
6527 Here, we are looking for a command which has zero exit status if the
6528 file exists and nonzero exit status otherwise."
6529 (let ((existing "/")
6530 (nonexisting
6531 (tramp-shell-quote-argument "/ this file does not exist "))
6532 result)
6533 ;; The algorithm is as follows: we try a list of several commands.
6534 ;; For each command, we first run `$cmd /' -- this should return
6535 ;; true, as the root directory always exists. And then we run
6536 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
6537 ;; does not exist. This should return false. We use the first
6538 ;; command we find that seems to work.
6539 ;; The list of commands to try is as follows:
6540 ;; `ls -d' This works on most systems, but NetBSD 1.4
6541 ;; has a bug: `ls' always returns zero exit
6542 ;; status, even for files which don't exist.
6543 ;; `test -e' Some Bourne shells have a `test' builtin
6544 ;; which does not know the `-e' option.
6545 ;; `/bin/test -e' For those, the `test' binary on disk normally
6546 ;; provides the option. Alas, the binary
6547 ;; is sometimes `/bin/test' and sometimes it's
6548 ;; `/usr/bin/test'.
6549 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
6550 (unless (or
6551 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
6552 (zerop (tramp-send-command-and-check
6553 vec (format "%s %s" result existing)))
6554 (not (zerop (tramp-send-command-and-check
6555 vec (format "%s %s" result nonexisting)))))
6556 (and (setq result "/bin/test -e")
6557 (zerop (tramp-send-command-and-check
6558 vec (format "%s %s" result existing)))
6559 (not (zerop (tramp-send-command-and-check
6560 vec (format "%s %s" result nonexisting)))))
6561 (and (setq result "/usr/bin/test -e")
6562 (zerop (tramp-send-command-and-check
6563 vec (format "%s %s" result existing)))
6564 (not (zerop (tramp-send-command-and-check
6565 vec (format "%s %s" result nonexisting)))))
6566 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
6567 (zerop (tramp-send-command-and-check
6568 vec (format "%s %s" result existing)))
6569 (not (zerop (tramp-send-command-and-check
6570 vec (format "%s %s" result nonexisting))))))
6571 (tramp-error
6572 vec 'file-error "Couldn't find command to check if file exists"))
6573 result))
6574
6575 ;; CCC test ksh or bash found for tilde expansion?
6576 (defun tramp-find-shell (vec)
6577 "Opens a shell on the remote host which groks tilde expansion."
6578 (unless (tramp-get-connection-property vec "remote-shell" nil)
6579 (let (shell)
6580 (with-current-buffer (tramp-get-buffer vec)
6581 (tramp-send-command vec "echo ~root" t)
6582 (cond
6583 ((or (string-match "^~root$" (buffer-string))
6584 ;; The default shell (ksh93) of OpenSolaris is buggy.
6585 (string-equal (tramp-get-connection-property vec "uname" "")
6586 "SunOS 5.11"))
6587 (setq shell
6588 (or (tramp-find-executable
6589 vec "bash" (tramp-get-remote-path vec) t t)
6590 (tramp-find-executable
6591 vec "ksh" (tramp-get-remote-path vec) t t)))
6592 (unless shell
6593 (tramp-error
6594 vec 'file-error
6595 "Couldn't find a shell which groks tilde expansion"))
6596 ;; Find arguments for this shell.
6597 (let ((alist tramp-sh-extra-args)
6598 item extra-args)
6599 (while (and alist (null extra-args))
6600 (setq item (pop alist))
6601 (when (string-match (car item) shell)
6602 (setq extra-args (cdr item))))
6603 (when extra-args (setq shell (concat shell " " extra-args))))
6604 (tramp-message
6605 vec 5 "Starting remote shell `%s' for tilde expansion" shell)
6606 (let ((tramp-end-of-output tramp-initial-end-of-output))
6607 (tramp-send-command
6608 vec
6609 (format "PROMPT_COMMAND='' PS1=%s PS2='' PS3='' exec %s"
6610 (shell-quote-argument tramp-end-of-output) shell)
6611 t))
6612 ;; Setting prompts.
6613 (with-progress-reporter vec 5 (format "Setting remote shell prompt")
6614 (tramp-send-command
6615 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
6616 (tramp-send-command vec "PS2=''" t)
6617 (tramp-send-command vec "PS3=''" t)
6618 (tramp-send-command vec "PROMPT_COMMAND=''" t)))
6619
6620 (t (tramp-message
6621 vec 5 "Remote `%s' groks tilde expansion, good"
6622 (tramp-get-method-parameter
6623 (tramp-file-name-method vec) 'tramp-remote-sh))
6624 (tramp-set-connection-property
6625 vec "remote-shell"
6626 (tramp-get-method-parameter
6627 (tramp-file-name-method vec) 'tramp-remote-sh))))))))
6628
6629 ;; ------------------------------------------------------------
6630 ;; -- Functions for establishing connection --
6631 ;; ------------------------------------------------------------
6632
6633 ;; The following functions are actions to be taken when seeing certain
6634 ;; prompts from the remote host. See the variable
6635 ;; `tramp-actions-before-shell' for usage of these functions.
6636
6637 (defun tramp-action-login (proc vec)
6638 "Send the login name."
6639 (when (not (stringp tramp-current-user))
6640 (save-window-excursion
6641 (let ((enable-recursive-minibuffers t))
6642 (pop-to-buffer (tramp-get-connection-buffer vec))
6643 (setq tramp-current-user (read-string (match-string 0))))))
6644 (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
6645 (with-current-buffer (tramp-get-connection-buffer vec)
6646 (tramp-message vec 6 "\n%s" (buffer-string)))
6647 (tramp-send-string vec tramp-current-user))
6648
6649 (defun tramp-action-password (proc vec)
6650 "Query the user for a password."
6651 (with-current-buffer (process-buffer proc)
6652 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
6653 (tramp-message vec 3 "Sending %s" (match-string 1)))
6654 (tramp-enter-password proc))
6655
6656 (defun tramp-action-succeed (proc vec)
6657 "Signal success in finding shell prompt."
6658 (throw 'tramp-action 'ok))
6659
6660 (defun tramp-action-permission-denied (proc vec)
6661 "Signal permission denied."
6662 (kill-process proc)
6663 (throw 'tramp-action 'permission-denied))
6664
6665 (defun tramp-action-yesno (proc vec)
6666 "Ask the user for confirmation using `yes-or-no-p'.
6667 Send \"yes\" to remote process on confirmation, abort otherwise.
6668 See also `tramp-action-yn'."
6669 (save-window-excursion
6670 (let ((enable-recursive-minibuffers t))
6671 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
6672 (unless (yes-or-no-p (match-string 0))
6673 (kill-process proc)
6674 (throw 'tramp-action 'permission-denied))
6675 (with-current-buffer (tramp-get-connection-buffer vec)
6676 (tramp-message vec 6 "\n%s" (buffer-string)))
6677 (tramp-send-string vec "yes"))))
6678
6679 (defun tramp-action-yn (proc vec)
6680 "Ask the user for confirmation using `y-or-n-p'.
6681 Send \"y\" to remote process on confirmation, abort otherwise.
6682 See also `tramp-action-yesno'."
6683 (save-window-excursion
6684 (let ((enable-recursive-minibuffers t))
6685 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
6686 (unless (y-or-n-p (match-string 0))
6687 (kill-process proc)
6688 (throw 'tramp-action 'permission-denied))
6689 (with-current-buffer (tramp-get-connection-buffer vec)
6690 (tramp-message vec 6 "\n%s" (buffer-string)))
6691 (tramp-send-string vec "y"))))
6692
6693 (defun tramp-action-terminal (proc vec)
6694 "Tell the remote host which terminal type to use.
6695 The terminal type can be configured with `tramp-terminal-type'."
6696 (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
6697 (with-current-buffer (tramp-get-connection-buffer vec)
6698 (tramp-message vec 6 "\n%s" (buffer-string)))
6699 (tramp-send-string vec tramp-terminal-type))
6700
6701 (defun tramp-action-process-alive (proc vec)
6702 "Check, whether a process has finished."
6703 (unless (memq (process-status proc) '(run open))
6704 (throw 'tramp-action 'process-died)))
6705
6706 (defun tramp-action-out-of-band (proc vec)
6707 "Check, whether an out-of-band copy has finished."
6708 (cond ((and (memq (process-status proc) '(stop exit))
6709 (zerop (process-exit-status proc)))
6710 (tramp-message vec 3 "Process has finished.")
6711 (throw 'tramp-action 'ok))
6712 ((or (and (memq (process-status proc) '(stop exit))
6713 (not (zerop (process-exit-status proc))))
6714 (memq (process-status proc) '(signal)))
6715 ;; `scp' could have copied correctly, but set modes could have failed.
6716 ;; This can be ignored.
6717 (with-current-buffer (process-buffer proc)
6718 (goto-char (point-min))
6719 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
6720 (progn
6721 (tramp-message vec 5 "'set mode' error ignored.")
6722 (tramp-message vec 3 "Process has finished.")
6723 (throw 'tramp-action 'ok))
6724 (tramp-message vec 3 "Process has died.")
6725 (throw 'tramp-action 'process-died))))
6726 (t nil)))
6727
6728 ;; Functions for processing the actions.
6729
6730 (defun tramp-process-one-action (proc vec actions)
6731 "Wait for output from the shell and perform one action."
6732 (let (found todo item pattern action)
6733 (while (not found)
6734 ;; Reread output once all actions have been performed.
6735 ;; Obviously, the output was not complete.
6736 (tramp-accept-process-output proc 1)
6737 (setq todo actions)
6738 (while todo
6739 (setq item (pop todo))
6740 (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
6741 (setq action (nth 1 item))
6742 (tramp-message
6743 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
6744 (when (tramp-check-for-regexp proc pattern)
6745 (tramp-message vec 5 "Call `%s'" (symbol-name action))
6746 (setq found (funcall action proc vec)))))
6747 found))
6748
6749 (defun tramp-process-actions (proc vec actions &optional timeout)
6750 "Perform actions until success or TIMEOUT."
6751 ;; Preserve message for `progress-reporter'.
6752 (with-temp-message ""
6753 ;; Enable auth-source and password-cache.
6754 (tramp-set-connection-property vec "first-password-request" t)
6755 (let (exit)
6756 (while (not exit)
6757 (tramp-message proc 3 "Waiting for prompts from remote shell")
6758 (setq exit
6759 (catch 'tramp-action
6760 (if timeout
6761 (with-timeout (timeout)
6762 (tramp-process-one-action proc vec actions))
6763 (tramp-process-one-action proc vec actions)))))
6764 (with-current-buffer (tramp-get-connection-buffer vec)
6765 (tramp-message vec 6 "\n%s" (buffer-string)))
6766 (unless (eq exit 'ok)
6767 (tramp-clear-passwd vec)
6768 (tramp-error-with-buffer
6769 nil vec 'file-error
6770 (cond
6771 ((eq exit 'permission-denied) "Permission denied")
6772 ((eq exit 'process-died) "Process died")
6773 (t "Login failed")))))))
6774
6775 ;; Utility functions.
6776
6777 (defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
6778 "Like `accept-process-output' for Tramp processes.
6779 This is needed in order to hide `last-coding-system-used', which is set
6780 for process communication also."
6781 (with-current-buffer (process-buffer proc)
6782 (tramp-message proc 10 "%s %s" proc (process-status proc))
6783 (let (buffer-read-only last-coding-system-used)
6784 ;; Under Windows XP, accept-process-output doesn't return
6785 ;; sometimes. So we add an additional timeout.
6786 (with-timeout ((or timeout 1))
6787 (accept-process-output proc timeout timeout-msecs)))
6788 (tramp-message proc 10 "\n%s" (buffer-string))))
6789
6790 (defun tramp-check-for-regexp (proc regexp)
6791 "Check, whether REGEXP is contained in process buffer of PROC.
6792 Erase echoed commands if exists."
6793 (with-current-buffer (process-buffer proc)
6794 (goto-char (point-min))
6795
6796 ;; Check whether we need to remove echo output.
6797 (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
6798 (re-search-forward tramp-echoed-echo-mark-regexp nil t))
6799 (let ((begin (match-beginning 0)))
6800 (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
6801 ;; Discard echo from remote output.
6802 (tramp-set-connection-property proc "check-remote-echo" nil)
6803 (tramp-message proc 5 "echo-mark found")
6804 (forward-line 1)
6805 (delete-region begin (point))
6806 (goto-char (point-min)))))
6807
6808 (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
6809 ;; Sometimes, the echo string is suppressed on the remote side.
6810 (not (string-equal
6811 (tramp-compat-funcall
6812 'substring-no-properties tramp-echo-mark-marker
6813 0 (min tramp-echo-mark-marker-length (1- (point-max))))
6814 (tramp-compat-funcall
6815 'buffer-substring-no-properties
6816 1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
6817 ;; No echo to be handled, now we can look for the regexp.
6818 (goto-char (point-min))
6819 (re-search-forward regexp nil t))))
6820
6821 (defun tramp-wait-for-regexp (proc timeout regexp)
6822 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
6823 Expects the output of PROC to be sent to the current buffer. Returns
6824 the string that matched, or nil. Waits indefinitely if TIMEOUT is
6825 nil."
6826 (with-current-buffer (process-buffer proc)
6827 (let ((found (tramp-check-for-regexp proc regexp))
6828 (start-time (current-time)))
6829 (cond (timeout
6830 ;; Work around a bug in XEmacs 21, where the timeout
6831 ;; expires faster than it should. This degenerates
6832 ;; to polling for buggy XEmacsen, but oh, well.
6833 (while (and (not found)
6834 (< (tramp-time-diff (current-time) start-time)
6835 timeout))
6836 (with-timeout (timeout)
6837 (while (not found)
6838 (tramp-accept-process-output proc 1)
6839 (unless (memq (process-status proc) '(run open))
6840 (tramp-error-with-buffer
6841 nil proc 'file-error "Process has died"))
6842 (setq found (tramp-check-for-regexp proc regexp))))))
6843 (t
6844 (while (not found)
6845 (tramp-accept-process-output proc 1)
6846 (unless (memq (process-status proc) '(run open))
6847 (tramp-error-with-buffer
6848 nil proc 'file-error "Process has died"))
6849 (setq found (tramp-check-for-regexp proc regexp)))))
6850 (tramp-message proc 6 "\n%s" (buffer-string))
6851 (when (not found)
6852 (if timeout
6853 (tramp-error
6854 proc 'file-error "[[Regexp `%s' not found in %d secs]]"
6855 regexp timeout)
6856 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
6857 found)))
6858
6859 (defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
6860 "Wait for shell prompt and barf if none appears.
6861 Looks at process PROC to see if a shell prompt appears in TIMEOUT
6862 seconds. If not, it produces an error message with the given ERROR-ARGS."
6863 (unless
6864 (tramp-wait-for-regexp
6865 proc timeout
6866 (format
6867 "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
6868 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
6869
6870 ;; We don't call `tramp-send-string' in order to hide the password
6871 ;; from the debug buffer, and because end-of-line handling of the
6872 ;; string.
6873 (defun tramp-enter-password (proc)
6874 "Prompt for a password and send it to the remote end."
6875 (process-send-string
6876 proc (concat (tramp-read-passwd proc)
6877 (or (tramp-get-method-parameter
6878 tramp-current-method
6879 'tramp-password-end-of-line)
6880 tramp-default-password-end-of-line))))
6881
6882 (defun tramp-open-connection-setup-interactive-shell (proc vec)
6883 "Set up an interactive shell.
6884 Mainly sets the prompt and the echo correctly. PROC is the shell
6885 process to set up. VEC specifies the connection."
6886 (let ((tramp-end-of-output tramp-initial-end-of-output))
6887 ;; It is useful to set the prompt in the following command because
6888 ;; some people have a setting for $PS1 which /bin/sh doesn't know
6889 ;; about and thus /bin/sh will display a strange prompt. For
6890 ;; example, if $PS1 has "${CWD}" in the value, then ksh will
6891 ;; display the current working directory but /bin/sh will display
6892 ;; a dollar sign. The following command line sets $PS1 to a sane
6893 ;; value, and works under Bourne-ish shells as well as csh-like
6894 ;; shells. Daniel Pittman reports that the unusual positioning of
6895 ;; the single quotes makes it work under `rc', too. We also unset
6896 ;; the variable $ENV because that is read by some sh
6897 ;; implementations (eg, bash when called as sh) on startup; this
6898 ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
6899 ;; is another way to set the prompt in /bin/bash, it must be
6900 ;; discarded as well.
6901 (tramp-send-command
6902 vec
6903 (format
6904 "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
6905 (shell-quote-argument tramp-end-of-output)
6906 (tramp-get-method-parameter
6907 (tramp-file-name-method vec) 'tramp-remote-sh))
6908 t)
6909
6910 ;; Disable echo.
6911 (tramp-message vec 5 "Setting up remote shell environment")
6912 (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
6913 ;; Check whether the echo has really been disabled. Some
6914 ;; implementations, like busybox of embedded GNU/Linux, don't
6915 ;; support disabling.
6916 (tramp-send-command vec "echo foo" t)
6917 (with-current-buffer (process-buffer proc)
6918 (goto-char (point-min))
6919 (when (looking-at "echo foo")
6920 (tramp-set-connection-property proc "remote-echo" t)
6921 (tramp-message vec 5 "Remote echo still on. Ok.")
6922 ;; Make sure backspaces and their echo are enabled and no line
6923 ;; width magic interferes with them.
6924 (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
6925
6926 (tramp-message vec 5 "Setting shell prompt")
6927 (tramp-send-command
6928 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
6929 (tramp-send-command vec "PS2=''" t)
6930 (tramp-send-command vec "PS3=''" t)
6931 (tramp-send-command vec "PROMPT_COMMAND=''" t)
6932
6933 ;; Try to set up the coding system correctly.
6934 ;; CCC this can't be the right way to do it. Hm.
6935 (tramp-message vec 5 "Determining coding system")
6936 (tramp-send-command vec "echo foo ; echo bar" t)
6937 (with-current-buffer (process-buffer proc)
6938 (goto-char (point-min))
6939 (if (featurep 'mule)
6940 ;; Use MULE to select the right EOL convention for communicating
6941 ;; with the process.
6942 (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
6943 (cons 'undecided 'undecided)))
6944 cs-decode cs-encode)
6945 (when (symbolp cs) (setq cs (cons cs cs)))
6946 (setq cs-decode (car cs))
6947 (setq cs-encode (cdr cs))
6948 (unless cs-decode (setq cs-decode 'undecided))
6949 (unless cs-encode (setq cs-encode 'undecided))
6950 (setq cs-encode (tramp-coding-system-change-eol-conversion
6951 cs-encode 'unix))
6952 (when (search-forward "\r" nil t)
6953 (setq cs-decode (tramp-coding-system-change-eol-conversion
6954 cs-decode 'dos)))
6955 (tramp-compat-funcall
6956 'set-buffer-process-coding-system cs-decode cs-encode)
6957 (tramp-message
6958 vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
6959 ;; Look for ^M and do something useful if found.
6960 (when (search-forward "\r" nil t)
6961 ;; We have found a ^M but cannot frob the process coding system
6962 ;; because we're running on a non-MULE Emacs. Let's try
6963 ;; stty, instead.
6964 (tramp-send-command vec "stty -onlcr" t))))
6965 ;; Dump stty settings in the traces.
6966 (when (>= tramp-verbose 10)
6967 (tramp-send-command vec "stty -a" t))
6968 (tramp-send-command vec "set +o vi +o emacs" t)
6969
6970 ;; Check whether the output of "uname -sr" has been changed. If
6971 ;; yes, this is a strong indication that we must expire all
6972 ;; connection properties. We start again with
6973 ;; `tramp-maybe-open-connection', it will be catched there.
6974 (tramp-message vec 5 "Checking system information")
6975 (let ((old-uname (tramp-get-connection-property vec "uname" nil))
6976 (new-uname
6977 (tramp-set-connection-property
6978 vec "uname"
6979 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
6980 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
6981 (with-current-buffer (tramp-get-debug-buffer vec)
6982 ;; Keep the debug buffer.
6983 (rename-buffer
6984 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
6985 (tramp-compat-funcall 'tramp-cleanup-connection vec)
6986 (if (= (point-min) (point-max))
6987 (kill-buffer nil)
6988 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
6989 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
6990 (tramp-get-buffer vec)
6991 (tramp-message
6992 vec 3
6993 "Connection reset, because remote host changed from `%s' to `%s'"
6994 old-uname new-uname)
6995 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
6996
6997 ;; Check whether the remote host suffers from buggy
6998 ;; `send-process-string'. This is known for FreeBSD (see comment in
6999 ;; `send_process', file process.c). I've tested sending 624 bytes
7000 ;; successfully, sending 625 bytes failed. Emacs makes a hack when
7001 ;; this host type is detected locally. It cannot handle remote
7002 ;; hosts, though.
7003 (with-connection-property proc "chunksize"
7004 (cond
7005 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
7006 tramp-chunksize)
7007 (t
7008 (tramp-message
7009 vec 5 "Checking remote host type for `send-process-string' bug")
7010 (if (string-match
7011 "^FreeBSD" (tramp-get-connection-property vec "uname" ""))
7012 500 0))))
7013
7014 ;; Set remote PATH variable.
7015 (tramp-set-remote-path vec)
7016
7017 ;; Search for a good shell before searching for a command which
7018 ;; checks if a file exists. This is done because Tramp wants to use
7019 ;; "test foo; echo $?" to check if various conditions hold, and
7020 ;; there are buggy /bin/sh implementations which don't execute the
7021 ;; "echo $?" part if the "test" part has an error. In particular,
7022 ;; the OpenSolaris /bin/sh is a problem. There are also other
7023 ;; problems with /bin/sh of OpenSolaris, like redirection of stderr
7024 ;; in in function declarations, or changing HISTFILE in place.
7025 ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when
7026 ;; detected.
7027 (tramp-find-shell vec)
7028
7029 ;; Disable unexpected output.
7030 (tramp-send-command vec "mesg n; biff n" t)
7031
7032 ;; Set the environment.
7033 (tramp-message vec 5 "Setting default environment")
7034
7035 (let ((env (copy-sequence tramp-remote-process-environment))
7036 unset item)
7037 (while env
7038 (setq item (tramp-compat-split-string (car env) "="))
7039 (setcdr item (mapconcat 'identity (cdr item) "="))
7040 (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
7041 (tramp-send-command
7042 vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t)
7043 (push (car item) unset))
7044 (setq env (cdr env)))
7045 (when unset
7046 (tramp-send-command
7047 vec (format "unset %s" (mapconcat 'identity unset " "))))) t)
7048
7049 ;; CCC: We should either implement a Perl version of base64 encoding
7050 ;; and decoding. Then we just use that in the last item. The other
7051 ;; alternative is to use the Perl version of UU encoding. But then
7052 ;; we need a Lisp version of uuencode.
7053 ;;
7054 ;; Old text from documentation of tramp-methods:
7055 ;; Using a uuencode/uudecode inline method is discouraged, please use one
7056 ;; of the base64 methods instead since base64 encoding is much more
7057 ;; reliable and the commands are more standardized between the different
7058 ;; Unix versions. But if you can't use base64 for some reason, please
7059 ;; note that the default uudecode command does not work well for some
7060 ;; Unices, in particular AIX and Irix. For AIX, you might want to use
7061 ;; the following command for uudecode:
7062 ;;
7063 ;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
7064 ;;
7065 ;; For Irix, no solution is known yet.
7066
7067 (defconst tramp-local-coding-commands
7068 '((b64 base64-encode-region base64-decode-region)
7069 (uu tramp-uuencode-region uudecode-decode-region)
7070 (pack
7071 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7072 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7073 "List of local coding commands for inline transfer.
7074 Each item is a list that looks like this:
7075
7076 \(FORMAT ENCODING DECODING\)
7077
7078 FORMAT is symbol describing the encoding/decoding format. It can be
7079 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7080
7081 ENCODING and DECODING can be strings, giving commands, or symbols,
7082 giving functions. If they are strings, then they can contain
7083 the \"%s\" format specifier. If that specifier is present, the input
7084 filename will be put into the command line at that spot. If the
7085 specifier is not present, the input should be read from standard
7086 input.
7087
7088 If they are functions, they will be called with two arguments, start
7089 and end of region, and are expected to replace the region contents
7090 with the encoded or decoded results, respectively.")
7091
7092 (defconst tramp-remote-coding-commands
7093 '((b64 "base64" "base64 -d")
7094 (b64 "mimencode -b" "mimencode -u -b")
7095 (b64 "mmencode -b" "mmencode -u -b")
7096 (b64 "recode data..base64" "recode base64..data")
7097 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
7098 (b64 tramp-perl-encode tramp-perl-decode)
7099 (uu "uuencode xxx" "uudecode -o /dev/stdout")
7100 (uu "uuencode xxx" "uudecode -o -")
7101 (uu "uuencode xxx" "uudecode -p")
7102 (uu "uuencode xxx" tramp-uudecode)
7103 (pack
7104 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7105 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7106 "List of remote coding commands for inline transfer.
7107 Each item is a list that looks like this:
7108
7109 \(FORMAT ENCODING DECODING\)
7110
7111 FORMAT is symbol describing the encoding/decoding format. It can be
7112 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7113
7114 ENCODING and DECODING can be strings, giving commands, or symbols,
7115 giving variables. If they are strings, then they can contain
7116 the \"%s\" format specifier. If that specifier is present, the input
7117 filename will be put into the command line at that spot. If the
7118 specifier is not present, the input should be read from standard
7119 input.
7120
7121 If they are variables, this variable is a string containing a Perl
7122 implementation for this functionality. This Perl program will be transferred
7123 to the remote host, and it is available as shell function with the same name.")
7124
7125 (defun tramp-find-inline-encoding (vec)
7126 "Find an inline transfer encoding that works.
7127 Goes through the list `tramp-local-coding-commands' and
7128 `tramp-remote-coding-commands'."
7129 (save-excursion
7130 (let ((local-commands tramp-local-coding-commands)
7131 (magic "xyzzy")
7132 loc-enc loc-dec rem-enc rem-dec litem ritem found)
7133 (while (and local-commands (not found))
7134 (setq litem (pop local-commands))
7135 (catch 'wont-work-local
7136 (let ((format (nth 0 litem))
7137 (remote-commands tramp-remote-coding-commands))
7138 (setq loc-enc (nth 1 litem))
7139 (setq loc-dec (nth 2 litem))
7140 ;; If the local encoder or decoder is a string, the
7141 ;; corresponding command has to work locally.
7142 (if (not (stringp loc-enc))
7143 (tramp-message
7144 vec 5 "Checking local encoding function `%s'" loc-enc)
7145 (tramp-message
7146 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
7147 (unless (zerop (tramp-call-local-coding-command
7148 loc-enc nil nil))
7149 (throw 'wont-work-local nil)))
7150 (if (not (stringp loc-dec))
7151 (tramp-message
7152 vec 5 "Checking local decoding function `%s'" loc-dec)
7153 (tramp-message
7154 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
7155 (unless (zerop (tramp-call-local-coding-command
7156 loc-dec nil nil))
7157 (throw 'wont-work-local nil)))
7158 ;; Search for remote coding commands with the same format
7159 (while (and remote-commands (not found))
7160 (setq ritem (pop remote-commands))
7161 (catch 'wont-work-remote
7162 (when (equal format (nth 0 ritem))
7163 (setq rem-enc (nth 1 ritem))
7164 (setq rem-dec (nth 2 ritem))
7165 ;; Check if remote encoding and decoding commands can be
7166 ;; called remotely with null input and output. This makes
7167 ;; sure there are no syntax errors and the command is really
7168 ;; found. Note that we do not redirect stdout to /dev/null,
7169 ;; for two reasons: when checking the decoding command, we
7170 ;; actually check the output it gives. And also, when
7171 ;; redirecting "mimencode" output to /dev/null, then as root
7172 ;; it might change the permissions of /dev/null!
7173 (when (not (stringp rem-enc))
7174 (let ((name (symbol-name rem-enc)))
7175 (while (string-match (regexp-quote "-") name)
7176 (setq name (replace-match "_" nil t name)))
7177 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
7178 (setq rem-enc name)))
7179 (tramp-message
7180 vec 5
7181 "Checking remote encoding command `%s' for sanity" rem-enc)
7182 (unless (zerop (tramp-send-command-and-check
7183 vec (format "%s </dev/null" rem-enc) t))
7184 (throw 'wont-work-remote nil))
7185
7186 (when (not (stringp rem-dec))
7187 (let ((name (symbol-name rem-dec)))
7188 (while (string-match (regexp-quote "-") name)
7189 (setq name (replace-match "_" nil t name)))
7190 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
7191 (setq rem-dec name)))
7192 (tramp-message
7193 vec 5
7194 "Checking remote decoding command `%s' for sanity" rem-dec)
7195 (unless (zerop (tramp-send-command-and-check
7196 vec
7197 (format "echo %s | %s | %s"
7198 magic rem-enc rem-dec)
7199 t))
7200 (throw 'wont-work-remote nil))
7201
7202 (with-current-buffer (tramp-get-buffer vec)
7203 (goto-char (point-min))
7204 (unless (looking-at (regexp-quote magic))
7205 (throw 'wont-work-remote nil)))
7206
7207 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
7208 (setq rem-enc (nth 1 ritem))
7209 (setq rem-dec (nth 2 ritem))
7210 (setq found t)))))))
7211
7212 ;; Did we find something?
7213 (unless found
7214 (tramp-error
7215 vec 'file-error "Couldn't find an inline transfer encoding"))
7216
7217 ;; Set connection properties.
7218 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
7219 (tramp-set-connection-property vec "local-encoding" loc-enc)
7220 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
7221 (tramp-set-connection-property vec "local-decoding" loc-dec)
7222 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
7223 (tramp-set-connection-property vec "remote-encoding" rem-enc)
7224 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
7225 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
7226
7227 (defun tramp-call-local-coding-command (cmd input output)
7228 "Call the local encoding or decoding command.
7229 If CMD contains \"%s\", provide input file INPUT there in command.
7230 Otherwise, INPUT is passed via standard input.
7231 INPUT can also be nil which means `/dev/null'.
7232 OUTPUT can be a string (which specifies a filename), or t (which
7233 means standard output and thus the current buffer), or nil (which
7234 means discard it)."
7235 (tramp-local-call-process
7236 tramp-encoding-shell
7237 (when (and input (not (string-match "%s" cmd))) input)
7238 (if (eq output t) t nil)
7239 nil
7240 tramp-encoding-command-switch
7241 (concat
7242 (if (string-match "%s" cmd) (format cmd input) cmd)
7243 (if (stringp output) (concat "> " output) ""))))
7244
7245 (defconst tramp-inline-compress-commands
7246 '(("gzip" "gzip -d")
7247 ("bzip2" "bzip2 -d")
7248 ("compress" "compress -d"))
7249 "List of compress and decompress commands for inline transfer.
7250 Each item is a list that looks like this:
7251
7252 \(COMPRESS DECOMPRESS\)
7253
7254 COMPRESS or DECOMPRESS are strings with the respective commands.")
7255
7256 (defun tramp-find-inline-compress (vec)
7257 "Find an inline transfer compress command that works.
7258 Goes through the list `tramp-inline-compress-commands'."
7259 (save-excursion
7260 (let ((commands tramp-inline-compress-commands)
7261 (magic "xyzzy")
7262 item compress decompress
7263 found)
7264 (while (and commands (not found))
7265 (catch 'next
7266 (setq item (pop commands)
7267 compress (nth 0 item)
7268 decompress (nth 1 item))
7269 (tramp-message
7270 vec 5
7271 "Checking local compress command `%s', `%s' for sanity"
7272 compress decompress)
7273 (unless (zerop (tramp-call-local-coding-command
7274 (format "echo %s | %s | %s"
7275 magic compress decompress) nil nil))
7276 (throw 'next nil))
7277 (tramp-message
7278 vec 5
7279 "Checking remote compress command `%s', `%s' for sanity"
7280 compress decompress)
7281 (unless (zerop (tramp-send-command-and-check
7282 vec (format "echo %s | %s | %s"
7283 magic compress decompress) t))
7284 (throw 'next nil))
7285 (setq found t)))
7286
7287 ;; Did we find something?
7288 (if found
7289 (progn
7290 ;; Set connection properties.
7291 (tramp-message
7292 vec 5 "Using inline transfer compress command `%s'" compress)
7293 (tramp-set-connection-property vec "inline-compress" compress)
7294 (tramp-message
7295 vec 5 "Using inline transfer decompress command `%s'" decompress)
7296 (tramp-set-connection-property vec "inline-decompress" decompress))
7297
7298 (tramp-set-connection-property vec "inline-compress" nil)
7299 (tramp-set-connection-property vec "inline-decompress" nil)
7300 (tramp-message
7301 vec 2 "Couldn't find an inline transfer compress command")))))
7302
7303 (defun tramp-compute-multi-hops (vec)
7304 "Expands VEC according to `tramp-default-proxies-alist'.
7305 Gateway hops are already opened."
7306 (let ((target-alist `(,vec))
7307 (choices tramp-default-proxies-alist)
7308 item proxy)
7309
7310 ;; Look for proxy hosts to be passed.
7311 (while choices
7312 (setq item (pop choices)
7313 proxy (eval (nth 2 item)))
7314 (when (and
7315 ;; host
7316 (string-match (or (eval (nth 0 item)) "")
7317 (or (tramp-file-name-host (car target-alist)) ""))
7318 ;; user
7319 (string-match (or (eval (nth 1 item)) "")
7320 (or (tramp-file-name-user (car target-alist)) "")))
7321 (if (null proxy)
7322 ;; No more hops needed.
7323 (setq choices nil)
7324 ;; Replace placeholders.
7325 (setq proxy
7326 (format-spec
7327 proxy
7328 (format-spec-make
7329 ?u (or (tramp-file-name-user (car target-alist)) "")
7330 ?h (or (tramp-file-name-host (car target-alist)) ""))))
7331 (with-parsed-tramp-file-name proxy l
7332 ;; Add the hop.
7333 (add-to-list 'target-alist l)
7334 ;; Start next search.
7335 (setq choices tramp-default-proxies-alist)))))
7336
7337 ;; Handle gateways.
7338 (when (and (boundp 'tramp-gw-tunnel-method)
7339 (string-match (format
7340 "^\\(%s\\|%s\\)$"
7341 (symbol-value 'tramp-gw-tunnel-method)
7342 (symbol-value 'tramp-gw-socks-method))
7343 (tramp-file-name-method (car target-alist))))
7344 (let ((gw (pop target-alist))
7345 (hop (pop target-alist)))
7346 ;; Is the method prepared for gateways?
7347 (unless (tramp-get-method-parameter
7348 (tramp-file-name-method hop) 'tramp-default-port)
7349 (tramp-error
7350 vec 'file-error
7351 "Method `%s' is not supported for gateway access."
7352 (tramp-file-name-method hop)))
7353 ;; Add default port if needed.
7354 (unless
7355 (string-match
7356 tramp-host-with-port-regexp (tramp-file-name-host hop))
7357 (aset hop 2
7358 (concat
7359 (tramp-file-name-host hop) tramp-prefix-port-format
7360 (number-to-string
7361 (tramp-get-method-parameter
7362 (tramp-file-name-method hop) 'tramp-default-port)))))
7363 ;; Open the gateway connection.
7364 (add-to-list
7365 'target-alist
7366 (vector
7367 (tramp-file-name-method hop) (tramp-file-name-user hop)
7368 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
7369 ;; For the password prompt, we need the correct values.
7370 ;; Therefore, we must remember the gateway vector. But we
7371 ;; cannot do it as connection property, because it shouldn't
7372 ;; be persistent. And we have no started process yet either.
7373 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
7374
7375 ;; Foreign and out-of-band methods are not supported for multi-hops.
7376 (when (cdr target-alist)
7377 (setq choices target-alist)
7378 (while choices
7379 (setq item (pop choices))
7380 (when
7381 (or
7382 (not
7383 (tramp-get-method-parameter
7384 (tramp-file-name-method item) 'tramp-login-program))
7385 (tramp-get-method-parameter
7386 (tramp-file-name-method item) 'tramp-copy-program))
7387 (tramp-error
7388 vec 'file-error
7389 "Method `%s' is not supported for multi-hops."
7390 (tramp-file-name-method item)))))
7391
7392 ;; In case the host name is not used for the remote shell
7393 ;; command, the user could be misguided by applying a random
7394 ;; hostname.
7395 (let* ((v (car target-alist))
7396 (method (tramp-file-name-method v))
7397 (host (tramp-file-name-host v)))
7398 (unless
7399 (or
7400 ;; There are multi-hops.
7401 (cdr target-alist)
7402 ;; The host name is used for the remote shell command.
7403 (member
7404 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
7405 ;; The host is local. We cannot use `tramp-local-host-p'
7406 ;; here, because it opens a connection as well.
7407 (string-match tramp-local-host-regexp host))
7408 (tramp-error
7409 v 'file-error
7410 "Host `%s' looks like a remote host, `%s' can only use the local host"
7411 host method)))
7412
7413 ;; Result.
7414 target-alist))
7415
7416 (defun tramp-maybe-open-connection (vec)
7417 "Maybe open a connection VEC.
7418 Does not do anything if a connection is already open, but re-opens the
7419 connection if a previous connection has died for some reason."
7420 (catch 'uname-changed
7421 (let ((p (tramp-get-connection-process vec))
7422 (process-name (tramp-get-connection-property vec "process-name" nil))
7423 (process-environment (copy-sequence process-environment)))
7424
7425 ;; If too much time has passed since last command was sent, look
7426 ;; whether process is still alive. If it isn't, kill it. When
7427 ;; using ssh, it can sometimes happen that the remote end has
7428 ;; hung up but the local ssh client doesn't recognize this until
7429 ;; it tries to send some data to the remote end. So that's why
7430 ;; we try to send a command from time to time, then look again
7431 ;; whether the process is really alive.
7432 (condition-case nil
7433 (when (and (> (tramp-time-diff
7434 (current-time)
7435 (tramp-get-connection-property
7436 p "last-cmd-time" '(0 0 0)))
7437 60)
7438 p (processp p) (memq (process-status p) '(run open)))
7439 (tramp-send-command vec "echo are you awake" t t)
7440 (unless (and (memq (process-status p) '(run open))
7441 (tramp-wait-for-output p 10))
7442 ;; The error will be catched locally.
7443 (tramp-error vec 'file-error "Awake did fail")))
7444 (file-error
7445 (tramp-flush-connection-property vec)
7446 (tramp-flush-connection-property p)
7447 (delete-process p)
7448 (setq p nil)))
7449
7450 ;; New connection must be opened.
7451 (unless (and p (processp p) (memq (process-status p) '(run open)))
7452
7453 ;; We call `tramp-get-buffer' in order to get a debug buffer for
7454 ;; messages from the beginning.
7455 (tramp-get-buffer vec)
7456 (with-progress-reporter
7457 vec 3
7458 (if (zerop (length (tramp-file-name-user vec)))
7459 (format "Opening connection for %s using %s"
7460 (tramp-file-name-host vec)
7461 (tramp-file-name-method vec))
7462 (format "Opening connection for %s@%s using %s"
7463 (tramp-file-name-user vec)
7464 (tramp-file-name-host vec)
7465 (tramp-file-name-method vec)))
7466
7467 ;; Start new process.
7468 (when (and p (processp p))
7469 (delete-process p))
7470 (setenv "TERM" tramp-terminal-type)
7471 (setenv "LC_ALL" "C")
7472 (setenv "PROMPT_COMMAND")
7473 (setenv "PS1" tramp-initial-end-of-output)
7474 (let* ((target-alist (tramp-compute-multi-hops vec))
7475 (process-connection-type tramp-process-connection-type)
7476 (process-adaptive-read-buffering nil)
7477 (coding-system-for-read nil)
7478 ;; This must be done in order to avoid our file name handler.
7479 (p (let ((default-directory
7480 (tramp-compat-temporary-file-directory)))
7481 (start-process
7482 (or process-name (tramp-buffer-name vec))
7483 (tramp-get-connection-buffer vec)
7484 tramp-encoding-shell))))
7485
7486 (tramp-message
7487 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
7488
7489 ;; Check whether process is alive.
7490 (tramp-set-process-query-on-exit-flag p nil)
7491 (tramp-barf-if-no-shell-prompt
7492 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
7493
7494 ;; Now do all the connections as specified.
7495 (while target-alist
7496 (let* ((hop (car target-alist))
7497 (l-method (tramp-file-name-method hop))
7498 (l-user (tramp-file-name-user hop))
7499 (l-host (tramp-file-name-host hop))
7500 (l-port nil)
7501 (login-program
7502 (tramp-get-method-parameter
7503 l-method 'tramp-login-program))
7504 (login-args
7505 (tramp-get-method-parameter l-method 'tramp-login-args))
7506 (async-args
7507 (tramp-get-method-parameter l-method 'tramp-async-args))
7508 (gw-args
7509 (tramp-get-method-parameter l-method 'tramp-gw-args))
7510 (gw (tramp-get-file-property hop "" "gateway" nil))
7511 (g-method (and gw (tramp-file-name-method gw)))
7512 (g-user (and gw (tramp-file-name-user gw)))
7513 (g-host (and gw (tramp-file-name-host gw)))
7514 (command login-program)
7515 ;; We don't create the temporary file. In fact,
7516 ;; it is just a prefix for the ControlPath option
7517 ;; of ssh; the real temporary file has another
7518 ;; name, and it is created and protected by ssh.
7519 ;; It is also removed by ssh, when the connection
7520 ;; is closed.
7521 (tmpfile
7522 (tramp-set-connection-property
7523 p "temp-file"
7524 (make-temp-name
7525 (expand-file-name
7526 tramp-temp-name-prefix
7527 (tramp-compat-temporary-file-directory)))))
7528 spec)
7529
7530 ;; Add arguments for asynchrononous processes.
7531 (when (and process-name async-args)
7532 (setq login-args (append login-args async-args)))
7533
7534 ;; Add gateway arguments if necessary.
7535 (when (and gw gw-args)
7536 (setq login-args (append login-args gw-args)))
7537
7538 ;; Check for port number. Until now, there's no need
7539 ;; for handling like method, user, host.
7540 (when (string-match tramp-host-with-port-regexp l-host)
7541 (setq l-port (match-string 2 l-host)
7542 l-host (match-string 1 l-host)))
7543
7544 ;; Set variables for computing the prompt for reading
7545 ;; password. They can also be derived from a gateway.
7546 (setq tramp-current-method (or g-method l-method)
7547 tramp-current-user (or g-user l-user)
7548 tramp-current-host (or g-host l-host))
7549
7550 ;; Replace login-args place holders.
7551 (setq
7552 l-host (or l-host "")
7553 l-user (or l-user "")
7554 l-port (or l-port "")
7555 spec (format-spec-make
7556 ?h l-host ?u l-user ?p l-port ?t tmpfile)
7557 command
7558 (concat
7559 ;; We do not want to see the trailing local prompt in
7560 ;; `start-file-process'.
7561 (unless (memq system-type '(windows-nt)) "exec ")
7562 command " "
7563 (mapconcat
7564 (lambda (x)
7565 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
7566 (unless (member "" x) (mapconcat 'identity x " ")))
7567 login-args " ")
7568 ;; Local shell could be a Windows COMSPEC. It
7569 ;; doesn't know the ";" syntax, but we must exit
7570 ;; always for `start-file-process'. "exec" does not
7571 ;; work either.
7572 (if (memq system-type '(windows-nt)) " && exit || exit")))
7573
7574 ;; Send the command.
7575 (tramp-message vec 3 "Sending command `%s'" command)
7576 (tramp-send-command vec command t t)
7577 (tramp-process-actions p vec tramp-actions-before-shell 60)
7578 (tramp-message
7579 vec 3 "Found remote shell prompt on `%s'" l-host))
7580 ;; Next hop.
7581 (setq target-alist (cdr target-alist)))
7582
7583 ;; Make initial shell settings.
7584 (tramp-open-connection-setup-interactive-shell p vec)))))))
7585
7586 (defun tramp-send-command (vec command &optional neveropen nooutput)
7587 "Send the COMMAND to connection VEC.
7588 Erases temporary buffer before sending the command. If optional
7589 arg NEVEROPEN is non-nil, never try to open the connection. This
7590 is meant to be used from `tramp-maybe-open-connection' only. The
7591 function waits for output unless NOOUTPUT is set."
7592 (unless neveropen (tramp-maybe-open-connection vec))
7593 (let ((p (tramp-get-connection-process vec)))
7594 (when (tramp-get-connection-property p "remote-echo" nil)
7595 ;; We mark the command string that it can be erased in the output buffer.
7596 (tramp-set-connection-property p "check-remote-echo" t)
7597 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
7598 (tramp-message vec 6 "%s" command)
7599 (tramp-send-string vec command)
7600 (unless nooutput (tramp-wait-for-output p))))
7601
7602 (defun tramp-wait-for-output (proc &optional timeout)
7603 "Wait for output from remote command."
7604 (unless (buffer-live-p (process-buffer proc))
7605 (delete-process proc)
7606 (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
7607 (with-current-buffer (process-buffer proc)
7608 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
7609 ;; be leading escape sequences, which must be ignored.
7610 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
7611 ;; Sometimes, the commands do not return a newline but a
7612 ;; null byte before the shell prompt, for example "git
7613 ;; ls-files -c -z ...".
7614 (regexp1 (format "\\(^\\|\000\\)%s" regexp))
7615 (found (tramp-wait-for-regexp proc timeout regexp1)))
7616 (if found
7617 (let (buffer-read-only)
7618 ;; A simple-minded busybox has sent " ^H" sequences.
7619 ;; Delete them.
7620 (goto-char (point-min))
7621 (when (re-search-forward
7622 "^\\(.\b\\)+$" (tramp-compat-line-end-position) t)
7623 (forward-line 1)
7624 (delete-region (point-min) (point)))
7625 ;; Delete the prompt.
7626 (goto-char (point-max))
7627 (re-search-backward regexp nil t)
7628 (delete-region (point) (point-max)))
7629 (if timeout
7630 (tramp-error
7631 proc 'file-error
7632 "[[Remote prompt `%s' not found in %d secs]]"
7633 tramp-end-of-output timeout)
7634 (tramp-error
7635 proc 'file-error
7636 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
7637 ;; Return value is whether end-of-output sentinel was found.
7638 found)))
7639
7640 (defun tramp-send-command-and-check
7641 (vec command &optional subshell dont-suppress-err)
7642 "Run COMMAND and check its exit status.
7643 Sends `echo $?' along with the COMMAND for checking the exit status. If
7644 COMMAND is nil, just sends `echo $?'. Returns the exit status found.
7645
7646 If the optional argument SUBSHELL is non-nil, the command is
7647 executed in a subshell, ie surrounded by parentheses. If
7648 DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
7649 (tramp-send-command
7650 vec
7651 (concat (if subshell "( " "")
7652 command
7653 (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
7654 "echo tramp_exit_status $?"
7655 (if subshell " )" "")))
7656 (with-current-buffer (tramp-get-connection-buffer vec)
7657 (goto-char (point-max))
7658 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
7659 (tramp-error
7660 vec 'file-error "Couldn't find exit status of `%s'" command))
7661 (skip-chars-forward "^ ")
7662 (prog1
7663 (read (current-buffer))
7664 (let (buffer-read-only) (delete-region (match-beginning 0) (point-max))))))
7665
7666 (defun tramp-barf-unless-okay (vec command fmt &rest args)
7667 "Run COMMAND, check exit status, throw error if exit status not okay.
7668 Similar to `tramp-send-command-and-check' but accepts two more arguments
7669 FMT and ARGS which are passed to `error'."
7670 (unless (zerop (tramp-send-command-and-check vec command))
7671 (apply 'tramp-error vec 'file-error fmt args)))
7672
7673 (defun tramp-send-command-and-read (vec command)
7674 "Run COMMAND and return the output, which must be a Lisp expression.
7675 In case there is no valid Lisp expression, it raises an error"
7676 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
7677 (with-current-buffer (tramp-get-connection-buffer vec)
7678 ;; Read the expression.
7679 (goto-char (point-min))
7680 (condition-case nil
7681 (prog1 (read (current-buffer))
7682 ;; Error handling.
7683 (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t)
7684 (error nil)))
7685 (error (tramp-error
7686 vec 'file-error
7687 "`%s' does not return a valid Lisp expression: `%s'"
7688 command (buffer-string))))))
7689
7690 ;; It seems that Tru64 Unix does not like it if long strings are sent
7691 ;; to it in one go. (This happens when sending the Perl
7692 ;; `file-attributes' implementation, for instance.) Therefore, we
7693 ;; have this function which sends the string in chunks.
7694 (defun tramp-send-string (vec string)
7695 "Send the STRING via connection VEC.
7696
7697 The STRING is expected to use Unix line-endings, but the lines sent to
7698 the remote host use line-endings as defined in the variable
7699 `tramp-rsh-end-of-line'. The communication buffer is erased before sending."
7700 (let* ((p (tramp-get-connection-process vec))
7701 (chunksize (tramp-get-connection-property p "chunksize" nil)))
7702 (unless p
7703 (tramp-error
7704 vec 'file-error "Can't send string to remote host -- not logged in"))
7705 (tramp-set-connection-property p "last-cmd-time" (current-time))
7706 (tramp-message vec 10 "%s" string)
7707 (with-current-buffer (tramp-get-connection-buffer vec)
7708 ;; Clean up the buffer. We cannot call `erase-buffer' because
7709 ;; narrowing might be in effect.
7710 (let (buffer-read-only) (delete-region (point-min) (point-max)))
7711 ;; Replace "\n" by `tramp-rsh-end-of-line'.
7712 (setq string
7713 (mapconcat 'identity
7714 (tramp-compat-split-string string "\n")
7715 tramp-rsh-end-of-line))
7716 (unless (or (string= string "")
7717 (string-equal (substring string -1) tramp-rsh-end-of-line))
7718 (setq string (concat string tramp-rsh-end-of-line)))
7719 ;; Send the string.
7720 (if (and chunksize (not (zerop chunksize)))
7721 (let ((pos 0)
7722 (end (length string)))
7723 (while (< pos end)
7724 (tramp-message
7725 vec 10 "Sending chunk from %s to %s"
7726 pos (min (+ pos chunksize) end))
7727 (process-send-string
7728 p (substring string pos (min (+ pos chunksize) end)))
7729 (setq pos (+ pos chunksize))))
7730 (process-send-string p string)))))
7731
7732 (defun tramp-mode-string-to-int (mode-string)
7733 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
7734 (let* (case-fold-search
7735 (mode-chars (string-to-vector mode-string))
7736 (owner-read (aref mode-chars 1))
7737 (owner-write (aref mode-chars 2))
7738 (owner-execute-or-setid (aref mode-chars 3))
7739 (group-read (aref mode-chars 4))
7740 (group-write (aref mode-chars 5))
7741 (group-execute-or-setid (aref mode-chars 6))
7742 (other-read (aref mode-chars 7))
7743 (other-write (aref mode-chars 8))
7744 (other-execute-or-sticky (aref mode-chars 9)))
7745 (save-match-data
7746 (logior
7747 (cond
7748 ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
7749 ((char-equal owner-read ?-) 0)
7750 (t (error "Second char `%c' must be one of `r-'" owner-read)))
7751 (cond
7752 ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
7753 ((char-equal owner-write ?-) 0)
7754 (t (error "Third char `%c' must be one of `w-'" owner-write)))
7755 (cond
7756 ((char-equal owner-execute-or-setid ?x)
7757 (tramp-octal-to-decimal "00100"))
7758 ((char-equal owner-execute-or-setid ?S)
7759 (tramp-octal-to-decimal "04000"))
7760 ((char-equal owner-execute-or-setid ?s)
7761 (tramp-octal-to-decimal "04100"))
7762 ((char-equal owner-execute-or-setid ?-) 0)
7763 (t (error "Fourth char `%c' must be one of `xsS-'"
7764 owner-execute-or-setid)))
7765 (cond
7766 ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
7767 ((char-equal group-read ?-) 0)
7768 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
7769 (cond
7770 ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
7771 ((char-equal group-write ?-) 0)
7772 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
7773 (cond
7774 ((char-equal group-execute-or-setid ?x)
7775 (tramp-octal-to-decimal "00010"))
7776 ((char-equal group-execute-or-setid ?S)
7777 (tramp-octal-to-decimal "02000"))
7778 ((char-equal group-execute-or-setid ?s)
7779 (tramp-octal-to-decimal "02010"))
7780 ((char-equal group-execute-or-setid ?-) 0)
7781 (t (error "Seventh char `%c' must be one of `xsS-'"
7782 group-execute-or-setid)))
7783 (cond
7784 ((char-equal other-read ?r)
7785 (tramp-octal-to-decimal "00004"))
7786 ((char-equal other-read ?-) 0)
7787 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
7788 (cond
7789 ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
7790 ((char-equal other-write ?-) 0)
7791 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
7792 (cond
7793 ((char-equal other-execute-or-sticky ?x)
7794 (tramp-octal-to-decimal "00001"))
7795 ((char-equal other-execute-or-sticky ?T)
7796 (tramp-octal-to-decimal "01000"))
7797 ((char-equal other-execute-or-sticky ?t)
7798 (tramp-octal-to-decimal "01001"))
7799 ((char-equal other-execute-or-sticky ?-) 0)
7800 (t (error "Tenth char `%c' must be one of `xtT-'"
7801 other-execute-or-sticky)))))))
7802
7803 (defun tramp-convert-file-attributes (vec attr)
7804 "Convert file-attributes ATTR generated by perl script, stat or ls.
7805 Convert file mode bits to string and set virtual device number.
7806 Return ATTR."
7807 (when attr
7808 ;; Convert last access time.
7809 (unless (listp (nth 4 attr))
7810 (setcar (nthcdr 4 attr)
7811 (list (floor (nth 4 attr) 65536)
7812 (floor (mod (nth 4 attr) 65536)))))
7813 ;; Convert last modification time.
7814 (unless (listp (nth 5 attr))
7815 (setcar (nthcdr 5 attr)
7816 (list (floor (nth 5 attr) 65536)
7817 (floor (mod (nth 5 attr) 65536)))))
7818 ;; Convert last status change time.
7819 (unless (listp (nth 6 attr))
7820 (setcar (nthcdr 6 attr)
7821 (list (floor (nth 6 attr) 65536)
7822 (floor (mod (nth 6 attr) 65536)))))
7823 ;; Convert file size.
7824 (when (< (nth 7 attr) 0)
7825 (setcar (nthcdr 7 attr) -1))
7826 (when (and (floatp (nth 7 attr))
7827 (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
7828 (setcar (nthcdr 7 attr) (round (nth 7 attr))))
7829 ;; Convert file mode bits to string.
7830 (unless (stringp (nth 8 attr))
7831 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
7832 (when (stringp (car attr))
7833 (aset (nth 8 attr) 0 ?l)))
7834 ;; Convert directory indication bit.
7835 (when (string-match "^d" (nth 8 attr))
7836 (setcar attr t))
7837 ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
7838 (when (consp (car attr))
7839 (if (and (stringp (caar attr))
7840 (string-match ".+ -> .\\(.+\\)." (caar attr)))
7841 (setcar attr (match-string 1 (caar attr)))
7842 (setcar attr nil)))
7843 ;; Set file's gid change bit.
7844 (setcar (nthcdr 9 attr)
7845 (if (numberp (nth 3 attr))
7846 (not (= (nth 3 attr)
7847 (tramp-get-remote-gid vec 'integer)))
7848 (not (string-equal
7849 (nth 3 attr)
7850 (tramp-get-remote-gid vec 'string)))))
7851 ;; Convert inode.
7852 (unless (listp (nth 10 attr))
7853 (setcar (nthcdr 10 attr)
7854 (condition-case nil
7855 (cons (floor (nth 10 attr) 65536)
7856 (floor (mod (nth 10 attr) 65536)))
7857 ;; Inodes can be incredible huge. We must hide this.
7858 (error (tramp-get-inode vec)))))
7859 ;; Set virtual device number.
7860 (setcar (nthcdr 11 attr)
7861 (tramp-get-device vec))
7862 attr))
7863
7864 (defun tramp-check-cached-permissions (vec access)
7865 "Check `file-attributes' caches for VEC.
7866 Return t if according to the cache access type ACCESS is known to
7867 be granted."
7868 (let ((result nil)
7869 (offset (cond
7870 ((eq ?r access) 1)
7871 ((eq ?w access) 2)
7872 ((eq ?x access) 3))))
7873 (dolist (suffix '("string" "integer") result)
7874 (setq
7875 result
7876 (or
7877 result
7878 (let ((file-attr
7879 (tramp-get-file-property
7880 vec (tramp-file-name-localname vec)
7881 (concat "file-attributes-" suffix) nil))
7882 (remote-uid
7883 (tramp-get-connection-property
7884 vec (concat "uid-" suffix) nil))
7885 (remote-gid
7886 (tramp-get-connection-property
7887 vec (concat "gid-" suffix) nil)))
7888 (and
7889 file-attr
7890 (or
7891 ;; Not a symlink
7892 (eq t (car file-attr))
7893 (null (car file-attr)))
7894 (or
7895 ;; World accessible.
7896 (eq access (aref (nth 8 file-attr) (+ offset 6)))
7897 ;; User accessible and owned by user.
7898 (and
7899 (eq access (aref (nth 8 file-attr) offset))
7900 (equal remote-uid (nth 2 file-attr)))
7901 ;; Group accessible and owned by user's
7902 ;; principal group.
7903 (and
7904 (eq access (aref (nth 8 file-attr) (+ offset 3)))
7905 (equal remote-gid (nth 3 file-attr)))))))))))
7906
7907 (defun tramp-get-inode (vec)
7908 "Returns the virtual inode number.
7909 If it doesn't exist, generate a new one."
7910 (let ((string (tramp-make-tramp-file-name
7911 (tramp-file-name-method vec)
7912 (tramp-file-name-user vec)
7913 (tramp-file-name-host vec)
7914 "")))
7915 (unless (assoc string tramp-inodes)
7916 (add-to-list 'tramp-inodes
7917 (list string (length tramp-inodes))))
7918 (nth 1 (assoc string tramp-inodes))))
7919
7920 (defun tramp-get-device (vec)
7921 "Returns the virtual device number.
7922 If it doesn't exist, generate a new one."
7923 (let ((string (tramp-make-tramp-file-name
7924 (tramp-file-name-method vec)
7925 (tramp-file-name-user vec)
7926 (tramp-file-name-host vec)
7927 "")))
7928 (unless (assoc string tramp-devices)
7929 (add-to-list 'tramp-devices
7930 (list string (length tramp-devices))))
7931 (cons -1 (nth 1 (assoc string tramp-devices)))))
7932
7933 (defun tramp-file-mode-from-int (mode)
7934 "Turn an integer representing a file mode into an ls(1)-like string."
7935 (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
7936 (user (logand (lsh mode -6) 7))
7937 (group (logand (lsh mode -3) 7))
7938 (other (logand (lsh mode -0) 7))
7939 (suid (> (logand (lsh mode -9) 4) 0))
7940 (sgid (> (logand (lsh mode -9) 2) 0))
7941 (sticky (> (logand (lsh mode -9) 1) 0)))
7942 (setq user (tramp-file-mode-permissions user suid "s"))
7943 (setq group (tramp-file-mode-permissions group sgid "s"))
7944 (setq other (tramp-file-mode-permissions other sticky "t"))
7945 (concat type user group other)))
7946
7947 (defun tramp-file-mode-permissions (perm suid suid-text)
7948 "Convert a permission bitset into a string.
7949 This is used internally by `tramp-file-mode-from-int'."
7950 (let ((r (> (logand perm 4) 0))
7951 (w (> (logand perm 2) 0))
7952 (x (> (logand perm 1) 0)))
7953 (concat (or (and r "r") "-")
7954 (or (and w "w") "-")
7955 (or (and suid x suid-text) ; suid, execute
7956 (and suid (upcase suid-text)) ; suid, !execute
7957 (and x "x") "-")))) ; !suid
7958
7959 (defun tramp-decimal-to-octal (i)
7960 "Return a string consisting of the octal digits of I.
7961 Not actually used. Use `(format \"%o\" i)' instead?"
7962 (cond ((< i 0) (error "Cannot convert negative number to octal"))
7963 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
7964 ((zerop i) "0")
7965 (t (concat (tramp-decimal-to-octal (/ i 8))
7966 (number-to-string (% i 8))))))
7967
7968 ;; Kudos to Gerd Moellmann for this suggestion.
7969 (defun tramp-octal-to-decimal (ostr)
7970 "Given a string of octal digits, return a decimal number."
7971 (let ((x (or ostr "")))
7972 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
7973 (unless (string-match "\\`[0-7]*\\'" x)
7974 (error "Non-octal junk in string `%s'" x))
7975 (string-to-number ostr 8)))
7976
7977 (defun tramp-shell-case-fold (string)
7978 "Converts STRING to shell glob pattern which ignores case."
7979 (mapconcat
7980 (lambda (c)
7981 (if (equal (downcase c) (upcase c))
7982 (vector c)
7983 (format "[%c%c]" (downcase c) (upcase c))))
7984 string
7985 ""))
7986
7987
7988 ;; ------------------------------------------------------------
7989 ;; -- Tramp file names --
7990 ;; ------------------------------------------------------------
7991 ;; Conversion functions between external representation and
7992 ;; internal data structure. Convenience functions for internal
7993 ;; data structure.
7994
7995 (defun tramp-file-name-p (vec)
7996 "Check, whether VEC is a Tramp object."
7997 (and (vectorp vec) (= 4 (length vec))))
7998
7999 (defun tramp-file-name-method (vec)
8000 "Return method component of VEC."
8001 (and (tramp-file-name-p vec) (aref vec 0)))
8002
8003 (defun tramp-file-name-user (vec)
8004 "Return user component of VEC."
8005 (and (tramp-file-name-p vec) (aref vec 1)))
8006
8007 (defun tramp-file-name-host (vec)
8008 "Return host component of VEC."
8009 (and (tramp-file-name-p vec) (aref vec 2)))
8010
8011 (defun tramp-file-name-localname (vec)
8012 "Return localname component of VEC."
8013 (and (tramp-file-name-p vec) (aref vec 3)))
8014
8015 ;; The user part of a Tramp file name vector can be of kind
8016 ;; "user%domain". Sometimes, we must extract these parts.
8017 (defun tramp-file-name-real-user (vec)
8018 "Return the user name of VEC without domain."
8019 (save-match-data
8020 (let ((user (tramp-file-name-user vec)))
8021 (if (and (stringp user)
8022 (string-match tramp-user-with-domain-regexp user))
8023 (match-string 1 user)
8024 user))))
8025
8026 (defun tramp-file-name-domain (vec)
8027 "Return the domain name of VEC."
8028 (save-match-data
8029 (let ((user (tramp-file-name-user vec)))
8030 (and (stringp user)
8031 (string-match tramp-user-with-domain-regexp user)
8032 (match-string 2 user)))))
8033
8034 ;; The host part of a Tramp file name vector can be of kind
8035 ;; "host#port". Sometimes, we must extract these parts.
8036 (defun tramp-file-name-real-host (vec)
8037 "Return the host name of VEC without port."
8038 (save-match-data
8039 (let ((host (tramp-file-name-host vec)))
8040 (if (and (stringp host)
8041 (string-match tramp-host-with-port-regexp host))
8042 (match-string 1 host)
8043 host))))
8044
8045 (defun tramp-file-name-port (vec)
8046 "Return the port number of VEC."
8047 (save-match-data
8048 (let ((host (tramp-file-name-host vec)))
8049 (and (stringp host)
8050 (string-match tramp-host-with-port-regexp host)
8051 (string-to-number (match-string 2 host))))))
8052
8053 (defun tramp-tramp-file-p (name)
8054 "Return t if NAME is a string with Tramp file name syntax."
8055 (save-match-data
8056 (and (stringp name) (string-match tramp-file-name-regexp name))))
8057
8058 (defun tramp-find-method (method user host)
8059 "Return the right method string to use.
8060 This is METHOD, if non-nil. Otherwise, do a lookup in
8061 `tramp-default-method-alist'."
8062 (or method
8063 (let ((choices tramp-default-method-alist)
8064 lmethod item)
8065 (while choices
8066 (setq item (pop choices))
8067 (when (and (string-match (or (nth 0 item) "") (or host ""))
8068 (string-match (or (nth 1 item) "") (or user "")))
8069 (setq lmethod (nth 2 item))
8070 (setq choices nil)))
8071 lmethod)
8072 tramp-default-method))
8073
8074 (defun tramp-find-user (method user host)
8075 "Return the right user string to use.
8076 This is USER, if non-nil. Otherwise, do a lookup in
8077 `tramp-default-user-alist'."
8078 (or user
8079 (let ((choices tramp-default-user-alist)
8080 luser item)
8081 (while choices
8082 (setq item (pop choices))
8083 (when (and (string-match (or (nth 0 item) "") (or method ""))
8084 (string-match (or (nth 1 item) "") (or host "")))
8085 (setq luser (nth 2 item))
8086 (setq choices nil)))
8087 luser)
8088 tramp-default-user))
8089
8090 (defun tramp-find-host (method user host)
8091 "Return the right host string to use.
8092 This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
8093 (or (and (> (length host) 0) host)
8094 tramp-default-host))
8095
8096 (defun tramp-dissect-file-name (name &optional nodefault)
8097 "Return a `tramp-file-name' structure.
8098 The structure consists of remote method, remote user, remote host
8099 and localname (file name on remote host). If NODEFAULT is
8100 non-nil, the file name parts are not expanded to their default
8101 values."
8102 (save-match-data
8103 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
8104 (unless match (error "Not a Tramp file name: %s" name))
8105 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
8106 (user (match-string (nth 2 tramp-file-name-structure) name))
8107 (host (match-string (nth 3 tramp-file-name-structure) name))
8108 (localname (match-string (nth 4 tramp-file-name-structure) name)))
8109 (when (member method '("multi" "multiu"))
8110 (error
8111 "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
8112 method))
8113 (when host
8114 (when (string-match tramp-prefix-ipv6-regexp host)
8115 (setq host (replace-match "" nil t host)))
8116 (when (string-match tramp-postfix-ipv6-regexp host)
8117 (setq host (replace-match "" nil t host))))
8118 (if nodefault
8119 (vector method user host localname)
8120 (vector
8121 (tramp-find-method method user host)
8122 (tramp-find-user method user host)
8123 (tramp-find-host method user host)
8124 localname))))))
8125
8126 (defun tramp-equal-remote (file1 file2)
8127 "Check, whether the remote parts of FILE1 and FILE2 are identical.
8128 The check depends on method, user and host name of the files. If
8129 one of the components is missing, the default values are used.
8130 The local file name parts of FILE1 and FILE2 are not taken into
8131 account.
8132
8133 Example:
8134
8135 (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
8136
8137 would yield `t'. On the other hand, the following check results in nil:
8138
8139 (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
8140 (and (stringp (file-remote-p file1))
8141 (stringp (file-remote-p file2))
8142 (string-equal (file-remote-p file1) (file-remote-p file2))))
8143
8144 (defun tramp-make-tramp-file-name (method user host localname)
8145 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
8146 (concat tramp-prefix-format
8147 (when (not (zerop (length method)))
8148 (concat method tramp-postfix-method-format))
8149 (when (not (zerop (length user)))
8150 (concat user tramp-postfix-user-format))
8151 (when host
8152 (if (string-match tramp-ipv6-regexp host)
8153 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8154 host))
8155 tramp-postfix-host-format
8156 (when localname localname)))
8157
8158 (defun tramp-completion-make-tramp-file-name (method user host localname)
8159 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
8160 It must not be a complete Tramp file name, but as long as there are
8161 necessary only. This function will be used in file name completion."
8162 (concat tramp-prefix-format
8163 (when (not (zerop (length method)))
8164 (concat method tramp-postfix-method-format))
8165 (when (not (zerop (length user)))
8166 (concat user tramp-postfix-user-format))
8167 (when (not (zerop (length host)))
8168 (concat
8169 (if (string-match tramp-ipv6-regexp host)
8170 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8171 host)
8172 tramp-postfix-host-format))
8173 (when localname localname)))
8174
8175 (defun tramp-make-copy-program-file-name (vec)
8176 "Create a file name suitable to be passed to `rcp' and workalikes."
8177 (let ((user (tramp-file-name-user vec))
8178 (host (tramp-file-name-real-host vec))
8179 (localname (tramp-shell-quote-argument
8180 (tramp-file-name-localname vec))))
8181 (if (not (zerop (length user)))
8182 (format "%s@%s:%s" user host localname)
8183 (format "%s:%s" host localname))))
8184
8185 (defun tramp-method-out-of-band-p (vec size)
8186 "Return t if this is an out-of-band method, nil otherwise."
8187 (and
8188 ;; It shall be an out-of-band method.
8189 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
8190 ;; Either the file size is large enough, or (in rare cases) there
8191 ;; does not exist a remote encoding.
8192 (or (null tramp-copy-size-limit)
8193 (> size tramp-copy-size-limit)
8194 (null (tramp-get-inline-coding vec "remote-encoding" size)))))
8195
8196 (defun tramp-local-host-p (vec)
8197 "Return t if this points to the local host, nil otherwise."
8198 ;; We cannot use `tramp-file-name-real-host'. A port is an
8199 ;; indication for an ssh tunnel or alike.
8200 (let ((host (tramp-file-name-host vec)))
8201 (and
8202 (stringp host)
8203 (string-match tramp-local-host-regexp host)
8204 ;; The method shall be applied to one of the shell file name
8205 ;; handler. `tramp-local-host-p' is also called for "smb" and
8206 ;; alike, where it must fail.
8207 (tramp-get-method-parameter
8208 (tramp-file-name-method vec) 'tramp-login-program)
8209 ;; The local temp directory must be writable for the other user.
8210 (file-writable-p
8211 (tramp-make-tramp-file-name
8212 (tramp-file-name-method vec)
8213 (tramp-file-name-user vec)
8214 host
8215 (tramp-compat-temporary-file-directory)))
8216 ;; On some systems, chown runs only for root.
8217 (or (zerop (user-uid))
8218 (zerop (tramp-get-remote-uid vec 'integer))))))
8219
8220 ;; Variables local to connection.
8221
8222 (defun tramp-get-remote-path (vec)
8223 (with-connection-property
8224 ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
8225 ;; cache the result for the session only. Otherwise, the result
8226 ;; is cached persistently.
8227 (if (memq 'tramp-own-remote-path tramp-remote-path)
8228 (tramp-get-connection-process vec)
8229 vec)
8230 "remote-path"
8231 (let* ((remote-path (copy-tree tramp-remote-path))
8232 (elt1 (memq 'tramp-default-remote-path remote-path))
8233 (elt2 (memq 'tramp-own-remote-path remote-path))
8234 (default-remote-path
8235 (when elt1
8236 (condition-case nil
8237 (tramp-send-command-and-read
8238 vec "echo \\\"`getconf PATH`\\\"")
8239 ;; Default if "getconf" is not available.
8240 (error
8241 (tramp-message
8242 vec 3
8243 "`getconf PATH' not successful, using default value \"%s\"."
8244 "/bin:/usr/bin")
8245 "/bin:/usr/bin"))))
8246 (own-remote-path
8247 (when elt2
8248 (condition-case nil
8249 (tramp-send-command-and-read vec "echo \\\"$PATH\\\"")
8250 ;; Default if "getconf" is not available.
8251 (error
8252 (tramp-message
8253 vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.")
8254 nil)))))
8255
8256 ;; Replace place holder `tramp-default-remote-path'.
8257 (when elt1
8258 (setcdr elt1
8259 (append
8260 (tramp-compat-split-string default-remote-path ":")
8261 (cdr elt1)))
8262 (setq remote-path (delq 'tramp-default-remote-path remote-path)))
8263
8264 ;; Replace place holder `tramp-own-remote-path'.
8265 (when elt2
8266 (setcdr elt2
8267 (append
8268 (tramp-compat-split-string own-remote-path ":")
8269 (cdr elt2)))
8270 (setq remote-path (delq 'tramp-own-remote-path remote-path)))
8271
8272 ;; Remove double entries.
8273 (setq elt1 remote-path)
8274 (while (consp elt1)
8275 (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
8276 (setcar elt2 nil))
8277 (setq elt1 (cdr elt1)))
8278
8279 ;; Remove non-existing directories.
8280 (delq
8281 nil
8282 (mapcar
8283 (lambda (x)
8284 (and
8285 (stringp x)
8286 (file-directory-p
8287 (tramp-make-tramp-file-name
8288 (tramp-file-name-method vec)
8289 (tramp-file-name-user vec)
8290 (tramp-file-name-host vec)
8291 x))
8292 x))
8293 remote-path)))))
8294
8295 (defun tramp-get-remote-tmpdir (vec)
8296 (with-connection-property vec "tmp-directory"
8297 (let ((dir (tramp-shell-quote-argument "/tmp")))
8298 (if (and (zerop
8299 (tramp-send-command-and-check
8300 vec (format "%s -d %s" (tramp-get-test-command vec) dir)))
8301 (zerop
8302 (tramp-send-command-and-check
8303 vec (format "%s -w %s" (tramp-get-test-command vec) dir))))
8304 dir
8305 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
8306
8307 (defun tramp-get-ls-command (vec)
8308 (with-connection-property vec "ls"
8309 (tramp-message vec 5 "Finding a suitable `ls' command")
8310 (or
8311 (catch 'ls-found
8312 (dolist (cmd '("ls" "gnuls" "gls"))
8313 (let ((dl (tramp-get-remote-path vec))
8314 result)
8315 (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
8316 ;; Check parameters. On busybox, "ls" output coloring is
8317 ;; enabled by default sometimes. So we try to disable it
8318 ;; when possible. $LS_COLORING is not supported there.
8319 (when (zerop (tramp-send-command-and-check
8320 vec (format "%s -lnd /" result)))
8321 (when (zerop (tramp-send-command-and-check
8322 vec (format "%s --color=never /" result)))
8323 (setq result (concat result " --color=never")))
8324 (throw 'ls-found result))
8325 (setq dl (cdr dl))))))
8326 (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
8327
8328 (defun tramp-get-ls-command-with-dired (vec)
8329 (save-match-data
8330 (with-connection-property vec "ls-dired"
8331 (tramp-message vec 5 "Checking, whether `ls --dired' works")
8332 (zerop (tramp-send-command-and-check
8333 vec (format "%s --dired /" (tramp-get-ls-command vec)))))))
8334
8335 (defun tramp-get-test-command (vec)
8336 (with-connection-property vec "test"
8337 (tramp-message vec 5 "Finding a suitable `test' command")
8338 (if (zerop (tramp-send-command-and-check vec "test 0"))
8339 "test"
8340 (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
8341
8342 (defun tramp-get-test-nt-command (vec)
8343 ;; Does `test A -nt B' work? Use abominable `find' construct if it
8344 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
8345 ;; for otherwise the shell crashes.
8346 (with-connection-property vec "test-nt"
8347 (or
8348 (progn
8349 (tramp-send-command
8350 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
8351 (with-current-buffer (tramp-get-buffer vec)
8352 (goto-char (point-min))
8353 (when (looking-at (regexp-quote tramp-end-of-output))
8354 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
8355 (progn
8356 (tramp-send-command
8357 vec
8358 (format
8359 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
8360 (tramp-get-test-command vec)))
8361 "tramp_test_nt %s %s"))))
8362
8363 (defun tramp-get-file-exists-command (vec)
8364 (with-connection-property vec "file-exists"
8365 (tramp-message vec 5 "Finding command to check if file exists")
8366 (tramp-find-file-exists-command vec)))
8367
8368 (defun tramp-get-remote-ln (vec)
8369 (with-connection-property vec "ln"
8370 (tramp-message vec 5 "Finding a suitable `ln' command")
8371 (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
8372
8373 (defun tramp-get-remote-perl (vec)
8374 (with-connection-property vec "perl"
8375 (tramp-message vec 5 "Finding a suitable `perl' command")
8376 (let ((result
8377 (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
8378 (tramp-find-executable
8379 vec "perl" (tramp-get-remote-path vec)))))
8380 ;; We must check also for some Perl modules.
8381 (when result
8382 (with-connection-property vec "perl-file-spec"
8383 (zerop
8384 (tramp-send-command-and-check
8385 vec (format "%s -e 'use File::Spec;'" result))))
8386 (with-connection-property vec "perl-cwd-realpath"
8387 (zerop
8388 (tramp-send-command-and-check
8389 vec (format "%s -e 'use Cwd \"realpath\";'" result)))))
8390 result)))
8391
8392 (defun tramp-get-remote-stat (vec)
8393 (with-connection-property vec "stat"
8394 (tramp-message vec 5 "Finding a suitable `stat' command")
8395 (let ((result (tramp-find-executable
8396 vec "stat" (tramp-get-remote-path vec)))
8397 tmp)
8398 ;; Check whether stat(1) returns usable syntax. %s does not
8399 ;; work on older AIX systems.
8400 (when result
8401 (setq tmp
8402 ;; We don't want to display an error message.
8403 (with-temp-message (or (current-message) "")
8404 (condition-case nil
8405 (tramp-send-command-and-read
8406 vec (format "%s -c '(\"%%N\" %%s)' /" result))
8407 (error nil))))
8408 (unless (and (listp tmp) (stringp (car tmp))
8409 (string-match "^./.$" (car tmp))
8410 (integerp (cadr tmp)))
8411 (setq result nil)))
8412 result)))
8413
8414 (defun tramp-get-remote-readlink (vec)
8415 (with-connection-property vec "readlink"
8416 (tramp-message vec 5 "Finding a suitable `readlink' command")
8417 (let ((result (tramp-find-executable
8418 vec "readlink" (tramp-get-remote-path vec))))
8419 (when (and result
8420 ;; We don't want to display an error message.
8421 (with-temp-message (or (current-message) "")
8422 (condition-case nil
8423 (zerop
8424 (tramp-send-command-and-check
8425 vec (format "%s --canonicalize-missing /" result)))
8426 (error nil))))
8427 result))))
8428
8429 (defun tramp-get-remote-trash (vec)
8430 (with-connection-property vec "trash"
8431 (tramp-message vec 5 "Finding a suitable `trash' command")
8432 (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
8433
8434 (defun tramp-get-remote-id (vec)
8435 (with-connection-property vec "id"
8436 (tramp-message vec 5 "Finding POSIX `id' command")
8437 (or
8438 (catch 'id-found
8439 (let ((dl (tramp-get-remote-path vec))
8440 result)
8441 (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
8442 ;; Check POSIX parameter.
8443 (when (zerop (tramp-send-command-and-check
8444 vec (format "%s -u" result)))
8445 (throw 'id-found result))
8446 (setq dl (cdr dl)))))
8447 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
8448
8449 (defun tramp-get-remote-uid (vec id-format)
8450 (with-connection-property vec (format "uid-%s" id-format)
8451 (let ((res (tramp-send-command-and-read
8452 vec
8453 (format "%s -u%s %s"
8454 (tramp-get-remote-id vec)
8455 (if (equal id-format 'integer) "" "n")
8456 (if (equal id-format 'integer)
8457 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8458 ;; The command might not always return a number.
8459 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8460
8461 (defun tramp-get-remote-gid (vec id-format)
8462 (with-connection-property vec (format "gid-%s" id-format)
8463 (let ((res (tramp-send-command-and-read
8464 vec
8465 (format "%s -g%s %s"
8466 (tramp-get-remote-id vec)
8467 (if (equal id-format 'integer) "" "n")
8468 (if (equal id-format 'integer)
8469 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8470 ;; The command might not always return a number.
8471 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8472
8473 (defun tramp-get-local-uid (id-format)
8474 (if (equal id-format 'integer) (user-uid) (user-login-name)))
8475
8476 (defun tramp-get-local-gid (id-format)
8477 (nth 3 (tramp-compat-file-attributes "~/" id-format)))
8478
8479 ;; Some predefined connection properties.
8480 (defun tramp-get-inline-compress (vec prop size)
8481 "Return the compress command related to PROP.
8482 PROP is either `inline-compress' or `inline-decompress'. SIZE is
8483 the length of the file to be compressed.
8484
8485 If no corresponding command is found, nil is returned."
8486 (when (and (integerp tramp-inline-compress-start-size)
8487 (> size tramp-inline-compress-start-size))
8488 (with-connection-property vec prop
8489 (tramp-find-inline-compress vec)
8490 (tramp-get-connection-property vec prop nil))))
8491
8492 (defun tramp-get-inline-coding (vec prop size)
8493 "Return the coding command related to PROP.
8494 PROP is either `remote-encoding', `remode-decoding',
8495 `local-encoding' or `local-decoding'.
8496
8497 SIZE is the length of the file to be coded. Depending on SIZE,
8498 compression might be applied.
8499
8500 If no corresponding command is found, nil is returned.
8501 Otherwise, either a string is returned which contains a `%s' mark
8502 to be used for the respective input or output file; or a Lisp
8503 function cell is returned to be applied on a buffer."
8504 (let ((coding
8505 (with-connection-property vec prop
8506 (tramp-find-inline-encoding vec)
8507 (tramp-get-connection-property vec prop nil)))
8508 (prop1 (if (string-match "encoding" prop)
8509 "inline-compress" "inline-decompress"))
8510 compress)
8511 ;; The connection property might have been cached. So we must send
8512 ;; the script to the remote side - maybe.
8513 (when (and coding (symbolp coding) (string-match "remote" prop))
8514 (let ((name (symbol-name coding)))
8515 (while (string-match (regexp-quote "-") name)
8516 (setq name (replace-match "_" nil t name)))
8517 (tramp-maybe-send-script vec (symbol-value coding) name)
8518 (setq coding name)))
8519 (when coding
8520 ;; Check for the `compress' command.
8521 (setq compress (tramp-get-inline-compress vec prop1 size))
8522 ;; Return the value.
8523 (cond
8524 ((and compress (symbolp coding))
8525 (if (string-match "decompress" prop1)
8526 `(lambda (beg end)
8527 (,coding beg end)
8528 (let ((coding-system-for-write 'binary)
8529 (coding-system-for-read 'binary))
8530 (apply
8531 'call-process-region (point-min) (point-max)
8532 (car (split-string ,compress)) t t nil
8533 (cdr (split-string ,compress)))))
8534 `(lambda (beg end)
8535 (let ((coding-system-for-write 'binary)
8536 (coding-system-for-read 'binary))
8537 (apply
8538 'call-process-region beg end
8539 (car (split-string ,compress)) t t nil
8540 (cdr (split-string ,compress))))
8541 (,coding (point-min) (point-max)))))
8542 ((symbolp coding)
8543 coding)
8544 ((and compress (string-match "decoding" prop))
8545 (format "(%s | %s >%%s)" coding compress))
8546 (compress
8547 (format "(%s <%%s | %s)" compress coding))
8548 ((string-match "decoding" prop)
8549 (format "%s >%%s" coding))
8550 (t
8551 (format "%s <%%s" coding))))))
8552
8553 (defun tramp-get-method-parameter (method param)
8554 "Return the method parameter PARAM.
8555 If the `tramp-methods' entry does not exist, return nil."
8556 (let ((entry (assoc param (assoc method tramp-methods))))
8557 (when entry (cadr entry))))
8558
8559 ;; Auto saving to a special directory.
8560
8561 (defun tramp-exists-file-name-handler (operation &rest args)
8562 "Check, whether OPERATION runs a file name handler."
8563 ;; The file name handler is determined on base of either an
8564 ;; argument, `buffer-file-name', or `default-directory'.
8565 (condition-case nil
8566 (let* ((buffer-file-name "/")
8567 (default-directory "/")
8568 (fnha file-name-handler-alist)
8569 (check-file-name-operation operation)
8570 (file-name-handler-alist
8571 (list
8572 (cons "/"
8573 (lambda (operation &rest args)
8574 "Returns OPERATION if it is the one to be checked."
8575 (if (equal check-file-name-operation operation)
8576 operation
8577 (let ((file-name-handler-alist fnha))
8578 (apply operation args))))))))
8579 (equal (apply operation args) operation))
8580 (error nil)))
8581
8582 (unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
8583 (defadvice make-auto-save-file-name
8584 (around tramp-advice-make-auto-save-file-name () activate)
8585 "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files."
8586 (if (tramp-tramp-file-p (buffer-file-name))
8587 ;; We cannot call `tramp-handle-make-auto-save-file-name'
8588 ;; directly, because this would bypass the locking mechanism.
8589 (setq ad-return-value
8590 (tramp-file-name-handler 'make-auto-save-file-name))
8591 ad-do-it))
8592 (add-hook
8593 'tramp-unload-hook
8594 (lambda ()
8595 (ad-remove-advice
8596 'make-auto-save-file-name
8597 'around 'tramp-advice-make-auto-save-file-name)
8598 (ad-activate 'make-auto-save-file-name))))
8599
8600 ;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus
8601 ;; umask. This is a security threat.
8602
8603 (defun tramp-set-auto-save-file-modes ()
8604 "Set permissions of autosaved remote files to the original permissions."
8605 (let ((bfn (buffer-file-name)))
8606 (when (and (tramp-tramp-file-p bfn)
8607 (buffer-modified-p)
8608 (stringp buffer-auto-save-file-name)
8609 (not (equal bfn buffer-auto-save-file-name)))
8610 (unless (file-exists-p buffer-auto-save-file-name)
8611 (write-region "" nil buffer-auto-save-file-name))
8612 ;; Permissions should be set always, because there might be an old
8613 ;; auto-saved file belonging to another original file. This could
8614 ;; be a security threat.
8615 (set-file-modes buffer-auto-save-file-name
8616 (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
8617
8618 (unless (and (featurep 'xemacs)
8619 (= emacs-major-version 21)
8620 (> emacs-minor-version 4))
8621 (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
8622 (add-hook 'tramp-unload-hook
8623 (lambda ()
8624 (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
8625
8626 (defun tramp-subst-strs-in-string (alist string)
8627 "Replace all occurrences of the string FROM with TO in STRING.
8628 ALIST is of the form ((FROM . TO) ...)."
8629 (save-match-data
8630 (while alist
8631 (let* ((pr (car alist))
8632 (from (car pr))
8633 (to (cdr pr)))
8634 (while (string-match (regexp-quote from) string)
8635 (setq string (replace-match to t t string)))
8636 (setq alist (cdr alist))))
8637 string))
8638
8639 ;; ------------------------------------------------------------
8640 ;; -- Compatibility functions section --
8641 ;; ------------------------------------------------------------
8642
8643 (defun tramp-read-passwd (proc &optional prompt)
8644 "Read a password from user (compat function).
8645 Consults the auth-source package.
8646 Invokes `password-read' if available, `read-passwd' else."
8647 (let* ((key (tramp-make-tramp-file-name
8648 tramp-current-method tramp-current-user
8649 tramp-current-host ""))
8650 (pw-prompt
8651 (or prompt
8652 (with-current-buffer (process-buffer proc)
8653 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
8654 (format "%s for %s " (capitalize (match-string 1)) key)))))
8655 (with-parsed-tramp-file-name key nil
8656 (prog1
8657 (or
8658 ;; See if auth-sources contains something useful, if it's bound.
8659 (and (boundp 'auth-sources)
8660 (tramp-get-connection-property v "first-password-request" nil)
8661 ;; Try with Tramp's current method.
8662 (tramp-compat-funcall
8663 'auth-source-user-or-password
8664 "password" tramp-current-host tramp-current-method))
8665 ;; Try the password cache.
8666 (when (functionp 'password-read)
8667 (unless (tramp-get-connection-property
8668 v "first-password-request" nil)
8669 (tramp-compat-funcall 'password-cache-remove key))
8670 (let ((password
8671 (tramp-compat-funcall 'password-read pw-prompt key)))
8672 (tramp-compat-funcall 'password-cache-add key password)
8673 password))
8674 ;; Else, get the password interactively.
8675 (read-passwd pw-prompt))
8676 (tramp-set-connection-property v "first-password-request" nil)))))
8677
8678 (defun tramp-clear-passwd (vec)
8679 "Clear password cache for connection related to VEC."
8680 (tramp-compat-funcall
8681 'password-cache-remove
8682 (tramp-make-tramp-file-name
8683 (tramp-file-name-method vec)
8684 (tramp-file-name-user vec)
8685 (tramp-file-name-host vec)
8686 "")))
8687
8688 ;; Snarfed code from time-date.el and parse-time.el
8689
8690 (defconst tramp-half-a-year '(241 17024)
8691 "Evaluated by \"(days-to-time 183)\".")
8692
8693 (defconst tramp-parse-time-months
8694 '(("jan" . 1) ("feb" . 2) ("mar" . 3)
8695 ("apr" . 4) ("may" . 5) ("jun" . 6)
8696 ("jul" . 7) ("aug" . 8) ("sep" . 9)
8697 ("oct" . 10) ("nov" . 11) ("dec" . 12))
8698 "Alist mapping month names to integers.")
8699
8700 (defun tramp-time-less-p (t1 t2)
8701 "Say whether time value T1 is less than time value T2."
8702 (unless t1 (setq t1 '(0 0)))
8703 (unless t2 (setq t2 '(0 0)))
8704 (or (< (car t1) (car t2))
8705 (and (= (car t1) (car t2))
8706 (< (nth 1 t1) (nth 1 t2)))))
8707
8708 (defun tramp-time-subtract (t1 t2)
8709 "Subtract two time values.
8710 Return the difference in the format of a time value."
8711 (unless t1 (setq t1 '(0 0)))
8712 (unless t2 (setq t2 '(0 0)))
8713 (let ((borrow (< (cadr t1) (cadr t2))))
8714 (list (- (car t1) (car t2) (if borrow 1 0))
8715 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
8716
8717 (defun tramp-time-diff (t1 t2)
8718 "Return the difference between the two times, in seconds.
8719 T1 and T2 are time values (as returned by `current-time' for example)."
8720 ;; Pacify byte-compiler with `symbol-function'.
8721 (cond ((and (fboundp 'subtract-time)
8722 (fboundp 'float-time))
8723 (tramp-compat-funcall
8724 'float-time (tramp-compat-funcall 'subtract-time t1 t2)))
8725 ((and (fboundp 'subtract-time)
8726 (fboundp 'time-to-seconds))
8727 (tramp-compat-funcall
8728 'time-to-seconds (tramp-compat-funcall 'subtract-time t1 t2)))
8729 ((fboundp 'itimer-time-difference)
8730 (tramp-compat-funcall
8731 'itimer-time-difference
8732 (if (< (length t1) 3) (append t1 '(0)) t1)
8733 (if (< (length t2) 3) (append t2 '(0)) t2)))
8734 (t
8735 (let ((time (tramp-time-subtract t1 t2)))
8736 (+ (* (car time) 65536.0)
8737 (cadr time)
8738 (/ (or (nth 2 time) 0) 1000000.0))))))
8739
8740 (defun tramp-coding-system-change-eol-conversion (coding-system eol-type)
8741 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
8742 EOL-TYPE can be one of `dos', `unix', or `mac'."
8743 (cond ((fboundp 'coding-system-change-eol-conversion)
8744 (tramp-compat-funcall
8745 'coding-system-change-eol-conversion coding-system eol-type))
8746 ((fboundp 'subsidiary-coding-system)
8747 (tramp-compat-funcall
8748 'subsidiary-coding-system coding-system
8749 (cond ((eq eol-type 'dos) 'crlf)
8750 ((eq eol-type 'unix) 'lf)
8751 ((eq eol-type 'mac) 'cr)
8752 (t
8753 (error "Unknown EOL-TYPE `%s', must be %s"
8754 eol-type
8755 "`dos', `unix', or `mac'")))))
8756 (t (error "Can't change EOL conversion -- is MULE missing?"))))
8757
8758 (defun tramp-set-process-query-on-exit-flag (process flag)
8759 "Specify if query is needed for process when Emacs is exited.
8760 If the second argument flag is non-nil, Emacs will query the user before
8761 exiting if process is running."
8762 (if (fboundp 'set-process-query-on-exit-flag)
8763 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
8764 (tramp-compat-funcall 'process-kill-without-query process flag)))
8765
8766
8767 ;; ------------------------------------------------------------
8768 ;; -- Kludges section --
8769 ;; ------------------------------------------------------------
8770
8771 ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
8772 ;; does not deal well with newline characters. Newline is replaced by
8773 ;; backslash newline. But if, say, the string `a backslash newline b'
8774 ;; is passed to a shell, the shell will expand this into "ab",
8775 ;; completely omitting the newline. This is not what was intended.
8776 ;; It does not appear to be possible to make the function
8777 ;; `shell-quote-argument' work with newlines without making it
8778 ;; dependent on the shell used. But within this package, we know that
8779 ;; we will always use a Bourne-like shell, so we use an approach which
8780 ;; groks newlines.
8781 ;;
8782 ;; The approach is simple: we call `shell-quote-argument', then
8783 ;; massage the newline part of the result.
8784 ;;
8785 ;; This function should produce a string which is grokked by a Unix
8786 ;; shell, even if the Emacs is running on Windows. Since this is the
8787 ;; kludges section, we bind `system-type' in such a way that
8788 ;; `shell-quote-arguments' behaves as if on Unix.
8789 ;;
8790 ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
8791 ;; function to work with Bourne-like shells.
8792 ;;
8793 ;; CCC: This function should be rewritten so that
8794 ;; `shell-quote-argument' is not used. This way, we are safe from
8795 ;; changes in `shell-quote-argument'.
8796 (defun tramp-shell-quote-argument (s)
8797 "Similar to `shell-quote-argument', but groks newlines.
8798 Only works for Bourne-like shells."
8799 (let ((system-type 'not-windows))
8800 (save-match-data
8801 (let ((result (shell-quote-argument s))
8802 (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
8803 (when (and (>= (length result) 2)
8804 (string= (substring result 0 2) "\\~"))
8805 (setq result (substring result 1)))
8806 (while (string-match nl result)
8807 (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
8808 t t result)))
8809 result))))
8810
8811 ;; Checklist for `tramp-unload-hook'
8812 ;; - Unload all `tramp-*' packages
8813 ;; - Reset `file-name-handler-alist'
8814 ;; - Cleanup hooks where Tramp functions are in
8815 ;; - Cleanup advised functions
8816 ;; - Cleanup autoloads
8817 ;;;###autoload
8818 (defun tramp-unload-tramp ()
8819 "Discard Tramp from loading remote files."
8820 (interactive)
8821 ;; When Tramp is not loaded yet, its autoloads are still active.
8822 (tramp-unload-file-name-handlers)
8823 ;; ange-ftp settings must be enabled.
8824 (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
8825 ;; Maybe its not loaded yet.
8826 (condition-case nil
8827 (unload-feature 'tramp 'force)
8828 (error nil)))
8829
8830 (when (and load-in-progress
8831 (string-match "Loading tramp..." (or (current-message) "")))
8832 (message "Loading tramp...done"))
8833
8834 (provide 'tramp)
8835
8836 ;;; TODO:
8837
8838 ;; * Handle nonlocal exits such as C-g.
8839 ;; * But it would probably be better to use with-local-quit at the
8840 ;; place where it's actually needed: around any potentially
8841 ;; indefinitely blocking piece of code. In this case it would be
8842 ;; within Tramp around one of its calls to accept-process-output (or
8843 ;; around one of the loops that calls accept-process-output)
8844 ;; (Stefan Monnier).
8845 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
8846 ;; `shell-quote-argument'.
8847 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
8848 ;; by the files in that directory. Add this here.
8849 ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
8850 ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
8851 ;; * Case-insensitive filename completion. (Norbert Goevert.)
8852 ;; * Don't use globbing for directories with many files, as this is
8853 ;; likely to produce long command lines, and some shells choke on
8854 ;; long command lines.
8855 ;; * How to deal with MULE in `insert-file-contents' and `write-region'?
8856 ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
8857 ;; * abbreviate-file-name
8858 ;; * Better error checking. At least whenever we see something
8859 ;; strange when doing zerop, we should kill the process and start
8860 ;; again. (Greg Stark)
8861 ;; * Remove unneeded parameters from methods.
8862 ;; * Make it work for different encodings, and for different file name
8863 ;; encodings, too. (Daniel Pittman)
8864 ;; * Don't search for perl5 and perl. Instead, only search for perl and
8865 ;; then look if it's the right version (with `perl -v').
8866 ;; * When editing a remote CVS controlled file as a different user, VC
8867 ;; gets confused about the file locking status. Try to find out why
8868 ;; the workaround doesn't work.
8869 ;; * Username and hostname completion.
8870 ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
8871 ;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
8872 ;; Code is nearly identical.
8873 ;; * Allow out-of-band methods as _last_ multi-hop. Open a connection
8874 ;; until the last but one hop via `start-file-process'. Apply it
8875 ;; also for ftp and smb.
8876 ;; * WIBNI if we had a command "trampclient"? If I was editing in
8877 ;; some shell with root priviledges, it would be nice if I could
8878 ;; just call
8879 ;; trampclient filename.c
8880 ;; as an editor, and the _current_ shell would connect to an Emacs
8881 ;; server and would be used in an existing non-priviledged Emacs
8882 ;; session for doing the editing in question.
8883 ;; That way, I need not tell Emacs my password again and be afraid
8884 ;; that it makes it into core dumps or other ugly stuff (I had Emacs
8885 ;; once display a just typed password in the context of a keyboard
8886 ;; sequence prompt for a question immediately following in a shell
8887 ;; script run within Emacs -- nasty).
8888 ;; And if I have some ssh session running to a different computer,
8889 ;; having the possibility of passing a local file there to a local
8890 ;; Emacs session (in case I can arrange for a connection back) would
8891 ;; be nice.
8892 ;; Likely the corresponding Tramp server should not allow the
8893 ;; equivalent of the emacsclient -eval option in order to make this
8894 ;; reasonably unproblematic. And maybe trampclient should have some
8895 ;; way of passing credentials, like by using an SSL socket or
8896 ;; something. (David Kastrup)
8897 ;; * Reconnect directly to a compliant shell without first going
8898 ;; through the user's default shell. (Pete Forman)
8899 ;; * Make `tramp-default-user' obsolete.
8900 ;; * How can I interrupt the remote process with a signal
8901 ;; (interrupt-process seems not to work)? (Markus Triska)
8902 ;; * Avoid the local shell entirely for starting remote processes. If
8903 ;; so, I think even a signal, when delivered directly to the local
8904 ;; SSH instance, would correctly be propagated to the remote process
8905 ;; automatically; possibly SSH would have to be started with
8906 ;; "-t". (Markus Triska)
8907 ;; * It makes me wonder if tramp couldn't fall back to ssh when scp
8908 ;; isn't on the remote host. (Mark A. Hershberger)
8909 ;; * Use lsh instead of ssh. (Alfred M. Szmidt)
8910 ;; * Implement a general server-local-variable mechanism, as there are
8911 ;; probably other variables that need different values for different
8912 ;; servers too. The user could then configure a variable (such as
8913 ;; tramp-server-local-variable-alist) to define any such variables
8914 ;; that they need to, which would then be let bound as appropriate
8915 ;; in tramp functions. (Jason Rumney)
8916 ;; * Optimize out-of-band copying, when both methods are scp-like (not
8917 ;; rsync).
8918 ;; * Keep a second connection open for out-of-band methods like scp or
8919 ;; rsync.
8920 ;; * Support ptys in `tramp-handle-start-file-process'. (Bug#4604, Bug#6360)
8921 ;; * IMHO, it's a drawback that currently Tramp doesn't support
8922 ;; Unicode in Dired file names by default. Is it possible to
8923 ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
8924 ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
8925 ;; expects only English messages? (Juri Linkov)
8926 ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
8927 ;; * Do not handle files with drive letter as remote. (Bug#5447)
8928 ;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705)
8929 ;; * Try telnet+curl as new method. It might be useful for busybox,
8930 ;; without built-in uuencode/uudecode.
8931 ;; * Let `shell-dynamic-complete-*' and `comint-dynamic-complete' work
8932 ;; on remote hosts.
8933 ;; * Use secrets.el for password handling.
8934 ;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'.
8935
8936 ;; Functions for file-name-handler-alist:
8937 ;; diff-latest-backup-file -- in diff.el
8938
8939 ;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
8940 ;;; tramp.el ends here
8941
8942 ;; Local Variables:
8943 ;; mode: Emacs-Lisp
8944 ;; coding: utf-8
8945 ;; End: