]> code.delx.au - gnu-emacs/blob - lisp/net/tramp.el
Version 2.0.21 released.
[gnu-emacs] / lisp / net / tramp.el
1 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*- coding: iso-8859-1; -*-
2
3 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
4
5 ;; Author: Kai.Grossjohann@CS.Uni-Dortmund.DE
6 ;; Keywords: comm, processes
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;; This package provides remote file editing, similar to ange-ftp.
28 ;; The difference is that ange-ftp uses FTP to transfer files between
29 ;; the local and the remote host, whereas tramp.el uses a combination
30 ;; of rsh and rcp or other work-alike programs, such as ssh/scp.
31 ;;
32 ;; For more detailed instructions, please see the info file, which is
33 ;; included in the file `tramp.tar.gz' mentioned below.
34 ;;
35 ;; Notes:
36 ;; -----
37 ;;
38 ;; This package only works for Emacs 20 and higher, and for XEmacs 21
39 ;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs
40 ;; 19 is reported to have other problems. For XEmacs 21, you need the
41 ;; package `fsf-compat' for the `with-timeout' macro.)
42 ;;
43 ;; This version might not work with pre-Emacs 21 VC unless VC is
44 ;; loaded before tramp.el. Could you please test this and tell me about
45 ;; the result? Thanks.
46 ;;
47 ;; Also see the todo list at the bottom of this file.
48 ;;
49 ;; The current version of tramp.el can be retrieved from the following
50 ;; URL: ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/tramp.tar.gz
51 ;; For your convenience, the *.el file is available separately from
52 ;; the same directory.
53 ;;
54 ;; There's a mailing list for this, as well. Its name is:
55 ;; tramp-devel@mail.freesoftware.fsf.org
56 ;; Send a mail with `help' in the subject (!) to the administration
57 ;; address for instructions on joining the list. The administration
58 ;; address is:
59 ;; tramp-devel-request@mail.freesoftware.fsf.org
60 ;; You can also use the Web to subscribe, under the following URL:
61 ;; http://mail.freesoftware.fsf.org/mailman/listinfo/tramp-devel
62 ;;
63 ;; For the adventurous, the current development sources are available
64 ;; via CVS. You can find instructions about this at the following URL:
65 ;; http://savannah.gnu.org/projects/tramp/
66 ;; Click on "CVS" in the navigation bar near the top.
67 ;;
68 ;; Don't forget to put on your asbestos longjohns, first!
69
70 ;;; Code:
71
72 ;; In the Tramp CVS repository, the version numer is auto-frobbed from
73 ;; the Makefile, so you should edit the top-level Makefile to change
74 ;; the version number.
75 (defconst tramp-version "2.0.21"
76 "This version of tramp.")
77
78 (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
79 "Email address to send bug reports to.")
80
81 (require 'timer)
82 (require 'format-spec) ;from Gnus 5.8, also in tar ball
83 ;; The explicit check is not necessary in Emacs, which provides the
84 ;; feature even if implemented in C, but it appears to be necessary
85 ;; in XEmacs.
86 (unless (and (fboundp 'base64-encode-region)
87 (fboundp 'base64-decode-region))
88 (require 'base64)) ;for the mimencode methods
89 (require 'shell)
90 (require 'advice)
91
92 (autoload 'tramp-uuencode-region "tramp-uu"
93 "Implementation of `uuencode' in Lisp.")
94
95 (unless (fboundp 'uudecode-decode-region)
96 (autoload 'uudecode-decode-region "uudecode"))
97
98 ;; ;; It does not work to load EFS after loading TRAMP.
99 ;; (when (fboundp 'efs-file-handler-function)
100 ;; (require 'efs))
101
102 (eval-when-compile
103 (require 'cl)
104 (require 'custom)
105 ;; Emacs 19.34 compatibility hack -- is this needed?
106 (or (>= emacs-major-version 20)
107 (load "cl-seq")))
108
109 (unless (boundp 'custom-print-functions)
110 (defvar custom-print-functions nil)) ; not autoloaded before Emacs 20.4
111
112 ;; XEmacs is distributed with few Lisp packages. Further packages are
113 ;; installed using EFS. If we use a unified filename format, then
114 ;; Tramp is required in addition to EFS. (But why can't Tramp just
115 ;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
116 ;; just like before.) Another reason for using a separate filename
117 ;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
118 ;; Tramp only knows how to deal with `file-name-handler-alist', not
119 ;; the other places.
120 (defvar tramp-unified-filenames (not (featurep 'xemacs))
121 "Non-nil means to use unified Ange-FTP/Tramp filename syntax.
122 Nil means to use a separate filename syntax for Tramp.")
123
124 ;;; User Customizable Internal Variables:
125
126 (defgroup tramp nil
127 "Edit remote files with a combination of rsh and rcp or similar programs."
128 :group 'files)
129
130 (defcustom tramp-verbose 9
131 "*Verbosity level for tramp.el. 0 means be silent, 10 is most verbose."
132 :group 'tramp
133 :type 'integer)
134
135 (defcustom tramp-debug-buffer nil
136 "*Whether to send all commands and responses to a debug buffer."
137 :group 'tramp
138 :type 'boolean)
139
140 (defcustom tramp-auto-save-directory nil
141 "*Put auto-save files in this directory, if set.
142 The idea is to use a local directory so that auto-saving is faster."
143 :group 'tramp
144 :type '(choice (const nil)
145 string))
146
147 (defcustom tramp-encoding-shell
148 (if (memq system-type '(windows-nt))
149 (getenv "COMSPEC")
150 "/bin/sh")
151 "*Use this program for encoding and decoding commands on the local host.
152 This shell is used to execute the encoding and decoding command on the
153 local host, so if you want to use `~' in those commands, you should
154 choose a shell here which groks tilde expansion. `/bin/sh' normally
155 does not understand tilde expansion.
156
157 For encoding and deocding, commands like the following are executed:
158
159 /bin/sh -c COMMAND < INPUT > OUTPUT
160
161 This variable can be used to change the \"/bin/sh\" part. See the
162 variable `tramp-encoding-command-switch' for the \"-c\" part. Also, see the
163 variable `tramp-encoding-reads-stdin' to specify whether the commands read
164 standard input or a file.
165
166 Note that this variable is not used for remote commands. There are
167 mechanisms in tramp.el which automatically determine the right shell to
168 use for the remote host."
169 :group 'tramp
170 :type '(file :must-match t))
171
172 (defcustom tramp-encoding-command-switch
173 (if (string-match "cmd\\.exe" tramp-encoding-shell)
174 "/c"
175 "-c")
176 "*Use this switch together with `tramp-encoding-shell' for local commands.
177 See the variable `tramp-encoding-shell' for more information."
178 :group 'tramp
179 :type 'string)
180
181 (defcustom tramp-encoding-reads-stdin t
182 "*If non-nil, encoding commands read from standard input.
183 If nil, the filename is the last argument.
184
185 Note that the commands always must write to standard output."
186 :group 'tramp
187 :type 'boolean)
188
189 (defcustom tramp-multi-sh-program
190 tramp-encoding-shell
191 "*Use this program for bootstrapping multi-hop connections.
192 This variable is similar to `tramp-encoding-shell', but it is only used
193 when initializing a multi-hop connection. Therefore, the set of
194 commands sent to this shell is quite restricted, and if you are
195 careful it works to use CMD.EXE under Windows (instead of a Bourne-ish
196 shell which does not normally exist on Windows anyway).
197
198 To use multi-hop methods from Windows, you also need suitable entries
199 in `tramp-multi-connection-function-alist' for the first hop.
200
201 This variable defaults to the value of `tramp-encoding-shell'."
202 :group 'tramp
203 :type '(file :must-match t))
204
205 ;; CCC I have changed all occurrences of comint-quote-filename with
206 ;; tramp-shell-quote-argument, except in tramp-handle-expand-many-files.
207 ;; There, comint-quote-filename was removed altogether. If it turns
208 ;; out to be necessary there, something will need to be done.
209 ;;-(defcustom tramp-file-name-quote-list
210 ;;- '(?] ?[ ?\| ?& ?< ?> ?\( ?\) ?\; ?\ ?\* ?\? ?\! ?\" ?\' ?\` ?# ?\@ ?\+ )
211 ;;- "*Protect these characters from the remote shell.
212 ;;-Any character in this list is quoted (preceded with a backslash)
213 ;;-because it means something special to the shell. This takes effect
214 ;;-when sending file and directory names to the remote shell.
215 ;;-
216 ;;-See `comint-file-name-quote-list' for details."
217 ;;- :group 'tramp
218 ;;- :type '(repeat character))
219
220 (defcustom tramp-methods
221 '( ("rcp" (tramp-connection-function tramp-open-connection-rsh)
222 (tramp-rsh-program "rsh")
223 (tramp-rcp-program "rcp")
224 (tramp-remote-sh "/bin/sh")
225 (tramp-rsh-args nil)
226 (tramp-rcp-args nil)
227 (tramp-rcp-keep-date-arg "-p")
228 (tramp-su-program nil)
229 (tramp-su-args nil)
230 (tramp-telnet-program nil)
231 (tramp-telnet-args nil))
232 ("scp" (tramp-connection-function tramp-open-connection-rsh)
233 (tramp-rsh-program "ssh")
234 (tramp-rcp-program "scp")
235 (tramp-remote-sh "/bin/sh")
236 (tramp-rsh-args ("-e" "none"))
237 (tramp-rcp-args nil)
238 (tramp-rcp-keep-date-arg "-p")
239 (tramp-su-program nil)
240 (tramp-su-args nil)
241 (tramp-telnet-program nil)
242 (tramp-telnet-args nil))
243 ("scp1" (tramp-connection-function tramp-open-connection-rsh)
244 (tramp-rsh-program "ssh")
245 (tramp-rcp-program "scp")
246 (tramp-remote-sh "/bin/sh")
247 (tramp-rsh-args ("-1" "-e" "none"))
248 (tramp-rcp-args ("-1"))
249 (tramp-rcp-keep-date-arg "-p")
250 (tramp-su-program nil)
251 (tramp-su-args nil)
252 (tramp-telnet-program nil)
253 (tramp-telnet-args nil))
254 ("scp2" (tramp-connection-function tramp-open-connection-rsh)
255 (tramp-rsh-program "ssh")
256 (tramp-rcp-program "scp")
257 (tramp-remote-sh "/bin/sh")
258 (tramp-rsh-args ("-2" "-e" "none"))
259 (tramp-rcp-args ("-2"))
260 (tramp-rcp-keep-date-arg "-p")
261 (tramp-su-program nil)
262 (tramp-su-args nil)
263 (tramp-telnet-program nil)
264 (tramp-telnet-args nil))
265 ("scp1-old"
266 (tramp-connection-function tramp-open-connection-rsh)
267 (tramp-rsh-program "ssh1")
268 (tramp-rcp-program "scp1")
269 (tramp-remote-sh "/bin/sh")
270 (tramp-rsh-args ("-e" "none"))
271 (tramp-rcp-args nil)
272 (tramp-rcp-keep-date-arg "-p")
273 (tramp-su-program nil)
274 (tramp-su-args nil)
275 (tramp-telnet-program nil)
276 (tramp-telnet-args nil))
277 ("scp2-old"
278 (tramp-connection-function tramp-open-connection-rsh)
279 (tramp-rsh-program "ssh2")
280 (tramp-rcp-program "scp2")
281 (tramp-remote-sh "/bin/sh")
282 (tramp-rsh-args ("-e" "none"))
283 (tramp-rcp-args nil)
284 (tramp-rcp-keep-date-arg "-p")
285 (tramp-su-program nil)
286 (tramp-su-args nil)
287 (tramp-telnet-program nil)
288 (tramp-telnet-args nil))
289 ("rsync" (tramp-connection-function tramp-open-connection-rsh)
290 (tramp-rsh-program "ssh")
291 (tramp-rcp-program "rsync")
292 (tramp-remote-sh "/bin/sh")
293 (tramp-rsh-args ("-e" "none"))
294 (tramp-rcp-args ("-e" "ssh"))
295 (tramp-rcp-keep-date-arg "-t")
296 (tramp-su-program nil)
297 (tramp-su-args nil)
298 (tramp-telnet-program nil)
299 (tramp-telnet-args nil))
300 ("rsh" (tramp-connection-function tramp-open-connection-rsh)
301 (tramp-rsh-program "rsh")
302 (tramp-rcp-program nil)
303 (tramp-remote-sh "/bin/sh")
304 (tramp-rsh-args nil)
305 (tramp-rcp-args nil)
306 (tramp-rcp-keep-date-arg nil)
307 (tramp-su-program nil)
308 (tramp-su-args nil)
309 (tramp-telnet-program nil)
310 (tramp-telnet-args nil))
311 ("ssh" (tramp-connection-function tramp-open-connection-rsh)
312 (tramp-rsh-program "ssh")
313 (tramp-rcp-program nil)
314 (tramp-remote-sh "/bin/sh")
315 (tramp-rsh-args ("-e" "none"))
316 (tramp-rcp-args nil)
317 (tramp-rcp-keep-date-arg nil)
318 (tramp-su-program nil)
319 (tramp-su-args nil)
320 (tramp-telnet-program nil)
321 (tramp-telnet-args nil))
322 ("ssh1" (tramp-connection-function tramp-open-connection-rsh)
323 (tramp-rsh-program "ssh")
324 (tramp-rcp-program nil)
325 (tramp-remote-sh "/bin/sh")
326 (tramp-rsh-args ("-1" "-e" "none"))
327 (tramp-rcp-args ("-1"))
328 (tramp-rcp-keep-date-arg nil)
329 (tramp-su-program nil)
330 (tramp-su-args nil)
331 (tramp-telnet-program nil)
332 (tramp-telnet-args nil))
333 ("ssh2" (tramp-connection-function tramp-open-connection-rsh)
334 (tramp-rsh-program "ssh")
335 (tramp-rcp-program nil)
336 (tramp-remote-sh "/bin/sh")
337 (tramp-rsh-args ("-2" "-e" "none"))
338 (tramp-rcp-args ("-2"))
339 (tramp-rcp-keep-date-arg nil)
340 (tramp-su-program nil)
341 (tramp-su-args nil)
342 (tramp-telnet-program nil)
343 (tramp-telnet-args nil))
344 ("ssh1-old"
345 (tramp-connection-function tramp-open-connection-rsh)
346 (tramp-rsh-program "ssh1")
347 (tramp-rcp-program nil)
348 (tramp-remote-sh "/bin/sh")
349 (tramp-rsh-args ("-e" "none"))
350 (tramp-rcp-args nil)
351 (tramp-rcp-keep-date-arg nil)
352 (tramp-su-program nil)
353 (tramp-su-args nil)
354 (tramp-telnet-program nil)
355 (tramp-telnet-args nil))
356 ("ssh2-old"
357 (tramp-connection-function tramp-open-connection-rsh)
358 (tramp-rsh-program "ssh2")
359 (tramp-rcp-program nil)
360 (tramp-remote-sh "/bin/sh")
361 (tramp-rsh-args ("-e" "none"))
362 (tramp-rcp-args nil)
363 (tramp-rcp-keep-date-arg nil)
364 (tramp-su-program nil)
365 (tramp-su-args nil)
366 (tramp-telnet-program nil)
367 (tramp-telnet-args nil))
368 ("telnet"
369 (tramp-connection-function tramp-open-connection-telnet)
370 (tramp-rsh-program nil)
371 (tramp-rcp-program nil)
372 (tramp-remote-sh "/bin/sh")
373 (tramp-rsh-args nil)
374 (tramp-rcp-args nil)
375 (tramp-rcp-keep-date-arg nil)
376 (tramp-su-program nil)
377 (tramp-su-args nil)
378 (tramp-telnet-program "telnet")
379 (tramp-telnet-args nil))
380 ("su" (tramp-connection-function tramp-open-connection-su)
381 (tramp-rsh-program nil)
382 (tramp-rcp-program nil)
383 (tramp-remote-sh "/bin/sh")
384 (tramp-rsh-args nil)
385 (tramp-rcp-args nil)
386 (tramp-rcp-keep-date-arg nil)
387 (tramp-su-program "su")
388 (tramp-su-args ("-" "%u"))
389 (tramp-telnet-program nil)
390 (tramp-telnet-args nil))
391 ("sudo" (tramp-connection-function tramp-open-connection-su)
392 (tramp-rsh-program nil)
393 (tramp-rcp-program nil)
394 (tramp-remote-sh "/bin/sh")
395 (tramp-rsh-args nil)
396 (tramp-rcp-args nil)
397 (tramp-rcp-keep-date-arg nil)
398 (tramp-su-program "sudo")
399 (tramp-su-args ("-u" "%u" "-s"))
400 (tramp-telnet-program nil)
401 (tramp-telnet-args nil))
402 ("multi" (tramp-connection-function tramp-open-connection-multi)
403 (tramp-rsh-program nil)
404 (tramp-rcp-program nil)
405 (tramp-remote-sh "/bin/sh")
406 (tramp-rsh-args nil)
407 (tramp-rcp-args nil)
408 (tramp-rcp-keep-date-arg nil)
409 (tramp-su-program nil)
410 (tramp-su-args nil)
411 (tramp-telnet-program nil)
412 (tramp-telnet-args nil))
413 ("scpx" (tramp-connection-function tramp-open-connection-rsh)
414 (tramp-rsh-program "ssh")
415 (tramp-rcp-program "scp")
416 (tramp-remote-sh "/bin/sh")
417 (tramp-rsh-args ("-e" "none" "-t" "-t" "/bin/sh"))
418 (tramp-rcp-args nil)
419 (tramp-rcp-keep-date-arg "-p")
420 (tramp-telnet-program nil)
421 (tramp-telnet-args nil))
422 ("sshx" (tramp-connection-function tramp-open-connection-rsh)
423 (tramp-rsh-program "ssh")
424 (tramp-rcp-program nil)
425 (tramp-remote-sh "/bin/sh")
426 (tramp-rsh-args ("-e" "none" "-t" "-t" "/bin/sh"))
427 (tramp-rcp-args nil)
428 (tramp-rcp-keep-date-arg nil)
429 (tramp-su-program nil)
430 (tramp-su-args nil)
431 (tramp-telnet-program nil)
432 (tramp-telnet-args nil))
433 ("krlogin"
434 (tramp-connection-function tramp-open-connection-rsh)
435 (tramp-rsh-program "krlogin")
436 (tramp-rcp-program nil)
437 (tramp-remote-sh "/bin/sh")
438 (tramp-rsh-args ("-x"))
439 (tramp-rcp-args nil)
440 (tramp-rcp-keep-date-arg nil)
441 (tramp-su-program nil)
442 (tramp-su-args nil)
443 (tramp-telnet-program nil)
444 (tramp-telnet-args nil))
445 ("plink"
446 (tramp-connection-function tramp-open-connection-rsh)
447 (tramp-rsh-program "plink")
448 (tramp-rcp-program nil)
449 (tramp-remote-sh "/bin/sh")
450 (tramp-rsh-args ("-ssh")) ;optionally add "-v"
451 (tramp-rcp-args nil)
452 (tramp-rcp-keep-date-arg nil)
453 (tramp-su-program nil)
454 (tramp-su-args nil)
455 (tramp-telnet-program nil)
456 (tramp-telnet-args nil))
457 ("pscp"
458 (tramp-connection-function tramp-open-connection-rsh)
459 (tramp-rsh-program "plink")
460 (tramp-rcp-program "pscp")
461 (tramp-remote-sh "/bin/sh")
462 (tramp-rsh-args ("-ssh"))
463 (tramp-rcp-args nil)
464 (tramp-rcp-keep-date-arg "-p")
465 (tramp-su-program nil)
466 (tramp-su-args nil)
467 (tramp-telnet-program nil)
468 (tramp-telnet-args nil))
469 ("fcp"
470 (tramp-connection-function tramp-open-connection-rsh)
471 (tramp-rsh-program "fsh")
472 (tramp-rcp-program "fcp")
473 (tramp-remote-sh "/bin/sh -i")
474 (tramp-rsh-args ("sh" "-i"))
475 (tramp-rcp-args nil)
476 (tramp-rcp-keep-date-arg "-p")
477 (tramp-su-program nil)
478 (tramp-su-args nil)
479 (tramp-telnet-program nil)
480 (tramp-telnet-args nil))
481 )
482 "*Alist of methods for remote files.
483 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
484 Each NAME stands for a remote access method. Each PARAM is a
485 pair of the form (KEY VALUE). The following KEYs are defined:
486 * `tramp-connection-function'
487 This specifies the function to use to connect to the remote host.
488 Currently, `tramp-open-connection-rsh', `tramp-open-connection-telnet'
489 and `tramp-open-connection-su' are defined. See the documentation
490 of these functions for more details.
491 * `tramp-remote-sh'
492 This specifies the Bourne shell to use on the remote host. This
493 MUST be a Bourne-like shell. It is normally not necessary to set
494 this to any value other than \"/bin/sh\": tramp wants to use a shell
495 which groks tilde expansion, but it can search for it. Also note
496 that \"/bin/sh\" exists on all Unixen, this might not be true for
497 the value that you decide to use. You Have Been Warned.
498 * `tramp-rsh-program'
499 This specifies the name of the program to use for rsh; this might be
500 the full path to rsh or the name of a workalike program.
501 * `tramp-rsh-args'
502 This specifies the list of arguments to pass to the above
503 mentioned program. Please note that this is a list of arguments,
504 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
505 here. Instead, you want two list elements, one for \"-a\" and one
506 for \"-b\", or one for \"-f\" and one for \"foo\".
507 * `tramp-rcp-program'
508 This specifies the name of the program to use for rcp; this might be
509 the full path to rcp or the name of a workalike program.
510 * `tramp-rcp-args'
511 This specifies the list of parameters to pass to the above mentioned
512 program, the hints for `tramp-rsh-args' also apply here.
513 * `tramp-rcp-keep-date-arg'
514 This specifies the parameter to use for `rcp' when the timestamp
515 of the original file should be kept. For `rcp', use `-p', for
516 `rsync', use `-t'.
517 * `tramp-su-program'
518 This specifies the name of the program to use for `su'.
519 * `tramp-su-args'
520 This specifies the list of arguments to pass to `su'.
521 \"%u\" is replaced by the user name, use \"%%\" for a literal
522 percent character.
523 * `tramp-telnet-program'
524 Specifies the telnet program to use when using
525 `tramp-open-connection-telnet' to log in.
526 * `tramp-telnet-args'
527 Specifies list of arguments to pass to `telnet'. The hints for
528 `tramp-rsh-args' also apply here.
529
530 What does all this mean? Well, you should specify `tramp-rsh-program',
531 `tramp-telnet-program' or `tramp-su-program' for all methods; this program
532 is used to log in to the remote site. Then, there are two ways to
533 actually transfer the files between the local and the remote side.
534 One way is using an additional rcp-like program. If you want to do
535 this, set `tramp-rcp-program' in the method.
536
537 Another possibility for file transfer is inline transfer, i.e. the
538 file is passed through the same buffer used by `tramp-rsh-program'. In
539 this case, the file contents need to be protected since the
540 `tramp-rsh-program' might use escape codes or the connection might not
541 be eight-bit clean. Therefore, file contents are encoded for transit.
542 See the variable `tramp-coding-commands' for details.
543
544 So, to summarize: if the method is an out-of-band method, then you
545 must specify `tramp-rcp-program' and `tramp-rcp-args'. If it is an
546 inline method, then these two parameters should be nil. Every method,
547 inline or out of band, must specify `tramp-connection-function' plus
548 the associated arguments (for example, the telnet program if you chose
549 `tramp-open-connection-telnet').
550
551 Notes:
552
553 When using `tramp-open-connection-su' the phrase `open connection to a
554 remote host' sounds strange, but it is used nevertheless, for
555 consistency. No connection is opened to a remote host, but `su' is
556 started on the local host. You are not allowed to specify a remote
557 host other than `localhost' or the name of the local host."
558 :group 'tramp
559 :type '(repeat
560 (cons string
561 (set (list (const tramp-connection-function) function)
562 (list (const tramp-rsh-program)
563 (choice (const nil) string))
564 (list (const tramp-rcp-program)
565 (choice (const nil) string))
566 (list (const tramp-remote-sh)
567 (choice (const nil) string))
568 (list (const tramp-rsh-args) (repeat string))
569 (list (const tramp-rcp-args) (repeat string))
570 (list (const tramp-rcp-keep-date-arg)
571 (choice (const nil) string))
572 (list (const tramp-su-program)
573 (choice (const nil) string))
574 (list (const tramp-su-args) (repeat string))
575 (list (const tramp-encoding-command)
576 (choice (const nil) string))
577 (list (const tramp-decoding-command)
578 (choice (const nil) string))
579 (list (const tramp-encoding-function)
580 (choice (const nil) function))
581 (list (const tramp-decoding-function)
582 (choice (const nil) function))
583 (list (const tramp-telnet-program)
584 (choice (const nil) string))
585 (list (const tramp-telnet-args) (repeat string))))))
586
587 (defcustom tramp-multi-methods '("multi" "multiu")
588 "*List of multi-hop methods.
589 Each entry in this list should be a method name as mentioned in the
590 variable `tramp-methods'."
591 :group 'tramp
592 :type '(repeat string))
593
594 (defcustom tramp-multi-connection-function-alist
595 '(("telnet" tramp-multi-connect-telnet "telnet %h%n")
596 ("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
597 ("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
598 ("su" tramp-multi-connect-su "su - %u%n")
599 ("sudo" tramp-multi-connect-su "sudo -u %u -s%n"))
600 "*List of connection functions for multi-hop methods.
601 Each list item is a list of three items (METHOD FUNCTION COMMAND),
602 where METHOD is the name as used in the file name, FUNCTION is the
603 function to be executed, and COMMAND is the shell command used for
604 connecting.
605
606 COMMAND may contain percent escapes. `%u' will be replaced with the
607 user name, `%h' will be replaced with the host name, and `%n' will be
608 replaced with an end-of-line character, as specified in the variable
609 `tramp-rsh-end-of-line'. Use `%%' for a literal percent character.
610 Note that the interpretation of the percent escapes also depends on
611 the FUNCTION. For example, the `%u' escape is forbidden with the
612 function `tramp-multi-connect-telnet'. See the documentation of the
613 various functions for details."
614 :group 'tramp
615 :type '(repeat (list string function string)))
616
617 (defcustom tramp-default-method "ssh"
618 "*Default method to use for transferring files.
619 See `tramp-methods' for possibilities.
620 Also see `tramp-default-method-alist'.
621
622 Emacs uses a unified filename syntax for Tramp and Ange-FTP.
623 For backward compatibility, the default value of this variable
624 is \"ftp\" on Emacs. But XEmacs uses a separate filename syntax
625 for Tramp and EFS, so there the default method is \"sm\"."
626 :group 'tramp
627 :type 'string)
628
629 (defcustom tramp-default-method-alist
630 (when tramp-unified-filenames
631 '(("\\`ftp\\." "" "ftp")
632 ("" "\\`\\(anonymous\\|ftp\\)\\'" "ftp")))
633 "*Default method to use for specific user/host pairs.
634 This is an alist of items (HOST USER METHOD). The first matching item
635 specifies the method to use for a file name which does not specify a
636 method. HOST and USER are regular expressions or nil, which is
637 interpreted as a regular expression which always matches. If no entry
638 matches, the variable `tramp-default-method' takes effect.
639
640 If the file name does not specify the user, lookup is done using the
641 empty string for the user name.
642
643 See `tramp-methods' for a list of possibilities for METHOD."
644 :group 'tramp
645 :type '(repeat (list (regexp :tag "Host regexp")
646 (regexp :tag "User regexp")
647 (string :tag "Method"))))
648
649 (defcustom tramp-ftp-method "ftp"
650 "*When this method name is used, forward all calls to Ange-FTP."
651 :group 'tramp
652 :type 'string)
653
654 ;; Default values for non-Unices seeked
655 (defconst tramp-completion-function-alist-rsh
656 (unless (memq system-type '(windows-nt))
657 '((tramp-parse-rhosts "/etc/hosts.equiv")
658 (tramp-parse-rhosts "~/.rhosts")))
659 "Default list of (FUNNCTION FILE) pairs to be examined for rsh methods."
660 )
661
662 ;; Default values for non-Unices seeked
663 (defconst tramp-completion-function-alist-ssh
664 (unless (memq system-type '(windows-nt))
665 '((tramp-parse-rhosts "/etc/hosts.equiv")
666 (tramp-parse-rhosts "/etc/shosts.equiv")
667 (tramp-parse-shosts "/etc/ssh_known_hosts")
668 (tramp-parse-rhosts "~/.rhosts")
669 (tramp-parse-rhosts "~/.shosts")
670 (tramp-parse-shosts "~/.ssh/known_hosts")))
671 "Default list of (FUNNCTION FILE) pairs to be examined for ssh methods."
672 )
673
674 ;; Default values for non-Unices seeked
675 (defconst tramp-completion-function-alist-telnet
676 (unless (memq system-type '(windows-nt))
677 '((tramp-parse-hosts "/etc/hosts")))
678 "Default list of (FUNNCTION FILE) pairs to be examined for telnet methods."
679 )
680
681 ;; Default values for non-Unices seeked
682 (defconst tramp-completion-function-alist-su
683 (unless (memq system-type '(windows-nt))
684 '((tramp-parse-passwd "/etc/passwd")))
685 "Default list of (FUNNCTION FILE) pairs to be examined for su methods."
686 )
687
688 (defcustom tramp-completion-function-alist
689 (list (cons "rcp" tramp-completion-function-alist-rsh)
690 (cons "scp" tramp-completion-function-alist-ssh)
691 (cons "scp1" tramp-completion-function-alist-ssh)
692 (cons "scp2" tramp-completion-function-alist-ssh)
693 (cons "scp1-old" tramp-completion-function-alist-ssh)
694 (cons "scp2-old" tramp-completion-function-alist-ssh)
695 (cons "rsync" tramp-completion-function-alist-rsh)
696 (cons "rsh" tramp-completion-function-alist-rsh)
697 (cons "ssh" tramp-completion-function-alist-ssh)
698 (cons "ssh1" tramp-completion-function-alist-ssh)
699 (cons "ssh2" tramp-completion-function-alist-ssh)
700 (cons "ssh1-old" tramp-completion-function-alist-ssh)
701 (cons "ssh2-old" tramp-completion-function-alist-ssh)
702 (cons "telnet" tramp-completion-function-alist-telnet)
703 (cons "su" tramp-completion-function-alist-su)
704 (cons "sudo" tramp-completion-function-alist-su)
705 (cons "multi" nil)
706 (cons "scpx" tramp-completion-function-alist-ssh)
707 (cons "sshx" tramp-completion-function-alist-ssh)
708 (cons "krlogin" tramp-completion-function-alist-rsh)
709 (cons "plink" tramp-completion-function-alist-ssh)
710 (cons "pscp" tramp-completion-function-alist-ssh)
711 (cons "fcp" nil)
712 )
713 "*Alist of methods for remote files.
714 This is a list of entries of the form (NAME PAIR1 PAIR2 ...).
715 Each NAME stands for a remote access method. Each PAIR is of the form
716 \(FUNCTION FILE). FUNCTION is responsible to extract user names and host
717 names from FILE for completion. The following predefined FUNCTIONs exists:
718
719 * `tramp-parse-rhosts' for \".rhosts\" like files,
720 * `tramp-parse-shosts' for \"ssh_known_hosts\" like files,
721 * `tramp-parse-hosts' for \"/etc/hosts\" like files, and
722 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
723
724 A FUNCTION parsing \".netrc\" file syntax doesn't exist in TRAMP. This
725 task is delegated to ange-ftp; its customization should be used instead.
726
727 FUNCTION can also see a customer defined function. For more details see
728 the info pages."
729 :group 'tramp
730 :type '(repeat
731 (cons string
732 (choice (const nil) (repeat (list function file))))))
733
734 (defcustom tramp-rsh-end-of-line "\n"
735 "*String used for end of line in rsh connections.
736 I don't think this ever needs to be changed, so please tell me about it
737 if you need to change this.
738 Also see `tramp-password-end-of-line'."
739 :group 'tramp
740 :type 'string)
741
742 (defcustom tramp-password-end-of-line tramp-rsh-end-of-line
743 "*String used for end of line after sending a password.
744 It seems that people using plink under Windows need to send
745 \"\\r\\n\" (carriage-return, then newline) after a password, but just
746 \"\\n\" after all other lines. This variable can be used for the
747 password, see `tramp-rsh-end-of-line' for the other cases.
748
749 The default value is to use the same value as `tramp-rsh-end-of-line'."
750 :group 'tramp
751 :type 'string)
752
753 (defcustom tramp-remote-path
754 '("/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin" "/usr/ccs/bin"
755 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
756 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
757 "*List of directories to search for executables on remote host.
758 Please notify me about other semi-standard directories to include here.
759
760 You can use `~' in this list, but when searching for a shell which groks
761 tilde expansion, all directory names starting with `~' will be ignored."
762 :group 'tramp
763 :type '(repeat string))
764
765 (defcustom tramp-login-prompt-regexp
766 ".*ogin: *"
767 "*Regexp matching login-like prompts.
768 The regexp should match at end of buffer."
769 :group 'tramp
770 :type 'regexp)
771
772 (defcustom tramp-shell-prompt-pattern
773 "^[^#$%>\n]*[#$%>] *"
774 "Regexp to match prompts from remote shell.
775 Normally, Tramp expects you to configure `shell-prompt-pattern'
776 correctly, but sometimes it happens that you are connecting to a
777 remote host which sends a different kind of shell prompt. Therefore,
778 Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
779 and also things matched by this variable. The default value of this
780 variable is the same as the default value of `shell-prompt-pattern',
781 which should work well in many cases."
782 :group 'tramp
783 :type 'regexp)
784
785 (defcustom tramp-password-prompt-regexp
786 "^.*\\([pP]assword\\|passphrase.*\\):\^@? *"
787 "*Regexp matching password-like prompts.
788 The regexp should match at end of buffer.
789
790 The `sudo' program appears to insert a `^@' character into the prompt."
791 :group 'tramp
792 :type 'regexp)
793
794 (defcustom tramp-wrong-passwd-regexp
795 (concat "^.*"
796 ;; These strings should be on the last line
797 (regexp-opt '("Permission denied."
798 "Login incorrect"
799 "Login Incorrect"
800 "Connection refused"
801 "Connection closed"
802 "Sorry, try again."
803 "Name or service not known"
804 "Host key verification failed.") t)
805 ".*"
806 "\\|"
807 "^.*\\("
808 ;; Here comes a list of regexes, separated by \\|
809 "Received signal [0-9]+"
810 "\\).*")
811 "*Regexp matching a `login failed' message.
812 The regexp should match at end of buffer."
813 :group 'tramp
814 :type 'regexp)
815
816 (defcustom tramp-yesno-prompt-regexp
817 (concat
818 (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
819 "\\s-*")
820 "Regular expression matching all yes/no queries which need to be confirmed.
821 The confirmation should be done with yes or no.
822 The regexp should match at end of buffer.
823 See also `tramp-yn-prompt-regexp'."
824 :group 'tramp
825 :type 'regexp)
826
827 (defcustom tramp-yn-prompt-regexp
828 (concat (regexp-opt '("Store key in cache? (y/n)") t)
829 "\\s-*")
830 "Regular expression matching all y/n queries which need to be confirmed.
831 The confirmation should be done with y or n.
832 The regexp should match at end of buffer.
833 See also `tramp-yesno-prompt-regexp'."
834 :group 'tramp
835 :type 'regexp)
836
837
838 (defcustom tramp-temp-name-prefix "tramp."
839 "*Prefix to use for temporary files.
840 If this is a relative file name (such as \"tramp.\"), it is considered
841 relative to the directory name returned by the function
842 `tramp-temporary-file-directory' (which see). It may also be an
843 absolute file name; don't forget to include a prefix for the filename
844 part, though."
845 :group 'tramp
846 :type 'string)
847
848 (defcustom tramp-discard-garbage nil
849 "*If non-nil, try to discard garbage sent by remote shell.
850 Some shells send such garbage upon connection setup."
851 :group 'tramp
852 :type 'boolean)
853
854 (defcustom tramp-sh-extra-args '(("/bash\\'" . "--norc"))
855 "*Alist specifying extra arguments to pass to the remote shell.
856 Entries are (REGEXP . ARGS) where REGEXP is a regular expression
857 matching the shell file name and ARGS is a string specifying the
858 arguments.
859
860 This variable is only used when Tramp needs to start up another shell
861 for tilde expansion. The extra arguments should typically prevent the
862 shell from reading its init file."
863 :group 'tramp
864 :type '(alist :key-type string :value-type string))
865
866 (defcustom tramp-prefix-format
867 (if tramp-unified-filenames "/" "/[")
868 "*String matching the very beginning of tramp file names.
869 Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
870 :group 'tramp
871 :type 'string)
872
873 (defcustom tramp-prefix-regexp
874 (concat "^" (regexp-quote tramp-prefix-format))
875 "*Regexp matching the very beginning of tramp file names.
876 Should always start with \"^\". Derived from `tramp-prefix-format'."
877 :group 'tramp
878 :type 'regexp)
879
880 (defcustom tramp-method-regexp
881 "[a-zA-Z_0-9-]+"
882 "*Regexp matching methods identifiers."
883 :group 'tramp
884 :type 'regexp)
885
886 ;; It is a little bit annoying that in XEmacs case this delimeter is different
887 ;; for single-hop and multi-hop cases.
888 (defcustom tramp-postfix-single-method-format
889 (if tramp-unified-filenames ":" "/")
890 "*String matching delimeter between method and user or host names.
891 Applicable for single-hop methods.
892 Used in `tramp-make-tramp-file-name'."
893 :group 'tramp
894 :type 'string)
895
896 (defcustom tramp-postfix-single-method-regexp
897 (regexp-quote tramp-postfix-single-method-format)
898 "*Regexp matching delimeter between method and user or host names.
899 Applicable for single-hop methods.
900 Derived from `tramp-postfix-single-method-format'."
901 :group 'tramp
902 :type 'regexp)
903
904 (defcustom tramp-postfix-multi-method-format
905 ":"
906 "*String matching delimeter between method and user or host names.
907 Applicable for multi-hop methods.
908 Used in `tramp-make-tramp-multi-file-name'."
909 :group 'tramp
910 :type 'string)
911
912 (defcustom tramp-postfix-multi-method-regexp
913 (regexp-quote tramp-postfix-multi-method-format)
914 "*Regexp matching delimeter between method and user or host names.
915 Applicable for multi-hop methods.
916 Derived from `tramp-postfix-multi-method-format'."
917 :group 'tramp
918 :type 'regexp)
919
920 (defcustom tramp-postfix-multi-hop-format
921 (if tramp-unified-filenames ":" "/")
922 "*String matching delimeter between path and next method.
923 Applicable for multi-hop methods.
924 Used in `tramp-make-tramp-multi-file-name'."
925 :group 'tramp
926 :type 'string)
927
928 (defcustom tramp-postfix-multi-hop-regexp
929 (regexp-quote tramp-postfix-multi-hop-format)
930 "*Regexp matching delimeter between path and next method.
931 Applicable for multi-hop methods.
932 Derived from `tramp-postfix-multi-hop-format'."
933 :group 'tramp
934 :type 'regexp)
935
936 (defcustom tramp-user-regexp
937 "[^:@/]*"
938 "*Regexp matching user names."
939 :group 'tramp
940 :type 'regexp)
941
942 (defcustom tramp-postfix-user-format
943 "@"
944 "*String matching delimeter between user and host names.
945 Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
946 :group 'tramp
947 :type 'string)
948
949 (defcustom tramp-postfix-user-regexp
950 (regexp-quote tramp-postfix-user-format)
951 "*Regexp matching delimeter between user and host names.
952 Derived from `tramp-postfix-user-format'."
953 :group 'tramp
954 :type 'regexp)
955
956 (defcustom tramp-host-regexp
957 "[a-zA-Z0-9_.-]*"
958 "*Regexp matching host names."
959 :group 'tramp
960 :type 'regexp)
961
962 (defcustom tramp-postfix-host-format
963 (if tramp-unified-filenames ":" "]")
964 "*String matching delimeter between host names and paths.
965 Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
966 :group 'tramp
967 :type 'string)
968
969 (defcustom tramp-postfix-host-regexp
970 (regexp-quote tramp-postfix-host-format)
971 "*Regexp matching delimeter between host names and paths.
972 Derived from `tramp-postfix-host-format'."
973 :group 'tramp
974 :type 'regexp)
975
976 (defcustom tramp-path-regexp
977 ".*$"
978 "*Regexp matching paths."
979 :group 'tramp
980 :type 'regexp)
981
982 ;; File name format.
983
984 (defcustom tramp-file-name-structure
985 (list
986 (concat
987 tramp-prefix-regexp
988 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp "\\)?"
989 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
990 "\\(" tramp-host-regexp "\\)" tramp-postfix-host-regexp
991 "\\(" tramp-path-regexp "\\)")
992 2 4 5 6)
993
994 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
995 the tramp file name structure.
996
997 The first element REGEXP is a regular expression matching a tramp file
998 name. The regex should contain parentheses around the method name,
999 the user name, the host name, and the file name parts.
1000
1001 The second element METHOD is a number, saying which pair of
1002 parentheses matches the method name. The third element USER is
1003 similar, but for the user name. The fourth element HOST is similar,
1004 but for the host name. The fifth element FILE is for the file name.
1005 These numbers are passed directly to `match-string', which see. That
1006 means the opening parentheses are counted to identify the pair.
1007
1008 See also `tramp-file-name-regexp'."
1009 :group 'tramp
1010 :type '(list (regexp :tag "File name regexp")
1011 (integer :tag "Paren pair for method name")
1012 (integer :tag "Paren pair for user name ")
1013 (integer :tag "Paren pair for host name ")
1014 (integer :tag "Paren pair for file name ")))
1015
1016 ;;;###autoload
1017 (defconst tramp-file-name-regexp-unified
1018 "\\`/[^/:]+:"
1019 "Value for `tramp-file-name-regexp' for unified remoting.
1020 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1021 Tramp. See `tramp-file-name-structure-unified' for more explanations.")
1022
1023 ;;;###autoload
1024 (defconst tramp-file-name-regexp-separate
1025 "\\`/\\[.*\\]"
1026 "Value for `tramp-file-name-regexp' for separate remoting.
1027 XEmacs uses a separate filename syntax for Tramp and EFS.
1028 See `tramp-file-name-structure-separate' for more explanations.")
1029
1030 ;;;###autoload
1031 (defcustom tramp-file-name-regexp
1032 (if tramp-unified-filenames
1033 tramp-file-name-regexp-unified
1034 tramp-file-name-regexp-separate)
1035 "*Regular expression matching file names handled by tramp.
1036 This regexp should match tramp file names but no other file names.
1037 \(When tramp.el is loaded, this regular expression is prepended to
1038 `file-name-handler-alist', and that is searched sequentially. Thus,
1039 if the tramp entry appears rather early in the `file-name-handler-alist'
1040 and is a bit too general, then some files might be considered tramp
1041 files which are not really tramp files.
1042
1043 Please note that the entry in `file-name-handler-alist' is made when
1044 this file (tramp.el) is loaded. This means that this variable must be set
1045 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1046 updated after changing this variable.
1047
1048 Also see `tramp-file-name-structure'."
1049 :group 'tramp
1050 :type 'regexp)
1051
1052 ;;;###autoload
1053 (defconst tramp-completion-file-name-regexp-unified
1054 "^/[^/]*$"
1055 "Value for `tramp-completion-file-name-regexp' for unified remoting.
1056 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1057 Tramp. See `tramp-file-name-structure-unified' for more explanations.")
1058
1059 ;;;###autoload
1060 (defconst tramp-completion-file-name-regexp-separate
1061 "^/\\([[][^]]*\\)?$"
1062 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1063 XEmacs uses a separate filename syntax for Tramp and EFS.
1064 See `tramp-file-name-structure-separate' for more explanations.")
1065
1066 ;;;###autoload
1067 (defcustom tramp-completion-file-name-regexp
1068 (if tramp-unified-filenames
1069 tramp-completion-file-name-regexp-unified
1070 tramp-completion-file-name-regexp-separate)
1071 "*Regular expression matching file names handled by tramp completion.
1072 This regexp should match partial tramp file names only.
1073
1074 Please note that the entry in `file-name-handler-alist' is made when
1075 this file (tramp.el) is loaded. This means that this variable must be set
1076 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1077 updated after changing this variable.
1078
1079 Also see `tramp-file-name-structure'."
1080 :group 'tramp
1081 :type 'regexp)
1082
1083 (defcustom tramp-multi-file-name-structure
1084 (list
1085 (concat
1086 tramp-prefix-regexp
1087 "\\(" "\\(" tramp-method-regexp "\\)" "\\)?"
1088 "\\(" "\\(" tramp-postfix-multi-hop-regexp "%s" "\\)+" "\\)?"
1089 tramp-postfix-host-regexp "\\(" tramp-path-regexp "\\)")
1090 2 3 -1)
1091 "*Describes the file name structure of `multi' files.
1092 Multi files allow you to contact a remote host in several hops.
1093 This is a list of four elements (REGEXP METHOD HOP PATH).
1094
1095 The first element, REGEXP, gives a regular expression to match against
1096 the file name. In this regular expression, `%s' is replaced with the
1097 value of `tramp-multi-file-name-hop-structure'. (Note: in order to
1098 allow multiple hops, you normally want to use something like
1099 \"\\\\(\\\\(%s\\\\)+\\\\)\" in the regular expression. The outer pair
1100 of parentheses is used for the HOP element, see below.)
1101
1102 All remaining elements are numbers. METHOD gives the number of the
1103 paren pair which matches the method name. HOP gives the number of the
1104 paren pair which matches the hop sequence. PATH gives the number of
1105 the paren pair which matches the path name on the remote host.
1106
1107 PATH can also be negative, which means to count from the end. Ie, a
1108 value of -1 means the last paren pair.
1109
1110 I think it would be good if the regexp matches the whole of the
1111 string, but I haven't actually tried what happens if it doesn't..."
1112 :group 'tramp
1113 :type '(list (regexp :tag "File name regexp")
1114 (integer :tag "Paren pair for method name")
1115 (integer :tag "Paren pair for hops")
1116 (integer :tag "Paren pair to match path")))
1117
1118 (defcustom tramp-multi-file-name-hop-structure
1119 (list
1120 (concat
1121 "\\(" tramp-method-regexp "\\)" tramp-postfix-multi-method-regexp
1122 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
1123 "\\(" tramp-host-regexp "\\)")
1124 1 2 3)
1125 "*Describes the structure of a hop in multi files.
1126 This is a list of four elements (REGEXP METHOD USER HOST). First
1127 element REGEXP is used to match against the hop. Pair number METHOD
1128 matches the method of one hop, pair number USER matches the user of
1129 one hop, pair number HOST matches the host of one hop.
1130
1131 This regular expression should match exactly all of one hop."
1132 :group 'tramp
1133 :type '(list (regexp :tag "Hop regexp")
1134 (integer :tag "Paren pair for method name")
1135 (integer :tag "Paren pair for user name")
1136 (integer :tag "Paren pair for host name")))
1137
1138 (defcustom tramp-make-multi-tramp-file-format
1139 (list
1140 (concat tramp-prefix-format "%m")
1141 (concat tramp-postfix-multi-hop-format
1142 "%m" tramp-postfix-multi-method-format
1143 "%u" tramp-postfix-user-format
1144 "%h")
1145 (concat tramp-postfix-host-format "%p"))
1146 "*Describes how to construct a `multi' file name.
1147 This is a list of three elements PREFIX, HOP and PATH.
1148
1149 The first element PREFIX says how to construct the prefix, the second
1150 element HOP specifies what each hop looks like, and the final element
1151 PATH says how to construct the path name.
1152
1153 In PREFIX, `%%' means `%' and `%m' means the method name.
1154
1155 In HOP, `%%' means `%' and `%m', `%u', `%h' mean the hop method, hop
1156 user and hop host, respectively.
1157
1158 In PATH, `%%' means `%' and `%p' means the path name.
1159
1160 The resulting file name always contains one copy of PREFIX and one
1161 copy of PATH, but there is one copy of HOP for each hop in the file
1162 name.
1163
1164 Note: the current implementation requires the prefix to contain the
1165 method name, followed by all the hops, and the path name must come
1166 last."
1167 :group 'tramp
1168 :type '(list string string string))
1169
1170 (defcustom tramp-terminal-type "dumb"
1171 "*Value of TERM environment variable for logging in to remote host.
1172 Because Tramp wants to parse the output of the remote shell, it is easily
1173 confused by ANSI color escape sequences and suchlike. Often, shell init
1174 files conditionalize this setup based on the TERM environment variable."
1175 :group 'tramp
1176 :type 'string)
1177
1178 (defcustom tramp-completion-without-shell-p nil
1179 "*If nil, use shell wildcards for completion, else rely on Lisp only.
1180 Using shell wildcards for completions has the advantage that it can be
1181 fast even in large directories, but completion is always
1182 case-sensitive. Relying on Lisp only means that case-insensitive
1183 completion is possible (subject to the variable `completion-ignore-case'),
1184 but it might be slow on large directories."
1185 :group 'tramp
1186 :type 'boolean)
1187
1188 (defcustom tramp-actions-before-shell
1189 '((tramp-password-prompt-regexp tramp-action-password)
1190 (tramp-login-prompt-regexp tramp-action-login)
1191 (shell-prompt-pattern tramp-action-succeed)
1192 (tramp-shell-prompt-pattern tramp-action-succeed)
1193 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1194 (tramp-yesno-prompt-regexp tramp-action-yesno)
1195 (tramp-yn-prompt-regexp tramp-action-yn))
1196 "List of pattern/action pairs.
1197 Whenever a pattern matches, the corresponding action is performed.
1198 Each item looks like (PATTERN ACTION).
1199
1200 The PATTERN should be a symbol, a variable. The value of this
1201 variable gives the regular expression to search for. Note that the
1202 regexp must match at the end of the buffer, \"\\'\" is implicitly
1203 appended to it.
1204
1205 The ACTION should also be a symbol, but a function. When the
1206 corresponding PATTERN matches, the ACTION function is called."
1207 :group 'tramp
1208 :type '(repeat (list variable function)))
1209
1210 (defcustom tramp-multi-actions
1211 '((tramp-password-prompt-regexp tramp-multi-action-password)
1212 (tramp-login-prompt-regexp tramp-multi-action-login)
1213 (shell-prompt-pattern tramp-multi-action-succeed)
1214 (tramp-shell-prompt-pattern tramp-multi-action-succeed)
1215 (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied))
1216 "List of pattern/action pairs.
1217 This list is used for each hop in multi-hop connections.
1218 See `tramp-actions-before-shell' for more info."
1219 :group 'tramp
1220 :type '(repeat (list variable function)))
1221
1222 ;;; Internal Variables:
1223
1224 (defvar tramp-buffer-file-attributes nil
1225 "Holds the `ls -ild' output for the current buffer.
1226 This variable is local to each buffer. It is not used if the remote
1227 machine groks Perl. If it is used, it's used as an emulation for
1228 the visited file modtime.")
1229 (make-variable-buffer-local 'tramp-buffer-file-attributes)
1230
1231 (defvar tramp-end-of-output "/////"
1232 "String used to recognize end of output.")
1233
1234 (defvar tramp-connection-function nil
1235 "This internal variable holds a parameter for `tramp-methods'.
1236 In the connection buffer, this variable has the value of the like-named
1237 method parameter, as specified in `tramp-methods' (which see).")
1238
1239 (defvar tramp-remote-sh nil
1240 "This internal variable holds a parameter for `tramp-methods'.
1241 In the connection buffer, this variable has the value of the like-named
1242 method parameter, as specified in `tramp-methods' (which see).")
1243
1244 (defvar tramp-rsh-program nil
1245 "This internal variable holds a parameter for `tramp-methods'.
1246 In the connection buffer, this variable has the value of the like-named
1247 method parameter, as specified in `tramp-methods' (which see).")
1248
1249 (defvar tramp-rsh-args nil
1250 "This internal variable holds a parameter for `tramp-methods'.
1251 In the connection buffer, this variable has the value of the like-named
1252 method parameter, as specified in `tramp-methods' (which see).")
1253
1254 (defvar tramp-rcp-program nil
1255 "This internal variable holds a parameter for `tramp-methods'.
1256 In the connection buffer, this variable has the value of the like-named
1257 method parameter, as specified in `tramp-methods' (which see).")
1258
1259 (defvar tramp-rcp-args nil
1260 "This internal variable holds a parameter for `tramp-methods'.
1261 In the connection buffer, this variable has the value of the like-named
1262 method parameter, as specified in `tramp-methods' (which see).")
1263
1264 (defvar tramp-rcp-keep-date-arg nil
1265 "This internal variable holds a parameter for `tramp-methods'.
1266 In the connection buffer, this variable has the value of the like-named
1267 method parameter, as specified in `tramp-methods' (which see).")
1268
1269 (defvar tramp-encoding-command nil
1270 "This internal variable holds a parameter for `tramp-methods'.
1271 In the connection buffer, this variable has the value of the like-named
1272 method parameter, as specified in `tramp-methods' (which see).")
1273
1274 (defvar tramp-decoding-command nil
1275 "This internal variable holds a parameter for `tramp-methods'.
1276 In the connection buffer, this variable has the value of the like-named
1277 method parameter, as specified in `tramp-methods' (which see).")
1278
1279 (defvar tramp-encoding-function nil
1280 "This internal variable holds a parameter for `tramp-methods'.
1281 In the connection buffer, this variable has the value of the like-named
1282 method parameter, as specified in `tramp-methods' (which see).")
1283
1284 (defvar tramp-decoding-function nil
1285 "This internal variable holds a parameter for `tramp-methods'.
1286 In the connection buffer, this variable has the value of the like-named
1287 method parameter, as specified in `tramp-methods' (which see).")
1288
1289 (defvar tramp-telnet-program nil
1290 "This internal variable holds a parameter for `tramp-methods'.
1291 In the connection buffer, this variable has the value of the like-named
1292 method parameter, as specified in `tramp-methods' (which see).")
1293
1294 (defvar tramp-telnet-args nil
1295 "This internal variable holds a parameter for `tramp-methods'.
1296 In the connection buffer, this variable has the value of the like-named
1297 method parameter, as specified in `tramp-methods' (which see).")
1298
1299 (defvar tramp-su-program nil
1300 "This internal variable holds a parameter for `tramp-methods'.
1301 In the connection buffer, this variable has the value of the like-named
1302 method parameter, as specified in `tramp-methods' (which see).")
1303
1304 ;; CCC `local in each buffer'?
1305 (defvar tramp-ls-command nil
1306 "This command is used to get a long listing with numeric user and group ids.
1307 This variable is automatically made buffer-local to each rsh process buffer
1308 upon opening the connection.")
1309
1310 (defvar tramp-current-multi-method nil
1311 "Name of `multi' connection method for this *tramp* buffer, or nil if not multi.
1312 This variable is automatically made buffer-local to each rsh process buffer
1313 upon opening the connection.")
1314
1315 (defvar tramp-current-method nil
1316 "Connection method for this *tramp* buffer.
1317 This variable is automatically made buffer-local to each rsh process buffer
1318 upon opening the connection.")
1319
1320 (defvar tramp-current-user nil
1321 "Remote login name for this *tramp* buffer.
1322 This variable is automatically made buffer-local to each rsh process buffer
1323 upon opening the connection.")
1324
1325 (defvar tramp-current-host nil
1326 "Remote host for this *tramp* buffer.
1327 This variable is automatically made buffer-local to each rsh process buffer
1328 upon opening the connection.")
1329
1330 (defvar tramp-test-groks-nt nil
1331 "Whether the `test' command groks the `-nt' switch.
1332 \(`test A -nt B' tests if file A is newer than file B.)
1333 This variable is automatically made buffer-local to each rsh process buffer
1334 upon opening the connection.")
1335
1336 (defvar tramp-file-exists-command nil
1337 "Command to use for checking if a file exists.
1338 This variable is automatically made buffer-local to each rsh process buffer
1339 upon opening the connection.")
1340
1341 (defconst tramp-uudecode "\
1342 tramp_uudecode () {
1343 \(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1344 cat /tmp/tramp.$$
1345 rm -f /tmp/tramp.$$
1346 }"
1347 "Shell function to implement `uudecode' to standard output.
1348 Many systems support `uudecode -o -' for this or `uudecode -p', but
1349 some systems don't, and for them we have this shell function.")
1350
1351 ;; Perl script to implement `file-attributes' in a Lisp `read'able
1352 ;; output. If you are hacking on this, note that you get *no* output
1353 ;; unless this spits out a complete line, including the '\n' at the
1354 ;; end.
1355 (defconst tramp-perl-file-attributes "\
1356 $f = $ARGV[0];
1357 @s = lstat($f);
1358 if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; }
1359 elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; }
1360 else { $l = \"nil\" };
1361 printf(\"(%s %u %d %d (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\",
1362 $l, $s[3], $s[4], $s[5], $s[8] >> 16 & 0xffff, $s[8] & 0xffff,
1363 $s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff,
1364 $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff, $s[0] >> 16 & 0xffff, $s[0] & 0xffff);"
1365 "Perl script to produce output suitable for use with `file-attributes'
1366 on the remote file system.")
1367
1368 ;; ;; These two use uu encoding.
1369 ;; (defvar tramp-perl-encode "%s -e'\
1370 ;; print qq(begin 644 xxx\n);
1371 ;; my $s = q();
1372 ;; my $res = q();
1373 ;; while (read(STDIN, $s, 45)) {
1374 ;; print pack(q(u), $s);
1375 ;; }
1376 ;; print qq(`\n);
1377 ;; print qq(end\n);
1378 ;; '"
1379 ;; "Perl program to use for encoding a file.
1380 ;; Escape sequence %s is replaced with name of Perl binary.")
1381
1382 ;; (defvar tramp-perl-decode "%s -ne '
1383 ;; print unpack q(u), $_;
1384 ;; '"
1385 ;; "Perl program to use for decoding a file.
1386 ;; Escape sequence %s is replaced with name of Perl binary.")
1387
1388 ;; These two use base64 encoding.
1389 (defvar tramp-perl-encode-with-module
1390 "perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)'"
1391 "Perl program to use for encoding a file.
1392 Escape sequence %s is replaced with name of Perl binary.
1393 This string is passed to `format', so percent characters need to be doubled.
1394 This implementation requires the MIME::Base64 Perl module to be installed
1395 on the remote host.")
1396
1397 (defvar tramp-perl-decode-with-module
1398 "perl -MMIME::Base64 -0777 -ne 'print decode_base64($_)'"
1399 "Perl program to use for decoding a file.
1400 Escape sequence %s is replaced with name of Perl binary.
1401 This string is passed to `format', so percent characters need to be doubled.
1402 This implementation requires the MIME::Base64 Perl module to be installed
1403 on the remote host.")
1404
1405 (defvar tramp-perl-encode
1406 "%s -e '
1407 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1408 # Copyright (C) 2002 Free Software Foundation, Inc.
1409 use strict;
1410
1411 my %%trans = do {
1412 my $i = 0;
1413 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
1414 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
1415 };
1416
1417 binmode(\\*STDIN);
1418
1419 # We read in chunks of 54 bytes, to generate output lines
1420 # of 72 chars (plus end of line)
1421 $/ = \\54;
1422
1423 while (my $data = <STDIN>) {
1424 my $pad = q();
1425
1426 # Only for the last chunk, and only if did not fill the last three-byte packet
1427 if (eof) {
1428 my $mod = length($data) %% 3;
1429 $pad = q(=) x (3 - $mod) if $mod;
1430 }
1431
1432 # Not the fastest method, but it is simple: unpack to binary string, split
1433 # by groups of 6 bits and convert back from binary to byte; then map into
1434 # the translation table
1435 print
1436 join q(),
1437 map($trans{$_},
1438 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1439 $pad,
1440 qq(\\n);
1441 }
1442 '"
1443 "Perl program to use for encoding a file.
1444 Escape sequence %s is replaced with name of Perl binary.
1445 This string is passed to `format', so percent characters need to be doubled.")
1446
1447 (defvar tramp-perl-decode
1448 "%s -e '
1449 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1450 # Copyright (C) 2002 Free Software Foundation, Inc.
1451 use strict;
1452
1453 my %%trans = do {
1454 my $i = 0;
1455 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
1456 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
1457 };
1458
1459 my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
1460
1461 binmode(\\*STDOUT);
1462
1463 # We are going to accumulate into $pending to accept any line length
1464 # (we do not check they are <= 76 chars as the RFC says)
1465 my $pending = q();
1466
1467 while (my $data = <STDIN>) {
1468 chomp $data;
1469
1470 # If we find one or two =, we have reached the end and
1471 # any following data is to be discarded
1472 my $finished = $data =~ s/(==?).*/$1/;
1473 $pending .= $data;
1474
1475 my $len = length($pending);
1476 my $chunk = substr($pending, 0, $len & ~3);
1477
1478 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
1479 # split in 8-bit chunks and convert back to char.
1480 print join q(),
1481 map $bytes{$_},
1482 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1483
1484 last if $finished;
1485 }
1486 '"
1487 "Perl program to use for decoding a file.
1488 Escape sequence %s is replaced with name of Perl binary.
1489 This string is passed to `format', so percent characters need to be doubled.")
1490
1491 ; These values conform to `file-attributes' from XEmacs 21.2.
1492 ; GNU Emacs and other tools not checked.
1493 (defconst tramp-file-mode-type-map '((0 . "-") ; Normal file (SVID-v2 and XPG2)
1494 (1 . "p") ; fifo
1495 (2 . "c") ; character device
1496 (3 . "m") ; multiplexed character device (v7)
1497 (4 . "d") ; directory
1498 (5 . "?") ; Named special file (XENIX)
1499 (6 . "b") ; block device
1500 (7 . "?") ; multiplexed block device (v7)
1501 (8 . "-") ; regular file
1502 (9 . "n") ; network special file (HP-UX)
1503 (10 . "l") ; symlink
1504 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
1505 (12 . "s") ; socket
1506 (13 . "D") ; door special (Solaris)
1507 (14 . "w")) ; whiteout (BSD)
1508 "A list of file types returned from the `stat' system call.
1509 This is used to map a mode number to a permission string.")
1510
1511 (defvar tramp-dos-coding-system
1512 (if (and (fboundp 'coding-system-p)
1513 (funcall 'coding-system-p '(dos)))
1514 'dos
1515 'undecided-dos)
1516 "Some Emacsen know the `dos' coding system, others need `undecided-dos'.")
1517
1518 (defvar tramp-last-cmd-time nil
1519 "Internal Tramp variable recording the time when the last cmd was sent.
1520 This variable is buffer-local in every buffer.")
1521 (make-variable-buffer-local 'tramp-last-cmd-time)
1522
1523 ;; This variable does not have the right value in XEmacs. What should
1524 ;; I use instead of find-operation-coding-system in XEmacs?
1525 (defvar tramp-feature-write-region-fix
1526 (when (fboundp 'find-operation-coding-system)
1527 (let ((file-coding-system-alist '(("test" emacs-mule))))
1528 (find-operation-coding-system 'write-region 0 0 "" nil "test")))
1529 "Internal variable to say if `write-region' chooses the right coding.
1530 Older versions of Emacs chose the coding system for `write-region' based
1531 on the FILENAME argument, even if VISIT was a string.")
1532
1533 ;; New handlers should be added here. The following operations can be
1534 ;; handled using the normal primitives: file-name-as-directory,
1535 ;; file-name-directory, file-name-nondirectory,
1536 ;; file-name-sans-versions, get-file-buffer.
1537 (defconst tramp-file-name-handler-alist
1538 '(
1539 (load . tramp-handle-load)
1540 (make-symbolic-link . tramp-handle-make-symbolic-link)
1541 (file-name-directory . tramp-handle-file-name-directory)
1542 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
1543 (file-truename . tramp-handle-file-truename)
1544 (file-exists-p . tramp-handle-file-exists-p)
1545 (file-directory-p . tramp-handle-file-directory-p)
1546 (file-executable-p . tramp-handle-file-executable-p)
1547 (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
1548 (file-readable-p . tramp-handle-file-readable-p)
1549 (file-regular-p . tramp-handle-file-regular-p)
1550 (file-symlink-p . tramp-handle-file-symlink-p)
1551 (file-writable-p . tramp-handle-file-writable-p)
1552 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
1553 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
1554 (file-attributes . tramp-handle-file-attributes)
1555 (file-modes . tramp-handle-file-modes)
1556 (file-directory-files . tramp-handle-file-directory-files)
1557 (directory-files . tramp-handle-directory-files)
1558 (file-name-all-completions . tramp-handle-file-name-all-completions)
1559 (file-name-completion . tramp-handle-file-name-completion)
1560 (add-name-to-file . tramp-handle-add-name-to-file)
1561 (copy-file . tramp-handle-copy-file)
1562 (rename-file . tramp-handle-rename-file)
1563 (set-file-modes . tramp-handle-set-file-modes)
1564 (make-directory . tramp-handle-make-directory)
1565 (delete-directory . tramp-handle-delete-directory)
1566 (delete-file . tramp-handle-delete-file)
1567 (directory-file-name . tramp-handle-directory-file-name)
1568 (shell-command . tramp-handle-shell-command)
1569 (insert-directory . tramp-handle-insert-directory)
1570 (expand-file-name . tramp-handle-expand-file-name)
1571 (file-local-copy . tramp-handle-file-local-copy)
1572 (insert-file-contents . tramp-handle-insert-file-contents)
1573 (write-region . tramp-handle-write-region)
1574 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
1575 (dired-call-process . tramp-handle-dired-call-process)
1576 (dired-recursive-delete-directory
1577 . tramp-handle-dired-recursive-delete-directory)
1578 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
1579 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime))
1580 "Alist of handler functions.
1581 Operations not mentioned here will be handled by the normal Emacs functions.")
1582
1583 ;; Handlers for partial tramp file names. For GNU Emacs just
1584 ;; `file-name-all-completions' is needed. The other ones are necessary
1585 ;; for XEmacs.
1586 (defconst tramp-completion-file-name-handler-alist
1587 '(
1588 (file-name-directory . tramp-completion-handle-file-name-directory)
1589 (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)
1590 (file-exists-p . tramp-completion-handle-file-exists-p)
1591 (file-name-all-completions . tramp-completion-handle-file-name-all-completions)
1592 (file-name-completion . tramp-completion-handle-file-name-completion)
1593 (expand-file-name . tramp-completion-handle-expand-file-name))
1594 "Alist of completion handler functions.
1595 Used for file names matching `tramp-file-name-regexp'. Operations not
1596 mentioned here will be handled by `tramp-file-name-handler-alist' or the
1597 normal Emacs functions.")
1598
1599 ;;; Internal functions which must come first.
1600
1601 (defsubst tramp-message (level fmt-string &rest args)
1602 "Emit a message depending on verbosity level.
1603 First arg LEVEL says to be quiet if `tramp-verbose' is less than LEVEL. The
1604 message is emitted only if `tramp-verbose' is greater than or equal to LEVEL.
1605 Calls function `message' with FMT-STRING as control string and the remaining
1606 ARGS to actually emit the message (if applicable).
1607
1608 This function expects to be called from the tramp buffer only!"
1609 (when (<= level tramp-verbose)
1610 (apply #'message (concat "tramp: " fmt-string) args)
1611 (when tramp-debug-buffer
1612 (save-excursion
1613 (set-buffer
1614 (tramp-get-debug-buffer
1615 tramp-current-multi-method tramp-current-method
1616 tramp-current-user tramp-current-host))
1617 (goto-char (point-max))
1618 (tramp-insert-with-face
1619 'italic
1620 (concat "# " (apply #'format fmt-string args) "\n"))))))
1621
1622 (defun tramp-message-for-buffer
1623 (multi-method method user host level fmt-string &rest args)
1624 "Like `tramp-message' but temporarily switches to the tramp buffer.
1625 First three args METHOD, USER, and HOST identify the tramp buffer to use,
1626 remaining args passed to `tramp-message'."
1627 (save-excursion
1628 (set-buffer (tramp-get-buffer multi-method method user host))
1629 (apply 'tramp-message level fmt-string args)))
1630
1631 (defsubst tramp-line-end-position nil
1632 "Return point at end of line.
1633 Calls `line-end-position' or `point-at-eol' if defined, else
1634 own implementation."
1635 (cond
1636 ((fboundp 'line-end-position) (funcall 'line-end-position))
1637 ((fboundp 'point-at-eol) (funcall 'point-at-eol))
1638 (t (save-excursion (end-of-line) (point)))))
1639
1640 (defmacro with-parsed-tramp-file-name (filename var &rest body)
1641 "Parse a Tramp filename and make components available in the body.
1642
1643 First arg FILENAME is evaluated and dissected into its components.
1644 Second arg VAR is a symbol. It is used as a variable name to hold
1645 the filename structure. It is also used as a prefix for the variables
1646 holding the components. For example, if VAR is the symbol `foo', then
1647 `foo' will be bound to the whole structure, `foo-multi-method' will
1648 be bound to the multi-method component, and so on for `foo-method',
1649 `foo-user', `foo-host', `foo-path'.
1650
1651 Remaining args are Lisp expressions to be evaluated (inside an implicit
1652 `progn').
1653
1654 If VAR is nil, then we bind `v' to the structure and `multi-method',
1655 `method', `user', `host', `path' to the components."
1656 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1657 (,(if var (intern (concat (symbol-name var) "-multi-method")) 'multi-method)
1658 (tramp-file-name-multi-method ,(or var 'v)))
1659 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
1660 (tramp-file-name-method ,(or var 'v)))
1661 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
1662 (tramp-file-name-user ,(or var 'v)))
1663 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
1664 (tramp-file-name-host ,(or var 'v)))
1665 (,(if var (intern (concat (symbol-name var) "-path")) 'path)
1666 (tramp-file-name-path ,(or var 'v))))
1667 ,@body))
1668
1669 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
1670
1671 ;;; Config Manipulation Functions:
1672
1673 (defun tramp-set-completion-function (method function-list)
1674 "Sets the list of completion functions for METHOD.
1675 FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
1676 The FUNCTION is intended to parse FILE according its syntax.
1677 It might be a predefined FUNCTION, or a user defined FUNCTION.
1678 Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
1679 `tramp-parse-hosts', and `tramp-parse-passwd'.
1680 Example:
1681
1682 (tramp-set-completion-function
1683 \"ssh\"
1684 '((tramp-parse-shosts \"/etc/ssh_known_hosts\")
1685 (tramp-parse-shosts \"~/.ssh/known_hosts\")))"
1686
1687 (let ((v (cdr (assoc method tramp-completion-function-alist))))
1688 (when v (setcdr v function-list))))
1689
1690 (defun tramp-get-completion-function (method)
1691 "Returns list of completion functions for METHOD.
1692 For definition of that list see `tramp-set-completion-function'."
1693 (cdr (assoc method tramp-completion-function-alist)))
1694
1695 ;;; File Name Handler Functions:
1696
1697 (defun tramp-handle-make-symbolic-link
1698 (filename linkname &optional ok-if-already-exists)
1699 "Like `make-symbolic-link' for tramp files.
1700 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
1701 the symlink. If LINKNAME is a Tramp file, only the path component is
1702 used as the target of the symlink.
1703
1704 If LINKNAME is a Tramp file and the path component is relative, then
1705 it is expanded first, before the path component is taken. Note that
1706 this can give surprising results if the user/host for the source and
1707 target of the symlink differ."
1708 (with-parsed-tramp-file-name linkname l
1709 (when (tramp-ange-ftp-file-name-p l-multi-method l-method)
1710 (tramp-invoke-ange-ftp 'make-symbolic-link
1711 filename linkname ok-if-already-exists))
1712 (let ((ln (tramp-get-remote-ln l-multi-method l-method l-user l-host))
1713 (cwd (file-name-directory l-path)))
1714 (unless ln
1715 (signal 'file-error
1716 (list "Making a symbolic link."
1717 "ln(1) does not exist on the remote host.")))
1718
1719 ;; Do the 'confirm if exists' thing.
1720 (when (file-exists-p linkname)
1721 ;; What to do?
1722 (if (or (null ok-if-already-exists) ; not allowed to exist
1723 (and (numberp ok-if-already-exists)
1724 (not (yes-or-no-p
1725 (format
1726 "File %s already exists; make it a link anyway? "
1727 l-path)))))
1728 (signal 'file-already-exists (list "File already exists" l-path))
1729 (delete-file linkname)))
1730
1731 ;; If FILENAME is a Tramp name, use just the path component.
1732 (when (tramp-tramp-file-p filename)
1733 (setq filename (tramp-file-name-path
1734 (tramp-dissect-file-name
1735 (expand-file-name filename)))))
1736
1737 ;; Right, they are on the same host, regardless of user, method, etc.
1738 ;; We now make the link on the remote machine. This will occur as the user
1739 ;; that FILENAME belongs to.
1740 (zerop
1741 (tramp-send-command-and-check
1742 l-multi-method l-method l-user l-host
1743 (format "cd %s && %s -sf %s %s"
1744 cwd ln
1745 filename
1746 l-path)
1747 t)))))
1748
1749
1750 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
1751 "Like `load' for tramp files. Not implemented!"
1752 (unless (file-name-absolute-p file)
1753 (error "Tramp cannot `load' files without absolute path name"))
1754 (with-parsed-tramp-file-name file nil
1755 (when (tramp-ange-ftp-file-name-p multi-method method)
1756 (tramp-invoke-ange-ftp 'load
1757 file noerror nomessage nosuffix must-suffix))
1758 (unless nosuffix
1759 (cond ((file-exists-p (concat file ".elc"))
1760 (setq file (concat file ".elc")))
1761 ((file-exists-p (concat file ".el"))
1762 (setq file (concat file ".el")))))
1763 (when must-suffix
1764 ;; The first condition is always true for absolute file names.
1765 ;; Included for safety's sake.
1766 (unless (or (file-name-directory file)
1767 (string-match "\\.elc?\\'" file))
1768 (error "File `%s' does not include a `.el' or `.elc' suffix"
1769 file)))
1770 (unless noerror
1771 (when (not (file-exists-p file))
1772 (error "Cannot load nonexistant file `%s'" file)))
1773 (if (not (file-exists-p file))
1774 nil
1775 (unless nomessage
1776 (message "Loading %s..." file))
1777 (let ((local-copy (file-local-copy file)))
1778 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
1779 (load local-copy noerror t t)
1780 (delete-file local-copy))
1781 (unless nomessage
1782 (message "Loading %s...done" file))
1783 t)))
1784
1785 ;; Path manipulation functions that grok TRAMP paths...
1786 (defun tramp-handle-file-name-directory (file)
1787 "Like `file-name-directory' but aware of TRAMP files."
1788 ;; everything except the last filename thing is the directory
1789 (with-parsed-tramp-file-name file nil
1790 (when (tramp-ange-ftp-file-name-p multi-method method)
1791 (tramp-invoke-ange-ftp 'file-name-directory file))
1792 ;; For the following condition, two possibilities should be tried:
1793 ;; (1) (string= path "")
1794 ;; (2) (or (string= path "") (string= path "/"))
1795 ;; The second variant fails when completing a "/" directory on
1796 ;; the remote host, that is a filename which looks like
1797 ;; "/user@host:/". But maybe wildcards fail with the first variant.
1798 ;; We should do some investigation.
1799 (if (string= path "")
1800 ;; For a filename like "/[foo]", we return "/". The `else'
1801 ;; case would return "/[foo]" unchanged. But if we do that,
1802 ;; then `file-expand-wildcards' ceases to work. It's not
1803 ;; quite clear to me what's the intuition that tells that this
1804 ;; behavior is the right behavior, but oh, well.
1805 "/"
1806 ;; run the command on the path portion only
1807 ;; CCC: This should take into account the remote machine type, no?
1808 ;; --daniel <daniel@danann.net>
1809 (tramp-make-tramp-file-name multi-method method user host
1810 ;; This will not recurse...
1811 (or (file-name-directory path) "")))))
1812
1813 (defun tramp-handle-file-name-nondirectory (file)
1814 "Like `file-name-nondirectory' but aware of TRAMP files."
1815 (with-parsed-tramp-file-name file nil
1816 (when (tramp-ange-ftp-file-name-p multi-method method)
1817 (tramp-invoke-ange-ftp 'file-name-nondirectory file))
1818 (file-name-nondirectory path)))
1819
1820 (defun tramp-handle-file-truename (filename &optional counter prev-dirs)
1821 "Like `file-truename' for tramp files."
1822 (with-parsed-tramp-file-name filename nil
1823 ;; Ange-FTP does not support truename processing, but for
1824 ;; convenience we pretend it did and forward the call to Ange-FTP
1825 ;; anyway. Ange-FTP then just invokes `identity'.
1826 (when (tramp-ange-ftp-file-name-p multi-method method)
1827 (tramp-invoke-ange-ftp 'file-truename filename))
1828 (let* ((steps (tramp-split-string path "/"))
1829 (pathdir (let ((directory-sep-char ?/))
1830 (file-name-as-directory path)))
1831 (is-dir (string= path pathdir))
1832 (thisstep nil)
1833 (numchase 0)
1834 ;; Don't make the following value larger than necessary.
1835 ;; People expect an error message in a timely fashion when
1836 ;; something is wrong; otherwise they might think that Emacs
1837 ;; is hung. Of course, correctness has to come first.
1838 (numchase-limit 20)
1839 (result nil) ;result steps in reverse order
1840 (curstri "")
1841 symlink-target)
1842 (tramp-message-for-buffer
1843 multi-method method user host
1844 10 "Finding true name for `%s'" filename)
1845 (while (and steps (< numchase numchase-limit))
1846 (setq thisstep (pop steps))
1847 (tramp-message-for-buffer
1848 multi-method method user host
1849 10 "Check %s"
1850 (mapconcat 'identity
1851 (append '("") (reverse result) (list thisstep))
1852 "/"))
1853 (setq symlink-target
1854 (nth 0 (tramp-handle-file-attributes
1855 (tramp-make-tramp-file-name
1856 multi-method method user host
1857 (mapconcat 'identity
1858 (append '("")
1859 (reverse result)
1860 (list thisstep))
1861 "/")))))
1862 (cond ((string= "." thisstep)
1863 (tramp-message-for-buffer multi-method method user host
1864 10 "Ignoring step `.'"))
1865 ((string= ".." thisstep)
1866 (tramp-message-for-buffer multi-method method user host
1867 10 "Processing step `..'")
1868 (pop result))
1869 ((stringp symlink-target)
1870 ;; It's a symlink, follow it.
1871 (tramp-message-for-buffer
1872 multi-method method user host
1873 10 "Follow symlink to %s" symlink-target)
1874 (setq numchase (1+ numchase))
1875 (when (file-name-absolute-p symlink-target)
1876 (setq result nil))
1877 (setq steps
1878 (append (tramp-split-string symlink-target "/") steps)))
1879 (t
1880 ;; It's a file.
1881 (setq result (cons thisstep result)))))
1882 (when (>= numchase numchase-limit)
1883 (error "Maximum number (%d) of symlinks exceeded" numchase-limit))
1884 (setq result (reverse result))
1885 (tramp-message-for-buffer
1886 multi-method method user host
1887 10 "True name of `%s' is `%s'"
1888 filename (mapconcat 'identity (cons "" result) "/"))
1889 (tramp-make-tramp-file-name
1890 multi-method method user host
1891 (concat (mapconcat 'identity (cons "" result) "/")
1892 (if is-dir "/" ""))))))
1893
1894 ;; Basic functions.
1895
1896 (defun tramp-handle-file-exists-p (filename)
1897 "Like `file-exists-p' for tramp files."
1898 (with-parsed-tramp-file-name filename nil
1899 (when (tramp-ange-ftp-file-name-p multi-method method)
1900 (tramp-invoke-ange-ftp 'file-exists-p filename))
1901 (save-excursion
1902 (zerop (tramp-send-command-and-check
1903 multi-method method user host
1904 (format
1905 (tramp-get-file-exists-command multi-method method user host)
1906 (tramp-shell-quote-argument path)))))))
1907
1908 ;; CCC: This should check for an error condition and signal failure
1909 ;; when something goes wrong.
1910 ;; Daniel Pittman <daniel@danann.net>
1911 (defun tramp-handle-file-attributes (filename &optional nonnumeric)
1912 "Like `file-attributes' for tramp files.
1913 Optional argument NONNUMERIC means return user and group name
1914 rather than as numbers."
1915 (let (result)
1916 (with-parsed-tramp-file-name filename nil
1917 (when (tramp-ange-ftp-file-name-p multi-method method)
1918 (tramp-invoke-ange-ftp 'file-attributes filename))
1919 (when (tramp-handle-file-exists-p filename)
1920 ;; file exists, find out stuff
1921 (save-excursion
1922 (if (tramp-get-remote-perl multi-method method user host)
1923 (setq result
1924 (tramp-handle-file-attributes-with-perl
1925 multi-method method user host path nonnumeric))
1926 (setq result
1927 (tramp-handle-file-attributes-with-ls
1928 multi-method method user host path nonnumeric))))))
1929 result))
1930
1931
1932 (defun tramp-handle-file-attributes-with-ls
1933 (multi-method method user host path &optional nonnumeric)
1934 "Implement `file-attributes' for tramp files using the ls(1) command."
1935 (let (symlinkp dirp
1936 res-inode res-filemodes res-numlinks
1937 res-uid res-gid res-size res-symlink-target)
1938 (tramp-message-for-buffer multi-method method user host 10
1939 "file attributes with ls: %s"
1940 (tramp-make-tramp-file-name
1941 multi-method method user host path))
1942 (tramp-send-command
1943 multi-method method user host
1944 (format "%s %s %s"
1945 (tramp-get-ls-command multi-method method user host)
1946 (if nonnumeric "-ild" "-ildn")
1947 (tramp-shell-quote-argument path)))
1948 (tramp-wait-for-output)
1949 ;; parse `ls -l' output ...
1950 ;; ... inode
1951 (setq res-inode
1952 (condition-case err
1953 (read (current-buffer))
1954 (invalid-read-syntax
1955 (when (and (equal (cadr err)
1956 "Integer constant overflow in reader")
1957 (string-match
1958 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
1959 (caddr err)))
1960 (let* ((big (read (substring (caddr err) 0
1961 (match-beginning 1))))
1962 (small (read (match-string 1 (caddr err))))
1963 (twiddle (/ small 65536)))
1964 (cons (+ big twiddle)
1965 (- small (* twiddle 65536))))))))
1966 ;; ... file mode flags
1967 (setq res-filemodes (symbol-name (read (current-buffer))))
1968 ;; ... number links
1969 (setq res-numlinks (read (current-buffer)))
1970 ;; ... uid and gid
1971 (setq res-uid (read (current-buffer)))
1972 (setq res-gid (read (current-buffer)))
1973 (unless nonnumeric
1974 (unless (numberp res-uid) (setq res-uid -1))
1975 (unless (numberp res-gid) (setq res-gid -1)))
1976 ;; ... size
1977 (setq res-size (read (current-buffer)))
1978 ;; From the file modes, figure out other stuff.
1979 (setq symlinkp (eq ?l (aref res-filemodes 0)))
1980 (setq dirp (eq ?d (aref res-filemodes 0)))
1981 ;; if symlink, find out file name pointed to
1982 (when symlinkp
1983 (search-forward "-> ")
1984 (setq res-symlink-target
1985 (buffer-substring (point)
1986 (tramp-line-end-position))))
1987 ;; return data gathered
1988 (list
1989 ;; 0. t for directory, string (name linked to) for symbolic
1990 ;; link, or nil.
1991 (or dirp res-symlink-target nil)
1992 ;; 1. Number of links to file.
1993 res-numlinks
1994 ;; 2. File uid.
1995 res-uid
1996 ;; 3. File gid.
1997 res-gid
1998 ;; 4. Last access time, as a list of two integers. First
1999 ;; integer has high-order 16 bits of time, second has low 16
2000 ;; bits.
2001 ;; 5. Last modification time, likewise.
2002 ;; 6. Last status change time, likewise.
2003 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2004 ;; 7. Size in bytes (-1, if number is out of range).
2005 res-size
2006 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2007 res-filemodes
2008 ;; 9. t iff file's gid would change if file were deleted and
2009 ;; recreated.
2010 nil ;hm?
2011 ;; 10. inode number.
2012 res-inode
2013 ;; 11. Device number.
2014 -1 ;hm?
2015 )))
2016
2017 (defun tramp-handle-file-attributes-with-perl
2018 (multi-method method user host path &optional nonnumeric)
2019 "Implement `file-attributes' for tramp files using a Perl script.
2020
2021 The Perl command is sent to the remote machine when the connection
2022 is initially created and is kept cached by the remote shell."
2023 (tramp-message-for-buffer multi-method method user host 10
2024 "file attributes with perl: %s"
2025 (tramp-make-tramp-file-name
2026 multi-method method user host path))
2027 (tramp-send-command
2028 multi-method method user host
2029 (format "tramp_file_attributes %s"
2030 (tramp-shell-quote-argument path)))
2031 (tramp-wait-for-output)
2032 (let ((result (read (current-buffer))))
2033 (setcar (nthcdr 8 result)
2034 (tramp-file-mode-from-int (nth 8 result)))
2035 result))
2036
2037 (defun tramp-handle-set-visited-file-modtime (&optional time-list)
2038 "Like `set-visited-file-modtime' for tramp files."
2039 (unless (buffer-file-name)
2040 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2041 (buffer-name)))
2042 (when time-list
2043 (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))
2044 (let ((f (buffer-file-name))
2045 (coding-system-used nil))
2046 (with-parsed-tramp-file-name f nil
2047 ;; This operation is not handled by Ange-FTP! Compare this
2048 ;; behavior with `file-truename' which Ange-FTP does not really
2049 ;; handle, either, but at least it pretends to. I wonder if
2050 ;; Ange-FTP should also pretend to grok
2051 ;; `set-visited-file-modtime', for consistency?
2052 (when (tramp-ange-ftp-file-name-p multi-method method)
2053 (throw 'tramp-forward-to-ange-ftp
2054 (tramp-run-real-handler 'set-visited-file-modtime
2055 (list time-list))))
2056 (let* ((attr (file-attributes f))
2057 (modtime (nth 5 attr)))
2058 ;; We use '(0 0) as a don't-know value. See also
2059 ;; `tramp-handle-file-attributes-with-ls'.
2060 (when (boundp 'last-coding-system-used)
2061 (setq coding-system-used last-coding-system-used))
2062 (if (not (equal modtime '(0 0)))
2063 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2064 (save-excursion
2065 (tramp-send-command
2066 multi-method method user host
2067 (format "%s -ild %s"
2068 (tramp-get-ls-command multi-method method user host)
2069 (tramp-shell-quote-argument path)))
2070 (tramp-wait-for-output)
2071 (setq attr (buffer-substring (point)
2072 (progn (end-of-line) (point)))))
2073 (setq tramp-buffer-file-attributes attr))
2074 (when (boundp 'last-coding-system-used)
2075 (setq last-coding-system-used coding-system-used))
2076 nil))))
2077
2078 ;; CCC continue here
2079
2080 ;; This function makes the same assumption as
2081 ;; `tramp-handle-set-visited-file-modtime'.
2082 (defun tramp-handle-verify-visited-file-modtime (buf)
2083 "Like `verify-visited-file-modtime' for tramp files."
2084 (with-current-buffer buf
2085 (let ((f (buffer-file-name)))
2086 (with-parsed-tramp-file-name f nil
2087 (when (tramp-ange-ftp-file-name-p multi-method method)
2088 ;; This one requires a hack since the file name is not passed
2089 ;; on the arg list.
2090 (let ((buffer-file-name (tramp-make-ange-ftp-file-name
2091 user host path)))
2092 (tramp-invoke-ange-ftp 'verify-visited-file-modtime buf)))
2093 (let* ((attr (file-attributes f))
2094 (modtime (nth 5 attr)))
2095 (cond ((and attr (not (equal modtime '(0 0))))
2096 ;; Why does `file-attributes' return a list (HIGH
2097 ;; LOW), but `visited-file-modtime' returns a cons
2098 ;; (HIGH . LOW)?
2099 (let ((mt (visited-file-modtime)))
2100 (< (abs (tramp-time-diff
2101 modtime (list (car mt) (cdr mt)))) 2)))
2102 (attr
2103 (save-excursion
2104 (tramp-send-command
2105 multi-method method user host
2106 (format "%s -ild %s"
2107 (tramp-get-ls-command multi-method method
2108 user host)
2109 (tramp-shell-quote-argument path)))
2110 (tramp-wait-for-output)
2111 (setq attr (buffer-substring
2112 (point) (progn (end-of-line) (point)))))
2113 (equal tramp-buffer-file-attributes attr))
2114 ;; If file does not exist, say it is not modified.
2115 (t nil)))))))
2116
2117 (defadvice clear-visited-file-modtime (after tramp activate)
2118 "Set `tramp-buffer-file-attributes' back to nil.
2119 Tramp uses this variable as an emulation for the actual modtime of the file,
2120 if the remote host can't provide the modtime."
2121 (setq tramp-buffer-file-attributes nil))
2122
2123 (defun tramp-handle-set-file-modes (filename mode)
2124 "Like `set-file-modes' for tramp files."
2125 (with-parsed-tramp-file-name filename nil
2126 (when (tramp-ange-ftp-file-name-p multi-method method)
2127 (tramp-invoke-ange-ftp 'set-file-modes mode filename))
2128 (save-excursion
2129 (unless (zerop (tramp-send-command-and-check
2130 multi-method method user host
2131 (format "chmod %s %s"
2132 (tramp-decimal-to-octal mode)
2133 (tramp-shell-quote-argument path))))
2134 (signal 'file-error
2135 (list "Doing chmod"
2136 ;; FIXME: extract the proper text from chmod's stderr.
2137 "error while changing file's mode"
2138 filename))))))
2139
2140 ;; Simple functions using the `test' command.
2141
2142 (defun tramp-handle-file-executable-p (filename)
2143 "Like `file-executable-p' for tramp files."
2144 (with-parsed-tramp-file-name filename nil
2145 (when (tramp-ange-ftp-file-name-p multi-method method)
2146 (tramp-invoke-ange-ftp 'file-executable-p filename))
2147 (zerop (tramp-run-test "-x" filename))))
2148
2149 (defun tramp-handle-file-readable-p (filename)
2150 "Like `file-readable-p' for tramp files."
2151 (with-parsed-tramp-file-name filename nil
2152 (when (tramp-ange-ftp-file-name-p multi-method method)
2153 (tramp-invoke-ange-ftp 'file-readable-p filename))
2154 (zerop (tramp-run-test "-r" filename))))
2155
2156 (defun tramp-handle-file-accessible-directory-p (filename)
2157 "Like `file-accessible-directory-p' for tramp files."
2158 (with-parsed-tramp-file-name filename nil
2159 (when (tramp-ange-ftp-file-name-p multi-method method)
2160 (tramp-invoke-ange-ftp 'file-accessible-directory-p filename))
2161 (and (zerop (tramp-run-test "-d" filename))
2162 (zerop (tramp-run-test "-r" filename))
2163 (zerop (tramp-run-test "-x" filename)))))
2164
2165 ;; When the remote shell is started, it looks for a shell which groks
2166 ;; tilde expansion. Here, we assume that all shells which grok tilde
2167 ;; expansion will also provide a `test' command which groks `-nt' (for
2168 ;; newer than). If this breaks, tell me about it and I'll try to do
2169 ;; something smarter about it.
2170 (defun tramp-handle-file-newer-than-file-p (file1 file2)
2171 "Like `file-newer-than-file-p' for tramp files."
2172 (cond ((not (file-exists-p file1))
2173 nil)
2174 ((not (file-exists-p file2))
2175 t)
2176 ;; We are sure both files exist at this point.
2177 (t
2178 (save-excursion
2179 ;; We try to get the mtime of both files. If they are not
2180 ;; equal to the "dont-know" value, then we subtract the times
2181 ;; and obtain the result.
2182 (let ((fa1 (file-attributes file1))
2183 (fa2 (file-attributes file2)))
2184 (if (and (not (equal (nth 5 fa1) '(0 0)))
2185 (not (equal (nth 5 fa2) '(0 0))))
2186 (> 0 (car (subtract-time (nth 5 fa1) (nth 5 fa2))))
2187 ;; If one of them is the dont-know value, then we can
2188 ;; still try to run a shell command on the remote host.
2189 ;; However, this only works if both files are Tramp
2190 ;; files and both have the same method, same user, same
2191 ;; host.
2192 (unless (and (tramp-tramp-file-p file1)
2193 (tramp-tramp-file-p file2))
2194 (signal
2195 'file-error
2196 (list
2197 "Cannot check if Tramp file is newer than non-Tramp file"
2198 file1 file2)))
2199 (with-parsed-tramp-file-name file1 v1
2200 (with-parsed-tramp-file-name file2 v2
2201 (when (and (tramp-ange-ftp-file-name-p
2202 v1-multi-method v1-method)
2203 (tramp-ange-ftp-file-name-p
2204 v2-multi-method v2-method))
2205 (tramp-invoke-ange-ftp 'file-newer-than-file-p
2206 file1 file2))
2207 (unless (and (equal v1-multi-method v2-multi-method)
2208 (equal v1-method v2-method)
2209 (equal v1-user v2-user)
2210 (equal v1-host v2-host))
2211 (signal 'file-error
2212 (list "Files must have same method, user, host"
2213 file1 file2)))
2214 (unless (and (tramp-tramp-file-p file1)
2215 (tramp-tramp-file-p file2))
2216 (signal 'file-error
2217 (list "Files must be tramp files on same host"
2218 file1 file2)))
2219 (if (tramp-get-test-groks-nt
2220 v1-multi-method v1-method v1-user v1-host)
2221 (zerop (tramp-run-test2 "test" file1 file2 "-nt"))
2222 (zerop (tramp-run-test2
2223 "tramp_test_nt" file1 file2)))))))))))
2224
2225 ;; Functions implemented using the basic functions above.
2226
2227 (defun tramp-handle-file-modes (filename)
2228 "Like `file-modes' for tramp files."
2229 (with-parsed-tramp-file-name filename nil
2230 (when (tramp-ange-ftp-file-name-p multi-method method)
2231 (tramp-invoke-ange-ftp 'file-modes filename))
2232 (when (file-exists-p filename)
2233 (tramp-mode-string-to-int
2234 (nth 8 (tramp-handle-file-attributes filename))))))
2235
2236 (defun tramp-handle-file-directory-p (filename)
2237 "Like `file-directory-p' for tramp files."
2238 ;; Care must be taken that this function returns `t' for symlinks
2239 ;; pointing to directories. Surely the most obvious implementation
2240 ;; would be `test -d', but that returns false for such symlinks.
2241 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
2242 ;; I now think he's right. So we could be using `test -d', couldn't
2243 ;; we?
2244 ;;
2245 ;; Alternatives: `cd %s', `test -d %s'
2246 (with-parsed-tramp-file-name filename nil
2247 (when (tramp-ange-ftp-file-name-p multi-method method)
2248 (tramp-invoke-ange-ftp 'file-directory-p filename))
2249 (save-excursion
2250 (zerop
2251 (tramp-send-command-and-check
2252 multi-method method user host
2253 (format "test -d %s"
2254 (tramp-shell-quote-argument path))
2255 t))))) ;run command in subshell
2256
2257 (defun tramp-handle-file-regular-p (filename)
2258 "Like `file-regular-p' for tramp files."
2259 (with-parsed-tramp-file-name filename nil
2260 (when (tramp-ange-ftp-file-name-p multi-method method)
2261 (tramp-invoke-ange-ftp 'file-regular-p filename))
2262 (and (tramp-handle-file-exists-p filename)
2263 (eq ?- (aref (nth 8 (tramp-handle-file-attributes filename)) 0)))))
2264
2265 (defun tramp-handle-file-symlink-p (filename)
2266 "Like `file-symlink-p' for tramp files."
2267 (with-parsed-tramp-file-name filename nil
2268 (when (tramp-ange-ftp-file-name-p multi-method method)
2269 (tramp-invoke-ange-ftp 'file-symlink-p filename))
2270 (let ((x (car (tramp-handle-file-attributes filename))))
2271 (when (stringp x) x))))
2272
2273 (defun tramp-handle-file-writable-p (filename)
2274 "Like `file-writable-p' for tramp files."
2275 (with-parsed-tramp-file-name filename nil
2276 (when (tramp-ange-ftp-file-name-p multi-method method)
2277 (tramp-invoke-ange-ftp 'file-writable-p filename))
2278 (if (tramp-handle-file-exists-p filename)
2279 ;; Existing files must be writable.
2280 (zerop (tramp-run-test "-w" filename))
2281 ;; If file doesn't exist, check if directory is writable.
2282 (and (zerop (tramp-run-test
2283 "-d" (tramp-handle-file-name-directory filename)))
2284 (zerop (tramp-run-test
2285 "-w" (tramp-handle-file-name-directory filename)))))))
2286
2287 (defun tramp-handle-file-ownership-preserved-p (filename)
2288 "Like `file-ownership-preserved-p' for tramp files."
2289 (with-parsed-tramp-file-name filename nil
2290 (when (tramp-ange-ftp-file-name-p multi-method method)
2291 (tramp-invoke-ange-ftp 'file-ownership-preserved-p filename))
2292 (or (not (tramp-handle-file-exists-p filename))
2293 ;; Existing files must be writable.
2294 (zerop (tramp-run-test "-O" filename)))))
2295
2296 ;; Other file name ops.
2297
2298 ;; ;; Matthias Köppe <mkoeppe@mail.math.uni-magdeburg.de>
2299 ;; (defun tramp-handle-directory-file-name (directory)
2300 ;; "Like `directory-file-name' for tramp files."
2301 ;; (if (and (eq (aref directory (- (length directory) 1)) ?/)
2302 ;; (not (eq (aref directory (- (length directory) 2)) ?:)))
2303 ;; (substring directory 0 (- (length directory) 1))
2304 ;; directory))
2305
2306 ;; Philippe Troin <phil@fifi.org>
2307 (defun tramp-handle-directory-file-name (directory)
2308 "Like `directory-file-name' for tramp files."
2309 (with-parsed-tramp-file-name directory nil
2310 (when (tramp-ange-ftp-file-name-p multi-method method)
2311 (tramp-invoke-ange-ftp 'directory-file-name directory))
2312 (let ((directory-length-1 (1- (length directory))))
2313 (save-match-data
2314 (if (and (eq (aref directory directory-length-1) ?/)
2315 (eq (string-match tramp-file-name-regexp directory) 0)
2316 (/= (match-end 0) directory-length-1))
2317 (substring directory 0 directory-length-1)
2318 directory)))))
2319
2320 ;; Directory listings.
2321
2322 (defun tramp-handle-directory-files (directory
2323 &optional full match nosort files-only)
2324 "Like `directory-files' for tramp files."
2325 (with-parsed-tramp-file-name directory nil
2326 (when (tramp-ange-ftp-file-name-p multi-method method)
2327 (tramp-invoke-ange-ftp 'directory-files
2328 directory full match nosort files-only))
2329 (let (result x)
2330 (save-excursion
2331 (tramp-barf-unless-okay
2332 multi-method method user host
2333 (concat "cd " (tramp-shell-quote-argument path))
2334 nil
2335 'file-error
2336 "tramp-handle-directory-files: couldn't `cd %s'"
2337 (tramp-shell-quote-argument path))
2338 (tramp-send-command
2339 multi-method method user host
2340 (concat (tramp-get-ls-command multi-method method user host)
2341 " -a | cat"))
2342 (tramp-wait-for-output)
2343 (goto-char (point-max))
2344 (while (zerop (forward-line -1))
2345 (setq x (buffer-substring (point)
2346 (tramp-line-end-position)))
2347 (when (or (not match) (string-match match x))
2348 (if full
2349 (push (concat (file-name-as-directory directory)
2350 x)
2351 result)
2352 (push x result))))
2353 (tramp-send-command multi-method method user host "cd")
2354 (tramp-wait-for-output)
2355 ;; Remove non-files or non-directories if necessary. Using
2356 ;; the remote shell for this would probably be way faster.
2357 ;; Maybe something could be adapted from
2358 ;; tramp-handle-file-name-all-completions.
2359 (when files-only
2360 (let ((temp (nreverse result))
2361 item)
2362 (setq result nil)
2363 (if (equal files-only t)
2364 ;; files only
2365 (while temp
2366 (setq item (pop temp))
2367 (when (file-regular-p item)
2368 (push item result)))
2369 ;; directories only
2370 (while temp
2371 (setq item (pop temp))
2372 (when (file-directory-p item)
2373 (push item result)))))))
2374 result)))
2375
2376 ;; This function should return "foo/" for directories and "bar" for
2377 ;; files. We use `ls -ad' to get a list of files (including
2378 ;; directories), and `find . -type d \! -name . -prune' to get a list
2379 ;; of directories.
2380 (defun tramp-handle-file-name-all-completions (filename directory)
2381 "Like `file-name-all-completions' for tramp files."
2382 (with-parsed-tramp-file-name directory nil
2383 (when (tramp-ange-ftp-file-name-p multi-method method)
2384 (tramp-invoke-ange-ftp 'file-name-all-completions
2385 filename directory))
2386 (unless (save-match-data (string-match "/" filename))
2387 (let* ((nowild tramp-completion-without-shell-p)
2388 result)
2389 (save-excursion
2390 (tramp-barf-unless-okay
2391 multi-method method user host
2392 (format "cd %s" (tramp-shell-quote-argument path))
2393 nil 'file-error
2394 "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
2395 (tramp-shell-quote-argument path))
2396
2397 ;; Get a list of directories and files, including reliably
2398 ;; tagging the directories with a trailing '/'. Because I
2399 ;; rock. --daniel@danann.net
2400 (tramp-send-command
2401 multi-method method user host
2402 (format (concat "%s -a %s 2>/dev/null | while read f; do "
2403 "if test -d \"$f\" 2>/dev/null; "
2404 "then echo \"$f/\"; else echo \"$f\"; fi; done")
2405 (tramp-get-ls-command multi-method method user host)
2406 (if (or nowild (zerop (length filename)))
2407 ""
2408 (format "-d %s*"
2409 (tramp-shell-quote-argument filename)))))
2410
2411 ;; Now grab the output.
2412 (tramp-wait-for-output)
2413 (goto-char (point-max))
2414 (while (zerop (forward-line -1))
2415 (push (buffer-substring (point)
2416 (tramp-line-end-position))
2417 result))
2418
2419 (tramp-send-command multi-method method user host "cd")
2420 (tramp-wait-for-output)
2421
2422 ;; Return the list.
2423 (if nowild
2424 (all-completions filename (mapcar 'list result))
2425 result))))))
2426
2427
2428 ;; The following isn't needed for Emacs 20 but for 19.34?
2429 (defun tramp-handle-file-name-completion (filename directory)
2430 "Like `file-name-completion' for tramp files."
2431 (unless (tramp-tramp-file-p directory)
2432 (error
2433 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2434 directory))
2435 (with-parsed-tramp-file-name directory nil
2436 (when (tramp-ange-ftp-file-name-p multi-method method)
2437 (tramp-invoke-ange-ftp 'file-name-completion
2438 filename directory))
2439 (try-completion
2440 filename
2441 (mapcar (lambda (x) (cons x nil))
2442 (tramp-handle-file-name-all-completions filename directory)))))
2443
2444 ;; cp, mv and ln
2445
2446 (defun tramp-handle-add-name-to-file
2447 (filename newname &optional ok-if-already-exists)
2448 "Like `add-name-to-file' for tramp files."
2449 (with-parsed-tramp-file-name filename v1
2450 (with-parsed-tramp-file-name newname v2
2451 (let ((ln (when v1 (tramp-get-remote-ln
2452 v1-multi-method v1-method v1-user v1-host))))
2453 (unless (and v1-method v2-method v1-user v2-user v1-host v2-host
2454 (equal v1-multi-method v2-multi-method)
2455 (equal v1-method v2-method)
2456 (equal v1-user v2-user)
2457 (equal v1-host v2-host))
2458 (error "add-name-to-file: %s"
2459 "only implemented for same method, same user, same host"))
2460 (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2461 (tramp-ange-ftp-file-name-p v2-multi-method v2-method))
2462 (tramp-invoke-ange-ftp 'add-name-to-file
2463 filename newname ok-if-already-exists))
2464 (when (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2465 (tramp-invoke-ange-ftp 'add-name-to-file
2466 filename newname ok-if-already-exists))
2467 (when (tramp-ange-ftp-file-name-p v2-multi-method v2-method)
2468 (tramp-invoke-ange-ftp 'add-name-to-file
2469 filename newname ok-if-already-exists))
2470 (when (and (not ok-if-already-exists)
2471 (file-exists-p newname)
2472 (not (numberp ok-if-already-exists))
2473 (y-or-n-p
2474 (format
2475 "File %s already exists; make it a new name anyway? "
2476 newname)))
2477 (error "add-name-to-file: file %s already exists" newname))
2478 (tramp-barf-unless-okay
2479 v1-multi-method v1-method v1-user v1-host
2480 (format "%s %s %s" ln (tramp-shell-quote-argument v1-path)
2481 (tramp-shell-quote-argument v2-path))
2482 nil 'file-error
2483 "error with add-name-to-file, see buffer `%s' for details"
2484 (buffer-name))))))
2485
2486 (defun tramp-handle-copy-file
2487 (filename newname &optional ok-if-already-exists keep-date)
2488 "Like `copy-file' for tramp files."
2489 ;; Check if both files are local -- invoke normal copy-file.
2490 ;; Otherwise, use tramp from local system.
2491 (setq filename (expand-file-name filename))
2492 (setq newname (expand-file-name newname))
2493 ;; At least one file a tramp file?
2494 (if (or (tramp-tramp-file-p filename)
2495 (tramp-tramp-file-p newname))
2496 (tramp-do-copy-or-rename-file
2497 'copy filename newname ok-if-already-exists keep-date)
2498 (tramp-run-real-handler
2499 'copy-file
2500 (list filename newname ok-if-already-exists keep-date))))
2501
2502 (defun tramp-handle-rename-file
2503 (filename newname &optional ok-if-already-exists)
2504 "Like `rename-file' for tramp files."
2505 ;; Check if both files are local -- invoke normal rename-file.
2506 ;; Otherwise, use tramp from local system.
2507 (setq filename (expand-file-name filename))
2508 (setq newname (expand-file-name newname))
2509 ;; At least one file a tramp file?
2510 (if (or (tramp-tramp-file-p filename)
2511 (tramp-tramp-file-p newname))
2512 (tramp-do-copy-or-rename-file
2513 'rename filename newname ok-if-already-exists)
2514 (tramp-run-real-handler 'rename-file
2515 (list filename newname ok-if-already-exists))))
2516
2517 (defun tramp-do-copy-or-rename-file
2518 (op filename newname &optional ok-if-already-exists keep-date)
2519 "Copy or rename a remote file.
2520 OP must be `copy' or `rename' and indicates the operation to perform.
2521 FILENAME specifies the file to copy or rename, NEWNAME is the name of
2522 the new file (for copy) or the new name of the file (for rename).
2523 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
2524 KEEP-DATE means to make sure that NEWNAME has the same timestamp
2525 as FILENAME.
2526
2527 This function is invoked by `tramp-handle-copy-file' and
2528 `tramp-handle-rename-file'. It is an error if OP is neither of `copy'
2529 and `rename'. FILENAME and NEWNAME must be absolute file names."
2530 (unless (memq op '(copy rename))
2531 (error "Unknown operation `%s', must be `copy' or `rename'" op))
2532 (unless ok-if-already-exists
2533 (when (file-exists-p newname)
2534 (signal 'file-already-exists
2535 (list newname))))
2536 (let ((t1 (tramp-tramp-file-p filename))
2537 (t2 (tramp-tramp-file-p newname)))
2538 ;; Check which ones of source and target are Tramp files.
2539 (cond
2540 ((and t1 t2)
2541 ;; Both are Tramp files.
2542 (with-parsed-tramp-file-name filename v1
2543 (with-parsed-tramp-file-name newname v2
2544 ;; Possibly invoke Ange-FTP.
2545 (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2546 (tramp-ange-ftp-file-name-p v2-multi-method v2-method))
2547 (if (eq op 'copy)
2548 (tramp-invoke-ange-ftp
2549 'copy-file filename newname ok-if-already-exists keep-date)
2550 (tramp-invoke-ange-ftp
2551 'rename-file filename newname ok-if-already-exists)))
2552 ;; Check if we can use a shortcut.
2553 (if (and (equal v1-multi-method v2-multi-method)
2554 (equal v1-method v2-method)
2555 (equal v1-host v2-host)
2556 (equal v1-user v2-user))
2557 ;; Shortcut: if method, host, user are the same for both
2558 ;; files, we invoke `cp' or `mv' on the remote host
2559 ;; directly.
2560 (tramp-do-copy-or-rename-file-directly
2561 op v1-multi-method v1-method v1-user v1-host
2562 v1-path v2-path keep-date)
2563 ;; The shortcut was not possible. So we copy the
2564 ;; file first. If the operation was `rename', we go
2565 ;; back and delete the original file (if the copy was
2566 ;; successful). The approach is simple-minded: we
2567 ;; create a new buffer, insert the contents of the
2568 ;; source file into it, then write out the buffer to
2569 ;; the target file. The advantage is that it doesn't
2570 ;; matter which filename handlers are used for the
2571 ;; source and target file.
2572
2573 ;; CCC: If both source and target are Tramp files,
2574 ;; and both are using the same rcp-program, then we
2575 ;; can invoke rcp directly. Note that
2576 ;; default-directory should point to a local
2577 ;; directory if we want to invoke rcp.
2578 (tramp-do-copy-or-rename-via-buffer
2579 op filename newname keep-date)))))
2580 ((or t1 t2)
2581 ;; Use the generic method via a Tramp buffer.
2582 (tramp-do-copy-or-rename-via-buffer op filename newname keep-date))
2583 (t
2584 ;; One of them must be a Tramp file.
2585 (error "Tramp implementation says this cannot happen")))))
2586
2587 (defun tramp-do-copy-or-rename-via-buffer (op filename newname keep-date)
2588 "Use an Emacs buffer to copy or rename a file.
2589 First arg OP is either `copy' or `rename' and indicates the operation.
2590 FILENAME is the source file, NEWNAME the target file.
2591 KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
2592 (let ((trampbuf (get-buffer-create "*tramp output*")))
2593 (when keep-date
2594 (tramp-message
2595 1 (concat "Warning: cannot preserve file time stamp"
2596 " with inline copying across machines")))
2597 (save-excursion
2598 (set-buffer trampbuf) (erase-buffer)
2599 (insert-file-contents-literally filename)
2600 (let ((coding-system-for-write 'no-conversion))
2601 (write-region (point-min) (point-max) newname)))
2602 ;; If the operation was `rename', delete the original file.
2603 (unless (eq op 'copy)
2604 (delete-file filename))))
2605
2606 (defun tramp-do-copy-or-rename-file-directly
2607 (op multi-method method user host path1 path2 keep-date)
2608 "Invokes `cp' or `mv' on the remote system.
2609 OP must be one of `copy' or `rename', indicating `cp' or `mv',
2610 respectively. METHOD, USER, and HOST specify the connection.
2611 PATH1 and PATH2 specify the two arguments of `cp' or `mv'.
2612 If KEEP-DATE is non-nil, preserve the time stamp when copying."
2613 ;; CCC: What happens to the timestamp when renaming?
2614 (let ((cmd (cond ((and (eq op 'copy) keep-date) "cp -f -p")
2615 ((eq op 'copy) "cp -f")
2616 ((eq op 'rename) "mv -f")
2617 (t (error
2618 "Unknown operation `%s', must be `copy' or `rename'"
2619 op)))))
2620 (save-excursion
2621 (tramp-barf-unless-okay
2622 multi-method method user host
2623 (format "%s %s %s"
2624 cmd
2625 (tramp-shell-quote-argument path1)
2626 (tramp-shell-quote-argument path2))
2627 nil 'file-error
2628 "Copying directly failed, see buffer `%s' for details."
2629 (buffer-name)))))
2630
2631 ;; mkdir
2632 (defun tramp-handle-make-directory (dir &optional parents)
2633 "Like `make-directory' for tramp files."
2634 (setq dir (expand-file-name dir))
2635 (with-parsed-tramp-file-name dir nil
2636 (when (tramp-ange-ftp-file-name-p multi-method method)
2637 (tramp-invoke-ange-ftp 'make-directory dir parents))
2638 (save-excursion
2639 (tramp-barf-unless-okay
2640 multi-method method user host
2641 (format " %s %s"
2642 (if parents "mkdir -p" "mkdir")
2643 (tramp-shell-quote-argument path))
2644 nil 'file-error
2645 "Couldn't make directory %s" dir))))
2646
2647 ;; CCC error checking?
2648 (defun tramp-handle-delete-directory (directory)
2649 "Like `delete-directory' for tramp files."
2650 (setq directory (expand-file-name directory))
2651 (with-parsed-tramp-file-name directory nil
2652 (when (tramp-ange-ftp-file-name-p multi-method method)
2653 (tramp-invoke-ange-ftp 'delete-directory directory))
2654 (save-excursion
2655 (tramp-send-command
2656 multi-method method user host
2657 (format "rmdir %s ; echo ok"
2658 (tramp-shell-quote-argument path)))
2659 (tramp-wait-for-output))))
2660
2661 (defun tramp-handle-delete-file (filename)
2662 "Like `delete-file' for tramp files."
2663 (setq filename (expand-file-name filename))
2664 (with-parsed-tramp-file-name filename nil
2665 (when (tramp-ange-ftp-file-name-p multi-method method)
2666 (tramp-invoke-ange-ftp 'delete-file filename))
2667 (save-excursion
2668 (unless (zerop (tramp-send-command-and-check
2669 multi-method method user host
2670 (format "rm -f %s"
2671 (tramp-shell-quote-argument path))))
2672 (signal 'file-error "Couldn't delete Tramp file")))))
2673
2674 ;; Dired.
2675
2676 ;; CCC: This does not seem to be enough. Something dies when
2677 ;; we try and delete two directories under TRAMP :/
2678 (defun tramp-handle-dired-recursive-delete-directory (filename)
2679 "Recursively delete the directory given.
2680 This is like `dired-recursive-delete-directory' for tramp files."
2681 (with-parsed-tramp-file-name filename nil
2682 (when (tramp-ange-ftp-file-name-p multi-method method)
2683 (tramp-invoke-ange-ftp 'dired-recursive-delete-directory
2684 filename))
2685 ;; run a shell command 'rm -r <path>'
2686 ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
2687 (or (tramp-handle-file-exists-p filename)
2688 (signal
2689 'file-error
2690 (list "Removing old file name" "no such directory" filename)))
2691 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
2692 (tramp-send-command multi-method method user host
2693 (format "rm -r %s" (tramp-shell-quote-argument path)))
2694 ;; Wait for the remote system to return to us...
2695 ;; This might take a while, allow it plenty of time.
2696 (tramp-wait-for-output 120)
2697 ;; Make sure that it worked...
2698 (and (tramp-handle-file-exists-p filename)
2699 (error "Failed to recusively delete %s" filename))))
2700
2701
2702 (defun tramp-handle-dired-call-process (program discard &rest arguments)
2703 "Like `dired-call-process' for tramp files."
2704 (with-parsed-tramp-file-name default-directory nil
2705 (when (tramp-ange-ftp-file-name-p multi-method method)
2706 (let ((default-directory
2707 (tramp-make-ange-ftp-file-name user host path)))
2708 (tramp-invoke-ange-ftp 'dired-call-process
2709 program discard arguments)))
2710 (save-excursion
2711 (tramp-barf-unless-okay
2712 multi-method method user host
2713 (format "cd %s" (tramp-shell-quote-argument path))
2714 nil 'file-error
2715 "tramp-handle-dired-call-process: Couldn't `cd %s'"
2716 (tramp-shell-quote-argument path))
2717 (tramp-send-command
2718 multi-method method user host
2719 (mapconcat #'tramp-shell-quote-argument (cons program arguments) " "))
2720 (tramp-wait-for-output))
2721 (unless discard
2722 (insert-buffer (tramp-get-buffer multi-method method user host)))
2723 (save-excursion
2724 (prog1
2725 (tramp-send-command-and-check multi-method method user host nil)
2726 (tramp-send-command multi-method method user host "cd")
2727 (tramp-wait-for-output)))))
2728
2729 ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
2730 ;; not sure at all that this is the right way to do it, but let's hope
2731 ;; it works for now, and wait for a guru to point out the Right Way to
2732 ;; achieve this.
2733 ;;(eval-when-compile
2734 ;; (unless (fboundp 'dired-insert-set-properties)
2735 ;; (fset 'dired-insert-set-properties 'ignore)))
2736 ;; Gerd suggests this:
2737 (eval-when-compile (require 'dired))
2738 ;; Note that dired is required at run-time, too, when it is needed.
2739 ;; It is only needed on XEmacs for the function
2740 ;; `dired-insert-set-properties'.
2741
2742 (defun tramp-handle-insert-directory
2743 (filename switches &optional wildcard full-directory-p)
2744 "Like `insert-directory' for tramp files."
2745 ;; For the moment, we assume that the remote "ls" program does not
2746 ;; grok "--dired". In the future, we should detect this on
2747 ;; connection setup.
2748 (when (string-match "^--dired\\s-+" switches)
2749 (setq switches (replace-match "" nil t switches)))
2750 (setq filename (expand-file-name filename))
2751 (with-parsed-tramp-file-name filename nil
2752 (when (tramp-ange-ftp-file-name-p multi-method method)
2753 (tramp-invoke-ange-ftp 'insert-directory
2754 filename switches wildcard full-directory-p))
2755 (tramp-message-for-buffer
2756 multi-method method user host 10
2757 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
2758 switches filename (if wildcard "yes" "no")
2759 (if full-directory-p "yes" "no"))
2760 (when wildcard
2761 (setq wildcard (file-name-nondirectory path))
2762 (setq path (file-name-directory path)))
2763 (when (listp switches)
2764 (setq switches (mapconcat 'identity switches " ")))
2765 (unless full-directory-p
2766 (setq switches (concat "-d " switches)))
2767 (when wildcard
2768 (setq switches (concat switches " " wildcard)))
2769 (save-excursion
2770 ;; If `full-directory-p', we just say `ls -l FILENAME'.
2771 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
2772 (if full-directory-p
2773 (tramp-send-command
2774 multi-method method user host
2775 (format "%s %s %s"
2776 (tramp-get-ls-command multi-method method user host)
2777 switches
2778 (if wildcard
2779 path
2780 (tramp-shell-quote-argument (concat path ".")))))
2781 (tramp-barf-unless-okay
2782 multi-method method user host
2783 (format "cd %s" (tramp-shell-quote-argument
2784 (file-name-directory path)))
2785 nil 'file-error
2786 "Couldn't `cd %s'"
2787 (tramp-shell-quote-argument (file-name-directory path)))
2788 (tramp-send-command
2789 multi-method method user host
2790 (format "%s %s %s"
2791 (tramp-get-ls-command multi-method method user host)
2792 switches
2793 (if full-directory-p
2794 ;; Add "/." to make sure we got complete dir
2795 ;; listing for symlinks, too.
2796 (concat (file-name-as-directory
2797 (file-name-nondirectory path)) ".")
2798 (file-name-nondirectory path)))))
2799 (sit-for 1) ;needed for rsh but not ssh?
2800 (tramp-wait-for-output))
2801 (let ((old-pos (point)))
2802 (insert-buffer-substring
2803 (tramp-get-buffer multi-method method user host))
2804 ;; On XEmacs, we want to call (exchange-point-and-mark t), but
2805 ;; that doesn't exist on Emacs, so we use this workaround instead.
2806 ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
2807 ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>.
2808 ;; (let ((zmacs-region-stays t))
2809 ;; (exchange-point-and-mark))
2810 (save-excursion
2811 (tramp-send-command multi-method method user host "cd")
2812 (tramp-wait-for-output))
2813 ;; Another XEmacs specialty follows. What's the right way to do
2814 ;; it?
2815 (when (and (featurep 'xemacs)
2816 (eq major-mode 'dired-mode))
2817 (save-excursion
2818 (require 'dired)
2819 (dired-insert-set-properties old-pos (point)))))))
2820
2821 ;; Continuation of kluge to pacify byte-compiler.
2822 ;;(eval-when-compile
2823 ;; (when (eq (symbol-function 'dired-insert-set-properties) 'ignore)
2824 ;; (fmakunbound 'dired-insert-set-properties)))
2825
2826 ;; CCC is this the right thing to do?
2827 (defun tramp-handle-unhandled-file-name-directory (filename)
2828 "Like `unhandled-file-name-directory' for tramp files."
2829 (with-parsed-tramp-file-name filename nil
2830 (when (tramp-ange-ftp-file-name-p multi-method method)
2831 (tramp-invoke-ange-ftp 'unhandled-file-name-directory
2832 filename))
2833 (expand-file-name "~/")))
2834
2835 ;; Canonicalization of file names.
2836
2837 (defun tramp-drop-volume-letter (name)
2838 "Cut off unnecessary drive letter from file NAME.
2839 The function `tramp-handle-expand-file-name' calls `expand-file-name'
2840 locally on a remote file name. When the local system is a W32 system
2841 but the remote system is Unix, this introduces a superfluous drive
2842 letter into the file name. This function removes it.
2843
2844 Doesn't do anything if the NAME does not start with a drive letter."
2845 (if (and (> (length name) 1)
2846 (char-equal (aref name 1) ?:)
2847 (let ((c1 (aref name 0)))
2848 (or (and (>= c1 ?A) (<= c1 ?Z))
2849 (and (>= c1 ?a) (<= c1 ?z)))))
2850 (substring name 2)
2851 name))
2852
2853 (defun tramp-handle-expand-file-name (name &optional dir)
2854 "Like `expand-file-name' for tramp files."
2855 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
2856 (setq dir (or dir default-directory "/"))
2857 ;; Unless NAME is absolute, concat DIR and NAME.
2858 (unless (file-name-absolute-p name)
2859 (setq name (concat (file-name-as-directory dir) name)))
2860 ;; If NAME is not a tramp file, run the real handler
2861 (if (not (tramp-tramp-file-p name))
2862 (tramp-run-real-handler 'expand-file-name
2863 (list name nil))
2864 ;; Dissect NAME.
2865 (with-parsed-tramp-file-name name nil
2866 (when (tramp-ange-ftp-file-name-p multi-method method)
2867 (tramp-invoke-ange-ftp 'expand-file-name name nil))
2868 (unless (file-name-absolute-p path)
2869 (setq path (concat "~/" path)))
2870 (save-excursion
2871 ;; Tilde expansion if necessary. This needs a shell which
2872 ;; groks tilde expansion! The function `tramp-find-shell' is
2873 ;; supposed to find such a shell on the remote host. Please
2874 ;; tell me about it when this doesn't work on your system.
2875 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" path)
2876 (let ((uname (match-string 1 path))
2877 (fname (match-string 2 path)))
2878 ;; CCC fanatic error checking?
2879 (set-buffer (tramp-get-buffer multi-method method user host))
2880 (erase-buffer)
2881 (tramp-send-command
2882 multi-method method user host
2883 (format "cd %s; pwd" uname)
2884 t)
2885 (tramp-wait-for-output)
2886 (goto-char (point-min))
2887 (setq uname (buffer-substring (point) (tramp-line-end-position)))
2888 (setq path (concat uname fname))
2889 (erase-buffer)))
2890 ;; No tilde characters in file name, do normal
2891 ;; expand-file-name (this does "/./" and "/../"). We bind
2892 ;; directory-sep-char here for XEmacs on Windows, which would
2893 ;; otherwise use backslash.
2894 (let ((directory-sep-char ?/))
2895 (tramp-make-tramp-file-name
2896 multi-method method user host
2897 (tramp-drop-volume-letter
2898 (tramp-run-real-handler 'expand-file-name (list path)))))))))
2899
2900 ;; Remote commands.
2901
2902 (defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
2903 "Like `shell-command' for tramp files.
2904 This will break if COMMAND prints a newline, followed by the value of
2905 `tramp-end-of-output', followed by another newline."
2906 (when (tramp-tramp-file-p default-directory)
2907 (with-parsed-tramp-file-name default-directory nil
2908 (when (tramp-ange-ftp-file-name-p multi-method method)
2909 (let ((default-directory (tramp-make-ange-ftp-file-name
2910 user host path)))
2911 (tramp-invoke-ange-ftp 'shell-command
2912 command output-buffer error-buffer)))
2913 (let (status)
2914 (when (string-match "&[ \t]*\\'" command)
2915 (error "Tramp doesn't grok asynchronous shell commands, yet"))
2916 (when error-buffer
2917 (error "Tramp doesn't grok optional third arg ERROR-BUFFER, yet"))
2918 (save-excursion
2919 (tramp-barf-unless-okay
2920 multi-method method user host
2921 (format "cd %s" (tramp-shell-quote-argument path))
2922 nil 'file-error
2923 "tramp-handle-shell-command: Couldn't `cd %s'"
2924 (tramp-shell-quote-argument path))
2925 (tramp-send-command multi-method method user host
2926 (concat command "; tramp_old_status=$?"))
2927 ;; This will break if the shell command prints "/////"
2928 ;; somewhere. Let's just hope for the best...
2929 (tramp-wait-for-output))
2930 (unless output-buffer
2931 (setq output-buffer (get-buffer-create "*Shell Command Output*"))
2932 (set-buffer output-buffer)
2933 (erase-buffer))
2934 (unless (bufferp output-buffer)
2935 (setq output-buffer (current-buffer)))
2936 (set-buffer output-buffer)
2937 (insert-buffer (tramp-get-buffer multi-method method user host))
2938 (save-excursion
2939 (tramp-send-command multi-method method user host "cd")
2940 (tramp-wait-for-output)
2941 (tramp-send-command
2942 multi-method method user host
2943 (concat "tramp_set_exit_status $tramp_old_status;"
2944 " echo tramp_exit_status $?"))
2945 (tramp-wait-for-output)
2946 (goto-char (point-max))
2947 (unless (search-backward "tramp_exit_status " nil t)
2948 (error "Couldn't find exit status of `%s'" command))
2949 (skip-chars-forward "^ ")
2950 (setq status (read (current-buffer))))
2951 (unless (zerop (buffer-size))
2952 (pop-to-buffer output-buffer))
2953 status)))
2954 ;; The following is only executed if something strange was
2955 ;; happening. Emit a helpful message and do it anyway.
2956 (message "tramp-handle-shell-command called with non-tramp directory: `%s'"
2957 default-directory)
2958 (tramp-run-real-handler 'shell-command
2959 (list command output-buffer error-buffer)))
2960
2961 ;; File Editing.
2962
2963 (defsubst tramp-make-temp-file ()
2964 (funcall (if (fboundp 'make-temp-file) 'make-temp-file 'make-temp-name)
2965 (expand-file-name tramp-temp-name-prefix
2966 (tramp-temporary-file-directory))))
2967
2968 (defun tramp-handle-file-local-copy (filename)
2969 "Like `file-local-copy' for tramp files."
2970 (with-parsed-tramp-file-name filename nil
2971 (when (tramp-ange-ftp-file-name-p multi-method method)
2972 (tramp-invoke-ange-ftp 'file-local-copy filename))
2973 (let ((trampbuf (get-buffer-create "*tramp output*"))
2974 (rcp-program (tramp-get-rcp-program
2975 multi-method
2976 (tramp-find-method multi-method method user host)
2977 user host))
2978 (rcp-args (tramp-get-rcp-args
2979 multi-method
2980 (tramp-find-method multi-method method user host)
2981 user host))
2982 tmpfil)
2983 (unless (file-exists-p filename)
2984 (error "Cannot make local copy of non-existing file `%s'"
2985 filename))
2986 (setq tmpfil (tramp-make-temp-file))
2987 (cond (rcp-program
2988 ;; Use rcp-like program for file transfer.
2989 (tramp-message-for-buffer
2990 multi-method method user host
2991 5 "Fetching %s to tmp file %s..." filename tmpfil)
2992 (save-excursion (set-buffer trampbuf) (erase-buffer))
2993 (unless (equal
2994 0
2995 (apply #'call-process
2996 rcp-program
2997 nil trampbuf nil
2998 (append rcp-args
2999 (list
3000 (tramp-make-rcp-program-file-name
3001 user host
3002 (tramp-shell-quote-argument path))
3003 tmpfil))))
3004 (pop-to-buffer trampbuf)
3005 (error
3006 (concat "tramp-handle-file-local-copy: `%s' didn't work, "
3007 "see buffer `%s' for details")
3008 rcp-program trampbuf))
3009 (tramp-message-for-buffer
3010 multi-method method user host
3011 5 "Fetching %s to tmp file %s...done" filename tmpfil))
3012 ((and (tramp-get-remote-encoding multi-method method user host)
3013 (tramp-get-remote-decoding multi-method method user host))
3014 ;; Use inline encoding for file transfer.
3015 (save-excursion
3016 ;; Following line for setting tramp-current-method,
3017 ;; tramp-current-user, tramp-current-host.
3018 (set-buffer (tramp-get-buffer multi-method method user host))
3019 (tramp-message 5 "Encoding remote file %s..." filename)
3020 (tramp-barf-unless-okay
3021 multi-method method user host
3022 (concat (tramp-get-remote-encoding
3023 multi-method method user host)
3024 " < " (tramp-shell-quote-argument path))
3025 nil 'file-error
3026 "Encoding remote file failed, see buffer `%s' for details"
3027 (tramp-get-buffer multi-method method user host))
3028 ;; Remove trailing status code
3029 (goto-char (point-max))
3030 (delete-region (point) (progn (forward-line -1) (point)))
3031
3032 (tramp-message 5 "Decoding remote file %s..." filename)
3033
3034 (let ((loc-enc (tramp-get-local-encoding
3035 multi-method method user host))
3036 (loc-dec (tramp-get-local-decoding
3037 multi-method method user host)))
3038 (if (and (symbolp loc-dec) (fboundp loc-dec))
3039 ;; If local decoding is a function, we call it.
3040 (let ((tmpbuf (get-buffer-create " *tramp tmp*")))
3041 (set-buffer tmpbuf)
3042 (erase-buffer)
3043 (insert-buffer (tramp-get-buffer multi-method method
3044 user host))
3045 (tramp-message-for-buffer
3046 multi-method method user host
3047 6 "Decoding remote file %s with function %s..."
3048 filename loc-dec)
3049 (set-buffer tmpbuf)
3050 ;; Douglas Gray Stephens <DGrayStephens@slb.com>
3051 ;; says that we need to strip tramp_exit_status
3052 ;; line from the output here. Go to point-max,
3053 ;; search backward for tramp_exit_status, delete
3054 ;; between point and point-max if found.
3055 (let ((coding-system-for-write 'no-conversion))
3056 (funcall loc-dec (point-min) (point-max))
3057 (write-region (point-min) (point-max) tmpfil))
3058 (kill-buffer tmpbuf))
3059 ;; If tramp-decoding-function is not defined for this
3060 ;; method, we invoke tramp-decoding-command instead.
3061 (let ((tmpfil2 (tramp-make-temp-file)))
3062 (write-region (point-min) (point-max) tmpfil2)
3063 (tramp-message
3064 6 "Decoding remote file %s with command %s..."
3065 filename loc-dec)
3066 (tramp-call-local-coding-command
3067 loc-dec tmpfil2 tmpfil)
3068 (delete-file tmpfil2)))
3069 (tramp-message-for-buffer
3070 multi-method method user host
3071 5 "Decoding remote file %s...done" filename))))
3072
3073 (t (error "Wrong method specification for `%s'" method)))
3074 tmpfil)))
3075
3076
3077 (defun tramp-handle-insert-file-contents
3078 (filename &optional visit beg end replace)
3079 "Like `insert-file-contents' for tramp files."
3080 (barf-if-buffer-read-only)
3081 (setq filename (expand-file-name filename))
3082 (with-parsed-tramp-file-name filename nil
3083 (when (tramp-ange-ftp-file-name-p multi-method method)
3084 (tramp-invoke-ange-ftp 'insert-file-contents
3085 filename visit beg end replace))
3086 (if (not (tramp-handle-file-exists-p filename))
3087 (progn
3088 (when visit
3089 (setq buffer-file-name filename)
3090 (set-visited-file-modtime)
3091 (set-buffer-modified-p nil))
3092 (signal 'file-error
3093 (format "File `%s' not found on remote host" filename))
3094 (list (tramp-handle-expand-file-name filename) 0))
3095 (let ((local-copy (tramp-handle-file-local-copy filename))
3096 (coding-system-used nil)
3097 (result nil))
3098 (when visit
3099 (setq buffer-file-name filename)
3100 (set-visited-file-modtime)
3101 (set-buffer-modified-p nil))
3102 (tramp-message-for-buffer
3103 multi-method method user host
3104 9 "Inserting local temp file `%s'..." local-copy)
3105 (setq result
3106 (tramp-run-real-handler 'insert-file-contents
3107 (list local-copy nil beg end replace)))
3108 ;; Now `last-coding-system-used' has right value. Remember it.
3109 (when (boundp 'last-coding-system-used)
3110 (setq coding-system-used last-coding-system-used))
3111 (tramp-message-for-buffer
3112 multi-method method user host
3113 9 "Inserting local temp file `%s'...done" local-copy)
3114 (delete-file local-copy)
3115 (when (boundp 'last-coding-system-used)
3116 (setq last-coding-system-used coding-system-used))
3117 (list (expand-file-name filename)
3118 (second result))))))
3119
3120 ;; CCC grok APPEND, LOCKNAME, CONFIRM
3121 (defun tramp-handle-write-region
3122 (start end filename &optional append visit lockname confirm)
3123 "Like `write-region' for tramp files."
3124 (unless (eq append nil)
3125 (error "Cannot append to file using tramp (`%s')" filename))
3126 (setq filename (expand-file-name filename))
3127 ;; Following part commented out because we don't know what to do about
3128 ;; file locking, and it does not appear to be a problem to ignore it.
3129 ;; Ange-ftp ignores it, too.
3130 ;; (when (and lockname (stringp lockname))
3131 ;; (setq lockname (expand-file-name lockname)))
3132 ;; (unless (or (eq lockname nil)
3133 ;; (string= lockname filename))
3134 ;; (error
3135 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
3136 ;; XEmacs takes a coding system as the sevent argument, not `confirm'
3137 (when (and (not (featurep 'xemacs))
3138 confirm (file-exists-p filename))
3139 (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
3140 filename))
3141 (error "File not overwritten")))
3142 (with-parsed-tramp-file-name filename nil
3143 (when (tramp-ange-ftp-file-name-p multi-method method)
3144 (tramp-invoke-ange-ftp 'write-region
3145 start end filename append visit))
3146 (let ((curbuf (current-buffer))
3147 (rcp-program (tramp-get-rcp-program
3148 multi-method (tramp-find-method multi-method method user host)
3149 user host))
3150 (rcp-args (tramp-get-rcp-args
3151 multi-method
3152 (tramp-find-method multi-method method user host)
3153 user host))
3154 (rem-enc (tramp-get-remote-encoding multi-method method user host))
3155 (rem-dec (tramp-get-remote-decoding multi-method method user host))
3156 (loc-enc (tramp-get-local-encoding multi-method method user host))
3157 (loc-dec (tramp-get-local-decoding multi-method method user host))
3158 (trampbuf (get-buffer-create "*tramp output*"))
3159 ;; We use this to save the value of `last-coding-system-used'
3160 ;; after writing the tmp file. At the end of the function,
3161 ;; we set `last-coding-system-used' to this saved value.
3162 ;; This way, any intermediary coding systems used while
3163 ;; talking to the remote shell or suchlike won't hose this
3164 ;; variable. This approach was snarfed from ange-ftp.el.
3165 coding-system-used
3166 tmpfil)
3167 ;; Write region into a tmp file. This isn't really needed if we
3168 ;; use an encoding function, but currently we use it always
3169 ;; because this makes the logic simpler.
3170 (setq tmpfil (tramp-make-temp-file))
3171 ;; We say `no-message' here because we don't want the visited file
3172 ;; modtime data to be clobbered from the temp file. We call
3173 ;; `set-visited-file-modtime' ourselves later on.
3174 (tramp-run-real-handler
3175 'write-region
3176 (if confirm ; don't pass this arg unless defined for backward compat.
3177 (list start end tmpfil append 'no-message lockname confirm)
3178 (list start end tmpfil append 'no-message lockname)))
3179 ;; Now, `last-coding-system-used' has the right value. Remember it.
3180 (when (boundp 'last-coding-system-used)
3181 (setq coding-system-used last-coding-system-used))
3182 ;; This is a bit lengthy due to the different methods possible for
3183 ;; file transfer. First, we check whether the method uses an rcp
3184 ;; program. If so, we call it. Otherwise, both encoding and
3185 ;; decoding command must be specified. However, if the method
3186 ;; _also_ specifies an encoding function, then that is used for
3187 ;; encoding the contents of the tmp file.
3188 (cond (rcp-program
3189 ;; use rcp-like program for file transfer
3190 (let ((argl (append rcp-args
3191 (list
3192 tmpfil
3193 (tramp-make-rcp-program-file-name
3194 user host
3195 (tramp-shell-quote-argument path))))))
3196 (tramp-message-for-buffer
3197 multi-method method user host
3198 6 "Writing tmp file using `%s'..." rcp-program)
3199 (save-excursion (set-buffer trampbuf) (erase-buffer))
3200 (when tramp-debug-buffer
3201 (save-excursion
3202 (set-buffer (tramp-get-debug-buffer multi-method
3203 method user host))
3204 (goto-char (point-max))
3205 (tramp-insert-with-face
3206 'bold (format "$ %s %s\n" rcp-program
3207 (mapconcat 'identity argl " ")))))
3208 (unless (equal 0
3209 (apply #'call-process
3210 rcp-program nil trampbuf nil argl))
3211 (pop-to-buffer trampbuf)
3212 (error
3213 "Cannot write region to file `%s', command `%s' failed"
3214 filename rcp-program))
3215 (tramp-message-for-buffer
3216 multi-method method user host
3217 6 "Transferring file using `%s'...done"
3218 rcp-program)))
3219 ((and rem-enc rem-dec)
3220 ;; Use inline file transfer
3221 (let ((tmpbuf (get-buffer-create " *tramp file transfer*")))
3222 (save-excursion
3223 ;; Encode tmpfil into tmpbuf
3224 (tramp-message-for-buffer multi-method method user host
3225 5 "Encoding region...")
3226 (set-buffer tmpbuf)
3227 (erase-buffer)
3228 ;; Use encoding function or command.
3229 (if (and (symbolp loc-enc) (fboundp loc-enc))
3230 (progn
3231 (tramp-message-for-buffer
3232 multi-method method user host
3233 6 "Encoding region using function...")
3234 (insert-file-contents-literally tmpfil)
3235 ;; CCC. The following `let' is a workaround for
3236 ;; the base64.el that comes with pgnus-0.84. If
3237 ;; both of the following conditions are
3238 ;; satisfied, it tries to write to a local file
3239 ;; in default-directory, but at this point,
3240 ;; default-directory is remote.
3241 ;; (CALL-PROCESS-REGION can't write to remote
3242 ;; files, it seems.) The file in question is a
3243 ;; tmp file anyway.
3244 (let ((default-directory
3245 (tramp-temporary-file-directory)))
3246 (funcall loc-enc (point-min) (point-max)))
3247 (goto-char (point-max))
3248 (unless (bolp)
3249 (newline)))
3250 (tramp-message-for-buffer
3251 multi-method method user host
3252 6 "Encoding region using command `%s'..." loc-enc)
3253 (unless (equal 0 (tramp-call-local-coding-command
3254 loc-enc tmpfil t))
3255 (pop-to-buffer trampbuf)
3256 (error (concat "Cannot write to `%s', local encoding"
3257 " command `%s' failed")
3258 filename loc-enc)))
3259 ;; Send tmpbuf into remote decoding command which
3260 ;; writes to remote file. Because this happens on the
3261 ;; remote host, we cannot use the function.
3262 (tramp-message-for-buffer
3263 multi-method method user host
3264 5 "Decoding region into remote file %s..." filename)
3265 (tramp-send-command
3266 multi-method method user host
3267 (format "%s >%s <<'EOF'"
3268 rem-dec
3269 (tramp-shell-quote-argument path)))
3270 (set-buffer tmpbuf)
3271 (tramp-message-for-buffer
3272 multi-method method user host
3273 6 "Sending data to remote host...")
3274 (tramp-send-region multi-method method user host
3275 (point-min) (point-max))
3276 ;; wait for remote decoding to complete
3277 (tramp-message-for-buffer
3278 multi-method method user host
3279 6 "Sending end of data token...")
3280 (tramp-send-command
3281 multi-method method user host "EOF" nil t)
3282 (tramp-message-for-buffer
3283 multi-method method user host 6
3284 "Waiting for remote host to process data...")
3285 (set-buffer (tramp-get-buffer multi-method method user host))
3286 (tramp-wait-for-output)
3287 (tramp-barf-unless-okay
3288 multi-method method user host nil nil 'file-error
3289 (concat "Couldn't write region to `%s',"
3290 " decode using `%s' failed")
3291 filename rem-dec)
3292 (tramp-message 5 "Decoding region into remote file %s...done"
3293 filename)
3294 (kill-buffer tmpbuf))))
3295 (t
3296 (error
3297 (concat "Method `%s' should specify both encoding and "
3298 "decoding command or an rcp program")
3299 method)))
3300 (delete-file tmpfil)
3301 (unless (equal curbuf (current-buffer))
3302 (error "Buffer has changed from `%s' to `%s'"
3303 curbuf (current-buffer)))
3304 (when (eq visit t)
3305 (set-visited-file-modtime))
3306 ;; Make `last-coding-system-used' have the right value.
3307 (when (boundp 'last-coding-system-used)
3308 (setq last-coding-system-used coding-system-used))
3309 (when (or (eq visit t)
3310 (eq visit nil)
3311 (stringp visit))
3312 (message "Wrote %s" filename)))))
3313
3314 ;; Call down to the real handler.
3315 ;; Because EFS does not play nicely with TRAMP (both systems match an
3316 ;; TRAMP path) it is needed to disable efs as well as tramp for the
3317 ;; operation.
3318 ;;
3319 ;; Other than that, this is the canon file-handler code that the doco
3320 ;; says should be used here. Which is nice.
3321 ;;
3322 ;; Under XEmacs current, EFS also hooks in as
3323 ;; efs-sifn-handler-function to handle any path with environment
3324 ;; variables. This has two implications:
3325 ;; 1) That EFS may not be completely dead (yet) for TRAMP paths
3326 ;; 2) That TRAMP might want to do the same thing.
3327 ;; Details as they come in.
3328 ;;
3329 ;; Daniel Pittman <daniel@danann.net>
3330
3331 ;; (defun tramp-run-real-handler (operation args)
3332 ;; "Invoke normal file name handler for OPERATION.
3333 ;; This inhibits EFS and Ange-FTP, too, because they conflict with tramp.
3334 ;; First arg specifies the OPERATION, remaining ARGS are passed to the
3335 ;; OPERATION."
3336 ;; (let ((inhibit-file-name-handlers
3337 ;; (list 'tramp-file-name-handler
3338 ;; 'efs-file-handler-function
3339 ;; 'ange-ftp-hook-function
3340 ;; (and (eq inhibit-file-name-operation operation)
3341 ;; inhibit-file-name-handlers)))
3342 ;; (inhibit-file-name-operation operation))
3343 ;; (apply operation args)))
3344
3345 (defun tramp-run-real-handler (operation args)
3346 "Invoke normal file name handler for OPERATION.
3347 First arg specifies the OPERATION, second arg is a list of arguments to
3348 pass to the OPERATION."
3349 (let* ((op (if (eq operation 'ange-ftp-hook-function)
3350 (car args)
3351 operation))
3352 (inhibit-file-name-handlers
3353 (list 'tramp-file-name-handler
3354 'tramp-completion-file-name-handler
3355 (and (eq inhibit-file-name-operation op)
3356 inhibit-file-name-handlers)))
3357 (inhibit-file-name-operation op))
3358 (apply operation args)))
3359
3360 ;; This function is used from `tramp-completion-file-name-handler' functions
3361 ;; only, if `tramp-completion-mode' is true. But this cannot be checked here
3362 ;; because the check is based on a full filename, not available for all
3363 ;; basic I/O operations.
3364 (defun tramp-completion-run-real-handler (operation args)
3365 "Invoke `tramp-file-name-handler' for OPERATION.
3366 First arg specifies the OPERATION, second arg is a list of arguments to
3367 pass to the OPERATION."
3368 (let* ((op (if (eq operation 'ange-ftp-hook-function)
3369 (car args)
3370 operation))
3371 (inhibit-file-name-handlers
3372 (list 'tramp-completion-file-name-handler
3373 (and (eq inhibit-file-name-operation op)
3374 inhibit-file-name-handlers)))
3375 (inhibit-file-name-operation op))
3376 (apply operation args)))
3377
3378 ;; Main function.
3379 ;;;###autoload
3380 (defun tramp-file-name-handler (operation &rest args)
3381 "Invoke tramp file name handler.
3382 Falls back to normal file name handler if no tramp file name handler exists."
3383 (let ((fn (assoc operation tramp-file-name-handler-alist)))
3384 (if fn
3385 (catch 'tramp-forward-to-ange-ftp
3386 (save-match-data (apply (cdr fn) args)))
3387 (tramp-run-real-handler operation args))))
3388
3389 (put 'tramp-file-name-handler 'file-remote-p t) ;for file-remote-p
3390
3391 ;;;###autoload
3392 (defun tramp-completion-file-name-handler (operation &rest args)
3393 "Invoke tramp file name completion handler.
3394 Falls back to normal file name handler if no tramp file name handler exists."
3395 ;; (setq tramp-debug-buffer t)
3396 ;; (tramp-message 1 "%s %s" operation args)
3397 ;; (tramp-message 1 "%s %s\n%s"
3398 ;; operation args (with-output-to-string (backtrace)))
3399 (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
3400 (if fn
3401 (catch 'tramp-forward-to-ange-ftp
3402 (save-match-data (apply (cdr fn) args)))
3403 (tramp-completion-run-real-handler operation args))))
3404
3405 ;; Register in file name handler alist
3406 ;;;###autoload
3407 (add-to-list 'file-name-handler-alist
3408 (cons tramp-file-name-regexp 'tramp-file-name-handler))
3409 (add-to-list 'file-name-handler-alist
3410 (cons tramp-completion-file-name-regexp
3411 'tramp-completion-file-name-handler))
3412
3413 ;; To handle EFS, the following functions need to be dealt with:
3414 ;;
3415 ;; * dired-before-readin-hook contains efs-dired-before-readin
3416 ;; * file-name-handler-alist contains efs-file-handler-function
3417 ;; and efs-root-handler-function and efs-sifn-handler-function
3418 ;; * find-file-hooks contains efs-set-buffer-mode
3419 ;;
3420 ;; But it won't happen for EFS since the XEmacs maintainers
3421 ;; don't want to use a unified filename syntax.
3422 (defun tramp-disable-ange-ftp ()
3423 "Turn Ange-FTP off.
3424 This is useful for unified remoting. See
3425 `tramp-file-name-structure-unified' and
3426 `tramp-file-name-structure-separate' for details. Requests suitable
3427 for Ange-FTP will be forwarded to Ange-FTP. Also see the variables
3428 `tramp-ftp-method', `tramp-default-method', and
3429 `tramp-default-method-alist'.
3430
3431 This function is not needed in Emacsen which include Tramp, but is
3432 present for backward compatibility."
3433 (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
3434 (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
3435 (setq file-name-handler-alist
3436 (delete a1 (delete a2 file-name-handler-alist)))))
3437 (tramp-disable-ange-ftp)
3438
3439 (defun tramp-repair-jka-compr ()
3440 "If jka-compr is already loaded, move it to the front of
3441 `file-name-handler-alist'. On Emacs 21.4 or so this will not be
3442 necessary anymore."
3443 (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
3444 (when jka
3445 (setq file-name-handler-alist
3446 (cons jka (delete jka file-name-handler-alist))))))
3447 (tramp-repair-jka-compr)
3448
3449 (defun tramp-flatten-list (arg)
3450 "Expands all lists inside ARG to a sequential list.
3451 Return (nil) if arg is nil."
3452 (let ((car (car arg))
3453 (cdr (cdr arg)))
3454 (cond
3455 ((eq arg nil) '(nil))
3456 ((listp car)
3457 (if (null cdr)
3458 (tramp-flatten-list car)
3459 (append (tramp-flatten-list car) (tramp-flatten-list cdr))))
3460 ((null cdr) (list car))
3461 (t (cons car (tramp-flatten-list cdr))))))
3462
3463 (defun tramp-invoke-ange-ftp (operation &rest args)
3464 "Invoke the Ange-FTP handler function and throw."
3465 (or (boundp 'ange-ftp-name-format)
3466 (and (require 'ange-ftp)
3467 (tramp-disable-ange-ftp)))
3468 (let ((ange-ftp-name-format
3469 (list (nth 0 tramp-file-name-structure)
3470 (nth 3 tramp-file-name-structure)
3471 (nth 2 tramp-file-name-structure)
3472 (nth 4 tramp-file-name-structure))))
3473 (throw 'tramp-forward-to-ange-ftp
3474 (tramp-run-real-handler 'ange-ftp-hook-function
3475 (cons operation args)))))
3476
3477 (defun tramp-ange-ftp-file-name-p (multi-method method)
3478 "Check if it's a filename that should be forwarded to Ange-FTP."
3479 (and tramp-unified-filenames
3480 (null multi-method)
3481 (string= method tramp-ftp-method)))
3482
3483
3484 ;;; Interactions with other packages:
3485
3486 ;; -- complete.el --
3487
3488 ;; This function contributed by Ed Sabol
3489 (defun tramp-handle-expand-many-files (name)
3490 "Like `PC-expand-many-files' for tramp files."
3491 (with-parsed-tramp-file-name name nil
3492 (when (tramp-ange-ftp-file-name-p multi-method method)
3493 (tramp-invoke-ange-ftp 'expand-many-files name))
3494 (save-match-data
3495 (if (or (string-match "\\*" name)
3496 (string-match "\\?" name)
3497 (string-match "\\[.*\\]" name))
3498 (save-excursion
3499 (let (bufstr)
3500 ;; CCC: To do it right, we should quote certain characters
3501 ;; in the file name, but since the echo command is going to
3502 ;; break anyway when there are spaces in the file names, we
3503 ;; don't bother.
3504 ;;-(let ((comint-file-name-quote-list
3505 ;;- (set-difference tramp-file-name-quote-list
3506 ;;- '(?\* ?\? ?[ ?]))))
3507 ;;- (tramp-send-command
3508 ;;- multi-method method user host
3509 ;;- (format "echo %s" (comint-quote-filename path)))
3510 ;;- (tramp-wait-for-output))
3511 (tramp-send-command multi-method method user host
3512 (format "echo %s" path))
3513 (tramp-wait-for-output)
3514 (setq bufstr (buffer-substring (point-min)
3515 (tramp-line-end-position)))
3516 (goto-char (point-min))
3517 (if (string-equal path bufstr)
3518 nil
3519 (insert "(\"")
3520 (while (search-forward " " nil t)
3521 (delete-backward-char 1)
3522 (insert "\" \""))
3523 (goto-char (point-max))
3524 (delete-backward-char 1)
3525 (insert "\")")
3526 (goto-char (point-min))
3527 (mapcar
3528 (function (lambda (x)
3529 (tramp-make-tramp-file-name multi-method method
3530 user host x)))
3531 (read (current-buffer))))))
3532 (list (tramp-handle-expand-file-name name))))))
3533
3534 ;; Check for complete.el and override PC-expand-many-files if appropriate.
3535 (eval-when-compile
3536 (defun tramp-save-PC-expand-many-files (name))); avoid compiler warning
3537
3538 (defun tramp-setup-complete ()
3539 (fset 'tramp-save-PC-expand-many-files
3540 (symbol-function 'PC-expand-many-files))
3541 (defun PC-expand-many-files (name)
3542 (if (tramp-tramp-file-p name)
3543 (tramp-handle-expand-many-files name)
3544 (tramp-save-PC-expand-many-files name))))
3545
3546 ;; Why isn't eval-after-load sufficient?
3547 (if (fboundp 'PC-expand-many-files)
3548 (tramp-setup-complete)
3549 (eval-after-load "complete" '(tramp-setup-complete)))
3550
3551 ;;; File name handler functions for completion mode
3552
3553 ;; Necessary because `tramp-file-name-regexp-unified' and
3554 ;; `tramp-completion-file-name-regexp-unified' aren't different.
3555 ;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
3556 ;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
3557 ;; Using `last-input-event' is a little bit risky, because completing a file
3558 ;; might require loading other files, like "~/.netrc", and for them it
3559 ;; shouldn't be decided based on that variable. On the other hand, those files
3560 ;; shouldn't have partial tramp file name syntax. Maybe another variable should
3561 ;; be introduced overwriting this check in such cases. Or we change tramp
3562 ;; file name syntax in order to avoid ambiguities, like in XEmacs ...
3563 ;; In case of XEmacs it can be always true (and wouldn't be necessary).
3564 (defun tramp-completion-mode (file)
3565 "Checks whether method / user name / host name completion is active."
3566 (cond
3567 ((featurep 'xemacs) t)
3568 ((string-match "^/.*:.*:$" file) nil)
3569 ((string-match
3570 (concat
3571 tramp-prefix-regexp
3572 tramp-method-regexp tramp-postfix-single-method-regexp "$")
3573 file)
3574 (member (match-string 1 file)
3575 (cons tramp-ftp-method (mapcar 'car tramp-methods))))
3576 ((or (equal last-input-event 'tab)
3577 (and (not (event-modifiers last-input-event))
3578 (integerp last-input-event)
3579 (or (char-equal last-input-event ?\?)
3580 (char-equal last-input-event ?\t) ; handled by 'tab already?
3581 (char-equal last-input-event ?\ ))))
3582 t)))
3583
3584 (defun tramp-completion-handle-file-exists-p (filename)
3585 "Like `file-exists-p' for tramp files."
3586 (if (tramp-completion-mode filename)
3587 (tramp-run-real-handler
3588 'file-exists-p (list filename))
3589 (tramp-completion-run-real-handler
3590 'file-exists-p (list filename))))
3591
3592 ;; Path manipulation in case of partial TRAMP file names.
3593 (defun tramp-completion-handle-file-name-directory (file)
3594 "Like `file-name-directory' but aware of TRAMP files."
3595 (if (tramp-completion-mode file)
3596 "/"
3597 (tramp-completion-run-real-handler
3598 'file-name-directory (list file))))
3599
3600 ;; Path manipulation in case of partial TRAMP file names.
3601 (defun tramp-completion-handle-file-name-nondirectory (file)
3602 "Like `file-name-nondirectory' but aware of TRAMP files."
3603 (substring
3604 file (length (tramp-completion-handle-file-name-directory file))))
3605
3606 ;; Method, host name and user name completion.
3607 ;; `tramp-completion-dissect-file-name' returns a list of
3608 ;; tramp-file-name structures. For all of them we return possible completions.
3609 (defun tramp-completion-handle-file-name-all-completions (filename directory)
3610 "Like `file-name-all-completions' for partial tramp files."
3611
3612 (let*
3613 ((fullname (concat directory filename))
3614 ;; prepare ange-ftp fix
3615 (fix-ange-ftp-string
3616 (concat tramp-ftp-method tramp-postfix-single-method-format))
3617 (fix-ange-ftp (string-match (concat "^" fix-ange-ftp-string) filename))
3618 ;; local files
3619 (result
3620 (if (tramp-completion-mode fullname)
3621 (tramp-run-real-handler
3622 'file-name-all-completions (list filename directory))
3623 (tramp-completion-run-real-handler
3624 'file-name-all-completions (list filename directory))))
3625 ;; possible completion structures
3626 (v (tramp-completion-dissect-file-name fullname)))
3627
3628 (while v
3629 (let* ((car (car v))
3630 (multi-method (tramp-file-name-multi-method car))
3631 (method (tramp-file-name-method car))
3632 (user (tramp-file-name-user car))
3633 (host (tramp-file-name-host car))
3634 (path (tramp-file-name-path car))
3635 (m (tramp-find-method multi-method method user host))
3636 all-user-hosts)
3637
3638 (unless (or multi-method ;; Not handled (yet).
3639 path) ;; Nothing to complete
3640
3641 (if (or user host)
3642
3643 ;; Method dependent user / host combinations
3644 (progn
3645 (mapcar
3646 '(lambda (x)
3647 (setq all-user-hosts
3648 (append all-user-hosts
3649 (funcall (nth 0 x) (nth 1 x)))))
3650 (tramp-get-completion-function m))
3651
3652 (setq result (append result
3653 (mapcar
3654 '(lambda (x)
3655 (tramp-get-completion-user-host
3656 method user host (nth 0 x) (nth 1 x)))
3657 (delq nil all-user-hosts)))))
3658
3659 ;; Possible methods
3660 (setq result
3661 (append result (tramp-get-completion-methods m))))
3662
3663 ;; Ange-ftp completions.
3664 ;; Filename might have the form "ftp:xxx". Ange-ftp isn't able to
3665 ;; handle the prefix "ftp:" correctly in
3666 ;; `ange-ftp-file-name-all-completions'; it simply calls
3667 ;;`(all-completions file (ange-ftp-generate-root-prefixes))'.
3668 ;; So we must wrap around.
3669 (when (tramp-ange-ftp-file-name-p nil m)
3670 (setq result (append result
3671 (mapcar
3672 '(lambda (x) (if fix-ange-ftp (concat fix-ange-ftp-string x) x))
3673 (catch 'tramp-forward-to-ange-ftp
3674 (tramp-invoke-ange-ftp
3675 'file-name-all-completions
3676 (if fix-ange-ftp
3677 (substring filename (length fix-ange-ftp-string))
3678 filename)
3679 directory)))))))
3680
3681 (setq v (delq car v))))
3682
3683 ;;; unify list, remove nil elements
3684 (let (result1)
3685 (while result
3686 (let ((car (car result)))
3687 (when car (add-to-list 'result1 car))
3688 (setq result (delq car result))))
3689
3690 result1)))
3691
3692 ;; Method, host name and user name completion for a file.
3693 (defun tramp-completion-handle-file-name-completion (filename directory)
3694 "Like `file-name-completion' for tramp files."
3695 (try-completion filename
3696 (mapcar 'list (file-name-all-completions filename directory))))
3697
3698 ;; I misuse a little bit the tramp-file-name structure in order to handle
3699 ;; completion possibilities for partial methods / user names / host names.
3700 ;; Return value is a list of tramp-file-name structures according to possible
3701 ;; completions. If "multi-method" or "path" is non-nil it means there
3702 ;; shouldn't be a completion anymore.
3703
3704 ;; Expected results:
3705
3706 ;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
3707 ;; [nil nil nil "x" nil] [nil nil "x" nil nil] [nil nil "x" "y" nil]
3708 ;; [nil nil "x" nil nil]
3709 ;; [nil "x" nil nil nil]
3710
3711 ;; "/x:" "/x:y" "/x:y:"
3712 ;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""]
3713 ;; "/[x/" "/[x/y"
3714 ;; [nil "x" nil "" nil] [nil "x" nil "y" nil]
3715 ;; [nil "x" "" nil nil] [nil "x" "y" nil nil]
3716
3717 ;; "/x:y@" "/x:y@z" "/x:y@z:"
3718 ;; [nil nil nil "x" "y@"] [nil nil nil "x" "y@z"] [nil "x" "y" "z" ""]
3719 ;; "/[x/y@" "/[x/y@z"
3720 ;; [nil "x" nil "y" nil] [nil "x" "y" "z" nil]
3721 (defun tramp-completion-dissect-file-name (name)
3722 "Returns a list of `tramp-file-name' structures.
3723 They are collected by `tramp-completion-dissect-file-name1'."
3724
3725 (let* ((result)
3726 (x-nil "\\|\\(\\)"))
3727
3728 ;; "/method" "/[method"
3729 (defconst tramp-completion-file-name-structure1
3730 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
3731 1 9 9 9))
3732 ;; "/user" "/[user"
3733 (defconst tramp-completion-file-name-structure2
3734 (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$")
3735 9 1 9 9))
3736 ;; "/host" "/[host"
3737 (defconst tramp-completion-file-name-structure3
3738 (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$")
3739 9 9 1 9))
3740 ;; "/user@host" "/[user@host"
3741 (defconst tramp-completion-file-name-structure4
3742 (list (concat tramp-prefix-regexp
3743 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
3744 "\\(" tramp-host-regexp x-nil "\\)$")
3745 9 1 2 9))
3746 ;; "/method:user" "/[method/user"
3747 (defconst tramp-completion-file-name-structure5
3748 (list (concat tramp-prefix-regexp
3749 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
3750 "\\(" tramp-user-regexp x-nil "\\)$")
3751 1 2 9 9))
3752 ;; "/method:host" "/[method/host"
3753 (defconst tramp-completion-file-name-structure6
3754 (list (concat tramp-prefix-regexp
3755 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
3756 "\\(" tramp-host-regexp x-nil "\\)$")
3757 1 9 2 9))
3758 ;; "/method:user@host" "/[method/user@host"
3759 (defconst tramp-completion-file-name-structure7
3760 (list (concat tramp-prefix-regexp
3761 "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
3762 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
3763 "\\(" tramp-host-regexp x-nil "\\)$")
3764 1 2 3 9))
3765
3766 (mapcar '(lambda (regexp)
3767 (add-to-list 'result
3768 (tramp-completion-dissect-file-name1 regexp name)))
3769 (list
3770 tramp-completion-file-name-structure1
3771 tramp-completion-file-name-structure2
3772 tramp-completion-file-name-structure3
3773 tramp-completion-file-name-structure4
3774 tramp-completion-file-name-structure5
3775 tramp-completion-file-name-structure6
3776 tramp-completion-file-name-structure7
3777 tramp-file-name-structure))
3778
3779 (delq nil result)))
3780
3781 (defun tramp-completion-dissect-file-name1 (structure name)
3782 "Returns a `tramp-file-name' structure matching STRUCTURE.
3783 The structure consists of multi-method, remote method, remote user,
3784 remote host and remote path name."
3785
3786 (let (method)
3787 (save-match-data
3788 (when (string-match (nth 0 structure) name)
3789 (setq method (match-string (nth 1 structure) name))
3790 (if (and method (member method tramp-multi-methods))
3791 ;; Not handled (yet).
3792 (make-tramp-file-name
3793 :multi-method method
3794 :method nil
3795 :user nil
3796 :host nil
3797 :path nil)
3798 (let ((user (match-string (nth 2 structure) name))
3799 (host (match-string (nth 3 structure) name))
3800 (path (match-string (nth 4 structure) name)))
3801 (make-tramp-file-name
3802 :multi-method nil
3803 :method method
3804 :user user
3805 :host host
3806 :path path)))))))
3807
3808 ;; This function returns all possible method completions, adding the
3809 ;; trailing method delimeter.
3810 ;; In case of Emacs, `tramp-ftp-method' is handled as well because it doesn't
3811 ;; belong to `tramp-methods'.
3812 (defun tramp-get-completion-methods (partial-method)
3813 "Returns all method completions for PARTIAL-METHOD."
3814 (let ((all-methods (delete "multi" (mapcar 'car tramp-methods))))
3815
3816 (mapcar
3817 '(lambda (method)
3818 (and method
3819 (string-match (concat "^" (regexp-quote partial-method)) method)
3820 ;; we must remove leading "/".
3821 (substring (tramp-make-tramp-file-name nil method nil nil nil) 1)))
3822
3823 (add-to-list 'all-methods
3824 (when tramp-unified-filenames tramp-ftp-method)))))
3825
3826 ;; Compares partial user and host names with possible completions.
3827 (defun tramp-get-completion-user-host (method partial-user partial-host user host)
3828 "Returns the most expanded string for user and host name completion.
3829 PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
3830 (cond
3831
3832 ((and partial-user partial-host)
3833 (if (and host
3834 (string-match (concat "^" (regexp-quote partial-host)) host)
3835 (string-equal partial-user (or user partial-user)))
3836 (setq user partial-user)
3837 (setq user nil
3838 host nil)))
3839
3840 (partial-user
3841 (setq host nil)
3842 (unless
3843 (and user (string-match (concat "^" (regexp-quote partial-user)) user))
3844 (setq user nil)))
3845
3846 (partial-host
3847 (setq user nil)
3848 (unless
3849 (and host (string-match (concat "^" (regexp-quote partial-host)) host))
3850 (setq host nil)))
3851
3852 (t (setq user nil
3853 host nil)))
3854
3855 (when (or user host)
3856 ;; we must remove leading "/".
3857 (substring (tramp-make-tramp-file-name nil method user host nil) 1)))
3858
3859 (defun tramp-parse-rhosts (filename)
3860 "Return a list of (user host) tuples allowed to access.
3861 Either user or host may be nil"
3862
3863 (let (res)
3864 (when (file-exists-p filename)
3865 (with-temp-buffer
3866 (insert-file-contents filename)
3867 (goto-char (point-min))
3868 (while (not (eobp))
3869 (add-to-list 'res (tramp-parse-rhosts-group)))))
3870 res))
3871
3872 ;; Taken from gnus/netrc.el
3873 (eval-and-compile
3874 (defalias 'tramp-point-at-eol
3875 (if (fboundp 'point-at-eol)
3876 'point-at-eol
3877 'line-end-position)))
3878
3879 (defun tramp-parse-rhosts-group ()
3880 "Return a (user host) tuple allowed to access.
3881 Either user or host may be nil"
3882
3883 (let ((result)
3884 (regexp
3885 (concat
3886 "^\\(" tramp-host-regexp "\\)"
3887 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
3888
3889 (narrow-to-region (point) (tramp-point-at-eol))
3890 (when (re-search-forward regexp nil t)
3891 (setq result (append (list (match-string 3) (match-string 1)))))
3892 (widen)
3893 (forward-line 1)
3894 result))
3895
3896 (defun tramp-parse-shosts (filename)
3897 "Return a list of (user host) tuples allowed to access.
3898 User is always nil."
3899
3900 (let (res)
3901 (when (file-exists-p filename)
3902 (with-temp-buffer
3903 (insert-file-contents filename)
3904 (goto-char (point-min))
3905 (while (not (eobp))
3906 (add-to-list 'res (tramp-parse-shosts-group)))))
3907 res))
3908
3909 (defun tramp-parse-shosts-group ()
3910 "Return a (user host) tuple allowed to access.
3911 User is always nil."
3912
3913 (let ((result)
3914 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
3915
3916 (narrow-to-region (point) (tramp-point-at-eol))
3917 (when (re-search-forward regexp nil t)
3918 (setq result (list nil (match-string 1))))
3919 (widen)
3920 (or
3921 (> (skip-chars-forward ",") 0)
3922 (forward-line 1))
3923 result))
3924
3925 (defun tramp-parse-hosts (filename)
3926 "Return a list of (user host) tuples allowed to access.
3927 User is always nil."
3928
3929 (let (res)
3930 (when (file-exists-p filename)
3931 (with-temp-buffer
3932 (insert-file-contents filename)
3933 (goto-char (point-min))
3934 (while (not (eobp))
3935 (add-to-list 'res (tramp-parse-hosts-group)))))
3936 res))
3937
3938 (defun tramp-parse-hosts-group ()
3939 "Return a (user host) tuple allowed to access.
3940 User is always nil."
3941
3942 (let ((result)
3943 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
3944
3945 (narrow-to-region (point) (tramp-point-at-eol))
3946 (when (re-search-forward regexp nil t)
3947 (unless (char-equal (or (char-after) ?\n) ?:) ; no IPv6
3948 (setq result (list nil (match-string 1)))))
3949 (widen)
3950 (or
3951 (> (skip-chars-forward " \t") 0)
3952 (forward-line 1))
3953 result))
3954
3955 (defun tramp-parse-passwd (filename)
3956 "Return a list of (user host) tuples allowed to access.
3957 Host is always \"localhost\"."
3958
3959 (let (res)
3960 (if (and (symbolp 'user) (zerop (length user)))
3961 '(("root" nil))
3962 (when (file-exists-p filename)
3963 (with-temp-buffer
3964 (insert-file-contents filename)
3965 (goto-char (point-min))
3966 (while (not (eobp))
3967 (add-to-list 'res (tramp-parse-passwd-group)))))
3968 res)))
3969
3970 (defun tramp-parse-passwd-group ()
3971 "Return a (user host) tuple allowed to access.
3972 User is always nil."
3973
3974 (let ((result)
3975 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
3976
3977 (narrow-to-region (point) (tramp-point-at-eol))
3978 (when (re-search-forward regexp nil t)
3979 (setq result (list (match-string 1) "localhost")))
3980 (widen)
3981 (forward-line 1)
3982 result))
3983
3984 (defun tramp-completion-handle-expand-file-name (name &optional dir)
3985 "Like `expand-file-name' for tramp files."
3986 (let ((fullname (concat (or dir default-directory) name)))
3987 (if (tramp-completion-mode fullname)
3988 (tramp-run-real-handler
3989 'expand-file-name (list name dir))
3990 (tramp-completion-run-real-handler
3991 'expand-file-name (list name dir)))))
3992
3993 ;;; Internal Functions:
3994
3995 (defun tramp-set-auto-save ()
3996 (when (and (buffer-file-name)
3997 (tramp-tramp-file-p (buffer-file-name))
3998 auto-save-default)
3999 (auto-save-mode 1)))
4000 (add-hook 'find-file-hooks 'tramp-set-auto-save t)
4001
4002 (defun tramp-run-test (switch filename)
4003 "Run `test' on the remote system, given a SWITCH and a FILENAME.
4004 Returns the exit code of the `test' program."
4005 (let ((v (tramp-dissect-file-name filename)))
4006 (save-excursion
4007 (tramp-send-command-and-check
4008 (tramp-file-name-multi-method v) (tramp-file-name-method v)
4009 (tramp-file-name-user v) (tramp-file-name-host v)
4010 (format "test %s %s" switch
4011 (tramp-shell-quote-argument (tramp-file-name-path v)))))))
4012
4013 (defun tramp-run-test2 (program file1 file2 &optional switch)
4014 "Run `test'-like PROGRAM on the remote system, given FILE1, FILE2.
4015 The optional SWITCH is inserted between the two files.
4016 Returns the exit code of the `test' PROGRAM. Barfs if the methods,
4017 hosts, or files, disagree."
4018 (let* ((v1 (tramp-dissect-file-name file1))
4019 (v2 (tramp-dissect-file-name file2))
4020 (mmethod1 (tramp-file-name-multi-method v1))
4021 (mmethod2 (tramp-file-name-multi-method v2))
4022 (method1 (tramp-file-name-method v1))
4023 (method2 (tramp-file-name-method v2))
4024 (user1 (tramp-file-name-user v1))
4025 (user2 (tramp-file-name-user v2))
4026 (host1 (tramp-file-name-host v1))
4027 (host2 (tramp-file-name-host v2))
4028 (path1 (tramp-file-name-path v1))
4029 (path2 (tramp-file-name-path v2)))
4030 (unless (and method1 method2 host1 host2
4031 (equal mmethod1 mmethod2)
4032 (equal method1 method2)
4033 (equal user1 user2)
4034 (equal host1 host2))
4035 (error "tramp-run-test2: %s"
4036 "only implemented for same method, same user, same host"))
4037 (save-excursion
4038 (tramp-send-command-and-check
4039 mmethod1 method1 user1 host1
4040 (format "%s %s %s %s"
4041 program
4042 (tramp-shell-quote-argument path1)
4043 (or switch "")
4044 (tramp-shell-quote-argument path2))))))
4045
4046 (defun tramp-buffer-name (multi-method method user host)
4047 "A name for the connection buffer for USER at HOST using METHOD."
4048 (cond (multi-method
4049 (tramp-buffer-name-multi-method "tramp" multi-method method user host))
4050 (user
4051 (format "*tramp/%s %s@%s*" method user host))
4052 (t
4053 (format "*tramp/%s %s*" method host))))
4054
4055 (defun tramp-buffer-name-multi-method (prefix multi-method method user host)
4056 "A name for the multi method connection buffer.
4057 MULTI-METHOD gives the multi method, METHOD the array of methods,
4058 USER the array of user names, HOST the array of host names."
4059 (unless (and (= (length method) (length user))
4060 (= (length method) (length host)))
4061 (error "Syntax error in multi method (implementation error)"))
4062 (let ((len (length method))
4063 (i 0)
4064 string-list)
4065 (while (< i len)
4066 (setq string-list
4067 (cons (if (aref user i)
4068 (format "%s#%s@%s:" (aref method i)
4069 (aref user i) (aref host i))
4070 (format "%s@%s:" (aref method i) (aref host i)))
4071 string-list))
4072 (incf i))
4073 (format "*%s/%s %s*"
4074 prefix multi-method
4075 (apply 'concat (reverse string-list)))))
4076
4077 (defun tramp-get-buffer (multi-method method user host)
4078 "Get the connection buffer to be used for USER at HOST using METHOD."
4079 (get-buffer-create (tramp-buffer-name multi-method method user host)))
4080
4081 (defun tramp-debug-buffer-name (multi-method method user host)
4082 "A name for the debug buffer for USER at HOST using METHOD."
4083 (cond (multi-method
4084 (tramp-buffer-name-multi-method "debug tramp"
4085 multi-method method user host))
4086 (user
4087 (format "*debug tramp/%s %s@%s*" method user host))
4088 (t
4089 (format "*debug tramp/%s %s*" method host))))
4090
4091 (defun tramp-get-debug-buffer (multi-method method user host)
4092 "Get the debug buffer for USER at HOST using METHOD."
4093 (get-buffer-create (tramp-debug-buffer-name multi-method method user host)))
4094
4095 (defun tramp-find-executable (multi-method method user host
4096 progname dirlist ignore-tilde)
4097 "Searches for PROGNAME in all directories mentioned in DIRLIST.
4098 First args METHOD, USER and HOST specify the connection, PROGNAME
4099 is the program to search for, and DIRLIST gives the list of directories
4100 to search. If IGNORE-TILDE is non-nil, directory names starting
4101 with `~' will be ignored.
4102
4103 Returns the full path name of PROGNAME, if found, and nil otherwise.
4104
4105 This function expects to be in the right *tramp* buffer."
4106 (let (result)
4107 (when ignore-tilde
4108 ;; Remove all ~/foo directories from dirlist. In Emacs 20,
4109 ;; `remove' is in CL, and we want to avoid CL dependencies.
4110 (let (newdl d)
4111 (while dirlist
4112 (setq d (car dirlist))
4113 (setq dirlist (cdr dirlist))
4114 (unless (char-equal ?~ (aref d 0))
4115 (setq newdl (cons d newdl))))
4116 (setq dirlist (nreverse newdl))))
4117 (tramp-send-command
4118 multi-method method user host
4119 (format (concat "while read d; "
4120 "do if test -x $d/%s -a -f $d/%s; "
4121 "then echo tramp_executable $d/%s; "
4122 "break; fi; done <<'EOF'")
4123 progname progname progname))
4124 (mapcar (lambda (d)
4125 (tramp-send-command multi-method method user host d))
4126 dirlist)
4127 (tramp-send-command multi-method method user host "EOF")
4128 (tramp-wait-for-output)
4129 (goto-char (point-max))
4130 (when (search-backward "tramp_executable " nil t)
4131 (skip-chars-forward "^ ")
4132 (skip-chars-forward " ")
4133 (buffer-substring (point) (tramp-line-end-position)))))
4134
4135 (defun tramp-set-remote-path (multi-method method user host var dirlist)
4136 "Sets the remote environment VAR to existing directories from DIRLIST.
4137 I.e., for each directory in DIRLIST, it is tested whether it exists and if
4138 so, it is added to the environment variable VAR."
4139 (let ((existing-dirs
4140 (mapcar
4141 (lambda (x)
4142 (when (and
4143 (file-exists-p
4144 (tramp-make-tramp-file-name multi-method method user host x))
4145 (file-directory-p
4146 (tramp-make-tramp-file-name multi-method method user host x)))
4147 x))
4148 dirlist)))
4149 (tramp-send-command
4150 multi-method method user host
4151 (concat var "="
4152 (mapconcat 'identity (delq nil existing-dirs) ":")
4153 "; export " var))
4154 (tramp-wait-for-output)))
4155
4156 ;; -- communication with external shell --
4157
4158 (defun tramp-find-file-exists-command (multi-method method user host)
4159 "Find a command on the remote host for checking if a file exists.
4160 Here, we are looking for a command which has zero exit status if the
4161 file exists and nonzero exit status otherwise."
4162 (make-local-variable 'tramp-file-exists-command)
4163 (tramp-message 9 "Finding command to check if file exists")
4164 (let ((existing
4165 (tramp-make-tramp-file-name
4166 multi-method method user host
4167 "/")) ;assume this file always exists
4168 (nonexisting
4169 (tramp-make-tramp-file-name
4170 multi-method method user host
4171 "/ this file does not exist "))) ;assume this never exists
4172 ;; The algorithm is as follows: we try a list of several commands.
4173 ;; For each command, we first run `$cmd /' -- this should return
4174 ;; true, as the root directory always exists. And then we run
4175 ;; `$cmd /this\ file\ does\ not\ exist', hoping that the file indeed
4176 ;; does not exist. This should return false. We use the first
4177 ;; command we find that seems to work.
4178 ;; The list of commands to try is as follows:
4179 ;; `ls -d' This works on most systems, but NetBSD 1.4
4180 ;; has a bug: `ls' always returns zero exit
4181 ;; status, even for files which don't exist.
4182 ;; `test -e' Some Bourne shells have a `test' builtin
4183 ;; which does not know the `-e' option.
4184 ;; `/bin/test -e' For those, the `test' binary on disk normally
4185 ;; provides the option. Alas, the binary
4186 ;; is sometimes `/bin/test' and sometimes it's
4187 ;; `/usr/bin/test'.
4188 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
4189 (unless (or
4190 (and (setq tramp-file-exists-command "test -e %s")
4191 (tramp-handle-file-exists-p existing)
4192 (not (tramp-handle-file-exists-p nonexisting)))
4193 (and (setq tramp-file-exists-command "/bin/test -e %s")
4194 (tramp-handle-file-exists-p existing)
4195 (not (tramp-handle-file-exists-p nonexisting)))
4196 (and (setq tramp-file-exists-command "/usr/bin/test -e %s")
4197 (tramp-handle-file-exists-p existing)
4198 (not (tramp-handle-file-exists-p nonexisting)))
4199 (and (setq tramp-file-exists-command "ls -d %s")
4200 (tramp-handle-file-exists-p existing)
4201 (not (tramp-handle-file-exists-p nonexisting))))
4202 (error "Couldn't find command to check if file exists."))))
4203
4204
4205 ;; CCC test ksh or bash found for tilde expansion?
4206 (defun tramp-find-shell (multi-method method user host)
4207 "Find a shell on the remote host which groks tilde expansion."
4208 (let ((shell nil))
4209 (tramp-send-command multi-method method user host "echo ~root")
4210 (tramp-wait-for-output)
4211 (cond
4212 ((string-match "^~root$" (buffer-string))
4213 (setq shell
4214 (or (tramp-find-executable multi-method method user host
4215 "bash" tramp-remote-path t)
4216 (tramp-find-executable multi-method method user host
4217 "ksh" tramp-remote-path t)))
4218 (unless shell
4219 (error "Couldn't find a shell which groks tilde expansion"))
4220 ;; Find arguments for this shell.
4221 (let ((alist tramp-sh-extra-args)
4222 item extra-args)
4223 (while (and alist (null extra-args))
4224 (setq item (pop alist))
4225 (when (string-match (car item) shell)
4226 (setq extra-args (cdr item))))
4227 (when extra-args (setq shell (concat shell " " extra-args))))
4228 (tramp-message
4229 5 "Starting remote shell `%s' for tilde expansion..." shell)
4230 (tramp-send-command
4231 multi-method method user host
4232 (concat "PS1='$ ' exec " shell)) ;
4233 (unless (tramp-wait-for-regexp
4234 (get-buffer-process (current-buffer))
4235 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'"
4236 tramp-shell-prompt-pattern shell-prompt-pattern))
4237 (pop-to-buffer (buffer-name))
4238 (error "Couldn't find remote `%s' prompt." shell))
4239 (tramp-message
4240 9 "Setting remote shell prompt...")
4241 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
4242 ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the
4243 ;; last tramp-rsh-end-of-line, Douglas wanted to replace that,
4244 ;; as well.
4245 (process-send-string nil (format "PS1='%s%s%s'; PS2=''; PS3=''%s"
4246 tramp-rsh-end-of-line
4247 tramp-end-of-output
4248 tramp-rsh-end-of-line
4249 tramp-rsh-end-of-line))
4250 (tramp-wait-for-output)
4251 (tramp-message
4252 9 "Setting remote shell prompt...done")
4253 )
4254 (t (tramp-message 5 "Remote `%s' groks tilde expansion, good"
4255 (tramp-get-remote-sh multi-method method user host))))))
4256
4257 (defun tramp-check-ls-command (multi-method method user host cmd)
4258 "Checks whether the given `ls' executable groks `-n'.
4259 METHOD, USER and HOST specify the connection, CMD (the full path name of)
4260 the `ls' executable. Returns t if CMD supports the `-n' option, nil
4261 otherwise."
4262 (tramp-message 9 "Checking remote `%s' command for `-n' option"
4263 cmd)
4264 (when (tramp-handle-file-executable-p
4265 (tramp-make-tramp-file-name multi-method method user host cmd))
4266 (let ((result nil))
4267 (tramp-message 7 "Testing remote command `%s' for -n..." cmd)
4268 (setq result
4269 (tramp-send-command-and-check
4270 multi-method method user host
4271 (format "%s -lnd / >/dev/null"
4272 cmd)))
4273 (tramp-message 7 "Testing remote command `%s' for -n...%s"
4274 cmd
4275 (if (zerop result) "okay" "failed"))
4276 (zerop result))))
4277
4278 (defun tramp-check-ls-commands (multi-method method user host cmd dirlist)
4279 "Checks whether the given `ls' executable in one of the dirs groks `-n'.
4280 Returns nil if none was found, else the command is returned."
4281 (let ((dl dirlist)
4282 (result nil)
4283 (directory-sep-char ?/)) ;for XEmacs
4284 ;; It would be better to use the CL function `find', but
4285 ;; we don't want run-time dependencies on CL.
4286 (while (and dl (not result))
4287 (let ((x (concat (file-name-as-directory (car dl)) cmd)))
4288 (when (tramp-check-ls-command multi-method method user host x)
4289 (setq result x)))
4290 (setq dl (cdr dl)))
4291 result))
4292
4293 (defun tramp-find-ls-command (multi-method method user host)
4294 "Finds an `ls' command which groks the `-n' option, returning nil if failed.
4295 \(This option prints numeric user and group ids in a long listing.)"
4296 (tramp-message 9 "Finding a suitable `ls' command")
4297 (or
4298 (tramp-check-ls-commands multi-method method user host "ls" tramp-remote-path)
4299 (tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path)
4300 (tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path)))
4301
4302 ;; ------------------------------------------------------------
4303 ;; -- Functions for establishing connection --
4304 ;; ------------------------------------------------------------
4305
4306 ;; The following functions are actions to be taken when seeing certain
4307 ;; prompts from the remote host. See the variable
4308 ;; `tramp-actions-before-shell' for usage of these functions.
4309
4310 (defun tramp-action-login (p multi-method method user host)
4311 "Send the login name."
4312 (tramp-message 9 "Sending login name `%s'"
4313 (or user (user-login-name)))
4314 (erase-buffer)
4315 (process-send-string nil (concat (or user (user-login-name))
4316 tramp-rsh-end-of-line)))
4317
4318 (defun tramp-action-password (p multi-method method user host)
4319 "Query the user for a password."
4320 (when (tramp-method-out-of-band-p multi-method method user host)
4321 (kill-process (get-buffer-process (current-buffer)))
4322 (error (concat "Out of band method `%s' not applicable "
4323 "for remote shell asking for a password")
4324 method))
4325 (tramp-message 9 "Sending password")
4326 (tramp-enter-password p (match-string 0)))
4327
4328 (defun tramp-action-succeed (p multi-method method user host)
4329 "Signal success in finding shell prompt."
4330 (tramp-message 9 "Found remote shell prompt.")
4331 (erase-buffer)
4332 (throw 'tramp-action 'ok))
4333
4334 (defun tramp-action-permission-denied (p multi-method method user host)
4335 "Signal permission denied."
4336 (pop-to-buffer (tramp-get-buffer multi-method method user host))
4337 (tramp-message 9 "Permission denied by remote host.")
4338 (kill-process p)
4339 (throw 'tramp-action 'permission-denied))
4340
4341 (defun tramp-action-yesno (p multi-method method user host)
4342 "Ask the user for confirmation using `yes-or-no-p'.
4343 Send \"yes\" to remote process on confirmation, abort otherwise.
4344 See also `tramp-action-yn'."
4345 (save-window-excursion
4346 (pop-to-buffer (tramp-get-buffer multi-method method user host))
4347 (unless (yes-or-no-p (match-string 0))
4348 (kill-process p)
4349 (erase-buffer)
4350 (throw 'tramp-action 'permission-denied))
4351 (process-send-string p (concat "yes" tramp-rsh-end-of-line))
4352 (erase-buffer)))
4353
4354 (defun tramp-action-yn (p multi-method method user host)
4355 "Ask the user for confirmation using `y-or-n-p'.
4356 Send \"y\" to remote process on confirmation, abort otherwise.
4357 See also `tramp-action-yesno'."
4358 (save-window-excursion
4359 (pop-to-buffer (tramp-get-buffer multi-method method user host))
4360 (unless (y-or-n-p (match-string 0))
4361 (kill-process p)
4362 (erase-buffer)
4363 (throw 'tramp-action 'permission-denied))
4364 (process-send-string p (concat "y" tramp-rsh-end-of-line))))
4365
4366 ;; The following functions are specifically for multi connections.
4367
4368 (defun tramp-multi-action-login (p method user host)
4369 "Send the login name."
4370 (tramp-message 9 "Sending login name `%s'" user)
4371 (erase-buffer)
4372 (process-send-string p (concat user tramp-rsh-end-of-line)))
4373
4374 (defun tramp-multi-action-password (p method user host)
4375 "Query the user for a password."
4376 (tramp-message 9 "Sending password")
4377 (tramp-enter-password p (match-string 0)))
4378
4379 (defun tramp-multi-action-succeed (p method user host)
4380 "Signal success in finding shell prompt."
4381 (tramp-message 9 "Found shell prompt on `%s'" host)
4382 (erase-buffer)
4383 (throw 'tramp-action 'ok))
4384
4385 (defun tramp-multi-action-permission-denied (p method user host)
4386 "Signal permission denied."
4387 (tramp-message 9 "Permission denied by remote host `%s'" host)
4388 (kill-process p)
4389 (erase-buffer)
4390 (throw 'tramp-action 'permission-denied))
4391
4392 ;; Functions for processing the actions.
4393
4394 (defun tramp-process-one-action (p multi-method method user host actions)
4395 "Wait for output from the shell and perform one action."
4396 (let (found item pattern action todo)
4397 (erase-buffer)
4398 (tramp-message 9 "Waiting 60s for prompt from remote shell")
4399 (with-timeout (60 (throw 'tramp-action 'timeout))
4400 (while (not found)
4401 (accept-process-output p 1)
4402 (goto-char (point-min))
4403 (setq todo actions)
4404 (while todo
4405 (goto-char (point-min))
4406 (setq item (pop todo))
4407 (setq pattern (symbol-value (nth 0 item)))
4408 (setq action (nth 1 item))
4409 (tramp-message 10 "Looking for regexp \"%s\" from remote shell"
4410 pattern)
4411 (when (re-search-forward (concat pattern "\\'") nil t)
4412 (setq found (funcall action p multi-method method user host)))))
4413 found)))
4414
4415 (defun tramp-process-actions (p multi-method method user host actions)
4416 "Perform actions until success."
4417 (let (exit)
4418 (while (not exit)
4419 (tramp-message 9 "Waiting for prompts from remote shell")
4420 (setq exit
4421 (catch 'tramp-action
4422 (tramp-process-one-action
4423 p multi-method method user host actions)
4424 nil)))
4425 (unless (eq exit 'ok)
4426 (error "Login failed"))))
4427
4428 ;; For multi-actions.
4429
4430 (defun tramp-process-one-multi-action (p method user host actions)
4431 "Wait for output from the shell and perform one action."
4432 (let (found item pattern action todo)
4433 (erase-buffer)
4434 (tramp-message 9 "Waiting 60s for prompt from remote shell")
4435 (with-timeout (60 (throw 'tramp-action 'timeout))
4436 (while (not found)
4437 (accept-process-output p 1)
4438 (setq todo actions)
4439 (goto-char (point-min))
4440 (while todo
4441 (goto-char (point-min))
4442 (setq item (pop todo))
4443 (setq pattern (symbol-value (nth 0 item)))
4444 (setq action (nth 1 item))
4445 (tramp-message 10 "Looking for regexp \"%s\" from remote shell"
4446 pattern)
4447 (when (re-search-forward (concat pattern "\\'") nil t)
4448 (setq found (funcall action p method user host)))))
4449 found)))
4450
4451 (defun tramp-process-multi-actions (p method user host actions)
4452 "Perform actions until success."
4453 (let (exit)
4454 (while (not exit)
4455 (tramp-message 9 "Waiting for prompts from remote shell")
4456 (setq exit
4457 (catch 'tramp-action
4458 (tramp-process-one-multi-action p method user host actions)
4459 nil)))
4460 (unless (eq exit 'ok)
4461 (error "Login failed"))))
4462
4463 ;; The actual functions for opening connections.
4464
4465 (defun tramp-open-connection-telnet (multi-method method user host)
4466 "Open a connection using a telnet METHOD.
4467 This starts the command `telnet HOST ARGS'[*], then waits for a remote
4468 login prompt, then sends the user name USER, then waits for a remote
4469 password prompt. It queries the user for the password, then sends the
4470 password to the remote host.
4471
4472 If USER is nil, uses value returned by `(user-login-name)' instead.
4473
4474 Recognition of the remote shell prompt is based on the variables
4475 `shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
4476 set up correctly.
4477
4478 Please note that it is NOT possible to use this connection method
4479 together with an out-of-band transfer method! You must use an inline
4480 transfer method.
4481
4482 Maybe the different regular expressions need to be tuned.
4483
4484 * Actually, the telnet program as well as the args to be used can be
4485 specified in the method parameters, see the variable `tramp-methods'."
4486 (save-match-data
4487 (when (tramp-method-out-of-band-p multi-method method user host)
4488 (error "Cannot use out-of-band method `%s' with telnet connection method"
4489 method))
4490 (when multi-method
4491 (error "Cannot multi-connect using telnet connection method"))
4492 (tramp-pre-connection multi-method method user host)
4493 (tramp-message 7 "Opening connection for %s@%s using %s..."
4494 (or user (user-login-name)) host method)
4495 (let ((process-environment (copy-sequence process-environment)))
4496 (setenv "TERM" tramp-terminal-type)
4497 (let* ((default-directory (tramp-temporary-file-directory))
4498 ;; If we omit the conditional here, then we would use
4499 ;; `undecided-dos' in some cases. With the conditional,
4500 ;; we use nil in these cases. Which one is right?
4501 (coding-system-for-read (unless (and (not (featurep 'xemacs))
4502 (> emacs-major-version 20))
4503 tramp-dos-coding-system))
4504 (p (apply 'start-process
4505 (tramp-buffer-name multi-method method user host)
4506 (tramp-get-buffer multi-method method user host)
4507 (tramp-get-telnet-program
4508 multi-method
4509 (tramp-find-method multi-method method user host)
4510 user host)
4511 host
4512 (tramp-get-telnet-args
4513 multi-method
4514 (tramp-find-method multi-method method user host)
4515 user host)))
4516 (found nil)
4517 (pw nil))
4518 (process-kill-without-query p)
4519 (set-buffer (tramp-get-buffer multi-method method user host))
4520 (erase-buffer)
4521 (tramp-process-actions p multi-method method user host
4522 tramp-actions-before-shell)
4523 (tramp-open-connection-setup-interactive-shell
4524 p multi-method method user host)
4525 (tramp-post-connection multi-method method user host)))))
4526
4527
4528 (defun tramp-open-connection-rsh (multi-method method user host)
4529 "Open a connection using an rsh METHOD.
4530 This starts the command `rsh HOST -l USER'[*], then waits for a remote
4531 password or shell prompt. If a password prompt is seen, the user is
4532 queried for a password, this function sends the password to the remote
4533 host and waits for a shell prompt.
4534
4535 If USER is nil, start the command `rsh HOST'[*] instead
4536
4537 Recognition of the remote shell prompt is based on the variables
4538 `shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
4539 set up correctly.
4540
4541 Please note that it is NOT possible to use this connection method with
4542 an out-of-band transfer method if this function asks the user for a
4543 password! You must use an inline transfer method in this case.
4544 Sadly, the transfer method cannot be switched on the fly, instead you
4545 must specify the right method in the file name.
4546
4547 Kludgy feature: if HOST has the form \"xx#yy\", then yy is assumed to
4548 be a port number for ssh, and \"-p yy\" will be added to the list of
4549 arguments, and xx will be used as the host name to connect to.
4550
4551 * Actually, the rsh program to be used can be specified in the
4552 method parameters, see the variable `tramp-methods'."
4553 (save-match-data
4554 (when multi-method
4555 (error "Cannot multi-connect using rsh connection method"))
4556 (tramp-pre-connection multi-method method user host)
4557 (if (and user (not (string= user "")))
4558 (tramp-message 7 "Opening connection for %s@%s using %s..."
4559 user host method)
4560 (tramp-message 7 "Opening connection at %s using %s..." host method))
4561 (let ((process-environment (copy-sequence process-environment))
4562 (bufnam (tramp-buffer-name multi-method method user host))
4563 (buf (tramp-get-buffer multi-method method user host))
4564 (rsh-program (tramp-get-rsh-program
4565 multi-method
4566 (tramp-find-method multi-method method user host)
4567 user host))
4568 (rsh-args (tramp-get-rsh-args
4569 multi-method
4570 (tramp-find-method multi-method method user host)
4571 user host)))
4572 ;; The following should be changed. We need a more general
4573 ;; mechanism to parse extra host args.
4574 (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
4575 (setq rsh-args (cons "-p" (cons (match-string 2 host) rsh-args)))
4576 (setq host (match-string 1 host)))
4577 (setenv "TERM" tramp-terminal-type)
4578 (let* ((default-directory (tramp-temporary-file-directory))
4579 ;; If we omit the conditional, we would use
4580 ;; `undecided-dos' in some cases. With the conditional,
4581 ;; we use nil in these cases. Which one is right?
4582 (coding-system-for-read (unless (and (not (featurep 'xemacs))
4583 (> emacs-major-version 20))
4584 tramp-dos-coding-system))
4585 (p (if (and user (not (string= user "")))
4586 (apply #'start-process bufnam buf rsh-program
4587 host "-l" user rsh-args)
4588 (apply #'start-process bufnam buf rsh-program
4589 host rsh-args)))
4590 (found nil))
4591 (process-kill-without-query p)
4592
4593 (set-buffer buf)
4594 (tramp-process-actions p multi-method method user host
4595 tramp-actions-before-shell)
4596 (tramp-message 7 "Initializing remote shell")
4597 (tramp-open-connection-setup-interactive-shell
4598 p multi-method method user host)
4599 (tramp-post-connection multi-method method user host)))))
4600
4601 (defun tramp-open-connection-su (multi-method method user host)
4602 "Open a connection using the `su' program with METHOD.
4603 This starts `su - USER', then waits for a password prompt. The HOST
4604 name must be equal to the local host name or to `localhost'.
4605
4606 If USER is nil, uses value returned by user-login-name instead.
4607
4608 Recognition of the remote shell prompt is based on the variables
4609 `shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
4610 set up correctly. Note that the other user may have a different shell
4611 prompt than you do, so it is not at all unlikely that the variable
4612 `shell-prompt-pattern' is set up wrongly!"
4613 (save-match-data
4614 (when (tramp-method-out-of-band-p multi-method method user host)
4615 (error "Cannot use out-of-band method `%s' with `su' connection method"
4616 method))
4617 (unless (or (string-match (concat "^" (regexp-quote host))
4618 (system-name))
4619 (string= "localhost" host)
4620 (string= "" host))
4621 (error
4622 "Cannot connect to different host `%s' with `su' connection method"
4623 host))
4624 (tramp-pre-connection multi-method method user host)
4625 (tramp-message 7 "Opening connection for `%s' using `%s'..."
4626 (or user "<root>") method)
4627 (let ((process-environment (copy-sequence process-environment)))
4628 (setenv "TERM" tramp-terminal-type)
4629 (let* ((default-directory (tramp-temporary-file-directory))
4630 ;; If we omit the conditional, we use `undecided-dos' in
4631 ;; some cases. With the conditional, we use nil in these
4632 ;; cases. What's the difference? Which one is right?
4633 (coding-system-for-read (unless (and (not (featurep 'xemacs))
4634 (> emacs-major-version 20))
4635 tramp-dos-coding-system))
4636 (p (apply 'start-process
4637 (tramp-buffer-name multi-method method user host)
4638 (tramp-get-buffer multi-method method user host)
4639 (tramp-get-su-program
4640 multi-method
4641 (tramp-find-method multi-method method user host)
4642 user host)
4643 (mapcar
4644 '(lambda (x)
4645 (format-spec x `((?u . ,(or user "root")))))
4646 (tramp-get-su-args
4647 multi-method
4648 (tramp-find-method multi-method method user host)
4649 user host))))
4650 (found nil)
4651 (pw nil))
4652 (process-kill-without-query p)
4653 (set-buffer (tramp-get-buffer multi-method method user host))
4654 (tramp-process-actions p multi-method method user host
4655 tramp-actions-before-shell)
4656 (tramp-open-connection-setup-interactive-shell
4657 p multi-method method user host)
4658 (tramp-post-connection multi-method method
4659 user host)))))
4660
4661 ;; HHH: Not Changed. Multi method. It is not clear to me how this can
4662 ;; handle not giving a user name in the "file name".
4663 ;;
4664 ;; This is more difficult than for the single-hop method. In the
4665 ;; multi-hop-method, the desired behaviour should be that the
4666 ;; user must specify names for the telnet hops of which the user
4667 ;; name is different than the "original" name (or different from
4668 ;; the previous hop.
4669 (defun tramp-open-connection-multi (multi-method method user host)
4670 "Open a multi-hop connection using METHOD.
4671 This uses a slightly changed file name syntax. The idea is to say
4672 [multi/telnet:u1@h1/rsh:u2@h2]/path/to/file
4673 This will use telnet to log in as u1 to h1, then use rsh from there to
4674 log in as u2 to h2."
4675 (save-match-data
4676 (unless multi-method
4677 (error "Multi-hop open connection function called on non-multi method"))
4678 (when (tramp-method-out-of-band-p multi-method method user host)
4679 (error "No out of band multi-hop connections"))
4680 (unless (and (arrayp method) (not (stringp method)))
4681 (error "METHOD must be an array of strings for multi methods"))
4682 (unless (and (arrayp user) (not (stringp user)))
4683 (error "USER must be an array of strings for multi methods"))
4684 (unless (and (arrayp host) (not (stringp host)))
4685 (error "HOST must be an array of strings for multi methods"))
4686 (unless (and (= (length method) (length user))
4687 (= (length method) (length host)))
4688 (error "Arrays METHOD, USER, HOST must have equal length"))
4689 (tramp-pre-connection multi-method method user host)
4690 (tramp-message 7 "Opening `%s' connection..." multi-method)
4691 (let ((process-environment (copy-sequence process-environment)))
4692 (setenv "TERM" tramp-terminal-type)
4693 (let* ((default-directory (tramp-temporary-file-directory))
4694 ;; If we omit the conditional, we use `undecided-dos' in
4695 ;; some cases. With the conditional, we use nil in these
4696 ;; cases. What's the difference? Which one is right?
4697 (coding-system-for-read (unless (and (not (featurep 'xemacs))
4698 (> emacs-major-version 20))
4699 tramp-dos-coding-system))
4700 (p (start-process (tramp-buffer-name multi-method method user host)
4701 (tramp-get-buffer multi-method method user host)
4702 tramp-multi-sh-program))
4703 (num-hops (length method))
4704 (i 0))
4705 (process-kill-without-query p)
4706 (tramp-message 9 "Waiting 60s for local shell to come up...")
4707 (unless (tramp-wait-for-regexp
4708 p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'"
4709 shell-prompt-pattern tramp-shell-prompt-pattern))
4710 (pop-to-buffer (buffer-name))
4711 (kill-process p)
4712 (error "Couldn't find local shell prompt"))
4713 ;; Now do all the connections as specified.
4714 (while (< i num-hops)
4715 (let* ((m (aref method i))
4716 (u (aref user i))
4717 (h (aref host i))
4718 (entry (assoc m tramp-multi-connection-function-alist))
4719 (multi-func (nth 1 entry))
4720 (command (nth 2 entry)))
4721 ;; The multi-funcs don't need to do save-match-data, as that
4722 ;; is done here.
4723 (funcall multi-func p m u h command)
4724 (erase-buffer)
4725 (incf i)))
4726 (tramp-open-connection-setup-interactive-shell
4727 p multi-method method user host)
4728 (tramp-post-connection multi-method method user host)))))
4729
4730 ;; HHH: Changed. Multi method. Don't know how to handle this in the case
4731 ;; of no user name provided. Hack to make it work as it did before:
4732 ;; changed `user' to `(or user (user-login-name))' in the places where
4733 ;; the value is actually used.
4734 (defun tramp-multi-connect-telnet (p method user host command)
4735 "Issue `telnet' command.
4736 Uses shell COMMAND to issue a `telnet' command to log in as USER to
4737 HOST. You can use percent escapes in COMMAND: `%h' is replaced with
4738 the host name, and `%n' is replaced with an end of line character, as
4739 set in `tramp-rsh-end-of-line'. Use `%%' if you want a literal percent
4740 character.
4741
4742 If USER is nil, uses the return value of (user-login-name) instead."
4743 (let ((cmd (format-spec command
4744 `((?h . ,host) (?n . ,tramp-rsh-end-of-line))))
4745 (cmd1 (format-spec command `((?h . ,host) (?n . ""))))
4746 found pw)
4747 (erase-buffer)
4748 (tramp-message 9 "Sending telnet command `%s'" cmd1)
4749 (process-send-string p cmd)
4750 (tramp-process-multi-actions p method user host
4751 tramp-multi-actions)))
4752
4753 ;; HHH: Changed. Multi method. Don't know how to handle this in the case
4754 ;; of no user name provided. Hack to make it work as it did before:
4755 ;; changed `user' to `(or user (user-login-name))' in the places where
4756 ;; the value is actually used.
4757 (defun tramp-multi-connect-rlogin (p method user host command)
4758 "Issue `rlogin' command.
4759 Uses shell COMMAND to issue an `rlogin' command to log in as USER to
4760 HOST. You can use percent escapes in COMMAND. `%u' will be replaced
4761 with the user name, `%h' will be replaced with the host name, and `%n'
4762 will be replaced with the value of `tramp-rsh-end-of-line'. You can use
4763 `%%' if you want to use a literal percent character.
4764
4765 If USER is nil, uses the return value of (user-login-name) instead."
4766 (let ((cmd (format-spec command `((?h . ,host)
4767 (?u . ,(or user (user-login-name)))
4768 (?n . ,tramp-rsh-end-of-line))))
4769 (cmd1 (format-spec command `((?h . ,host)
4770 (?u . ,(or user (user-login-name)))
4771 (?n . ""))))
4772 found)
4773 (erase-buffer)
4774 (tramp-message 9 "Sending rlogin command `%s'" cmd1)
4775 (process-send-string p cmd)
4776 (tramp-process-multi-actions p method user host
4777 tramp-multi-actions)))
4778
4779 ;; HHH: Changed. Multi method. Don't know how to handle this in the case
4780 ;; of no user name provided. Hack to make it work as it did before:
4781 ;; changed `user' to `(or user (user-login-name))' in the places where
4782 ;; the value is actually used.
4783 (defun tramp-multi-connect-su (p method user host command)
4784 "Issue `su' command.
4785 Uses shell COMMAND to issue a `su' command to log in as USER on
4786 HOST. The HOST name is ignored, this just changes the user id on the
4787 host currently logged in to.
4788
4789 If USER is nil, uses the return value of (user-login-name) instead.
4790
4791 You can use percent escapes in the COMMAND. `%u' is replaced with the
4792 user name, and `%n' is replaced with the value of
4793 `tramp-rsh-end-of-line'. Use `%%' if you want a literal percent
4794 character."
4795 (let ((cmd (format-spec command `((?u . ,(or user (user-login-name)))
4796 (?n . ,tramp-rsh-end-of-line))))
4797 (cmd1 (format-spec command `((?u . ,(or user (user-login-name)))
4798 (?n . ""))))
4799 found)
4800 (erase-buffer)
4801 (tramp-message 9 "Sending su command `%s'" cmd1)
4802 (process-send-string p cmd)
4803 (tramp-process-multi-actions p method user host
4804 tramp-multi-actions)))
4805
4806 ;; Utility functions.
4807
4808 (defun tramp-wait-for-regexp (proc timeout regexp)
4809 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
4810 Expects the output of PROC to be sent to the current buffer. Returns
4811 the string that matched, or nil. Waits indefinitely if TIMEOUT is
4812 nil."
4813 (let ((found nil)
4814 (start-time (current-time)))
4815 (cond (timeout
4816 ;; Work around a bug in XEmacs 21, where the timeout
4817 ;; expires faster than it should. This degenerates
4818 ;; to polling for buggy XEmacsen, but oh, well.
4819 (while (and (not found)
4820 (< (tramp-time-diff (current-time) start-time)
4821 timeout))
4822 (with-timeout (timeout)
4823 (while (not found)
4824 (accept-process-output proc 1)
4825 (goto-char (point-min))
4826 (setq found (when (re-search-forward regexp nil t)
4827 (tramp-match-string-list)))))))
4828 (t
4829 (while (not found)
4830 (accept-process-output proc 1)
4831 (goto-char (point-min))
4832 (setq found (when (re-search-forward regexp nil t)
4833 (tramp-match-string-list))))))
4834 (when tramp-debug-buffer
4835 (append-to-buffer
4836 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
4837 tramp-current-user tramp-current-host)
4838 (point-min) (point-max))
4839 (when (not found)
4840 (save-excursion
4841 (set-buffer
4842 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
4843 tramp-current-user tramp-current-host))
4844 (goto-char (point-max))
4845 (insert "[[Regexp `" regexp "' not found"
4846 (if timeout (format " in %d secs" timeout) "")
4847 "]]"))))
4848 found))
4849
4850 (defun tramp-enter-password (p prompt)
4851 "Prompt for a password and send it to the remote end.
4852 Uses PROMPT as a prompt and sends the password to process P."
4853 (let ((pw (tramp-read-passwd prompt)))
4854 (erase-buffer)
4855 (process-send-string p (concat pw tramp-password-end-of-line))))
4856
4857 ;; HHH: Not Changed. This might handle the case where USER is not
4858 ;; given in the "File name" very poorly. Then, the local
4859 ;; variable tramp-current user will be set to nil.
4860 (defun tramp-pre-connection (multi-method method user host)
4861 "Do some setup before actually logging in.
4862 METHOD, USER and HOST specify the connection."
4863 (set-buffer (tramp-get-buffer multi-method method user host))
4864 (set (make-local-variable 'tramp-current-multi-method) multi-method)
4865 (set (make-local-variable 'tramp-current-method) method)
4866 (set (make-local-variable 'tramp-current-user) user)
4867 (set (make-local-variable 'tramp-current-host) host)
4868 (set (make-local-variable 'inhibit-eol-conversion) nil)
4869 (erase-buffer))
4870
4871 (defun tramp-open-connection-setup-interactive-shell
4872 (p multi-method method user host)
4873 "Set up an interactive shell.
4874 Mainly sets the prompt and the echo correctly. P is the shell process
4875 to set up. METHOD, USER and HOST specify the connection."
4876 ;; Wait a bit in case the remote end feels like sending a little
4877 ;; junk first. It seems that fencepost.gnu.org does this when doing
4878 ;; a Kerberos login.
4879 (sit-for 1)
4880 (tramp-discard-garbage-erase-buffer p multi-method method user host)
4881 ;; It is useful to set the prompt in the following command because
4882 ;; some people have a setting for $PS1 which /bin/sh doesn't know
4883 ;; about and thus /bin/sh will display a strange prompt. For
4884 ;; example, if $PS1 has "${CWD}" in the value, then ksh will display
4885 ;; the current working directory but /bin/sh will display a dollar
4886 ;; sign. The following command line sets $PS1 to a sane value, and
4887 ;; works under Bourne-ish shells as well as csh-like shells. Daniel
4888 ;; Pittman reports that the unusual positioning of the single quotes
4889 ;; makes it work under `rc', too.
4890 (process-send-string nil (format "exec env 'PS1=$ ' %s%s"
4891 (tramp-get-remote-sh
4892 multi-method method user host)
4893 tramp-rsh-end-of-line))
4894 (when tramp-debug-buffer
4895 (save-excursion
4896 (set-buffer (tramp-get-debug-buffer multi-method method user host))
4897 (goto-char (point-max))
4898 (tramp-insert-with-face
4899 'bold (format "$ exec env PS1='$ ' %s\n"
4900 (tramp-get-remote-sh multi-method method user host)))))
4901 (tramp-message 9 "Waiting 30s for remote `%s' to come up..."
4902 (tramp-get-remote-sh multi-method method user host))
4903 (unless (tramp-wait-for-regexp
4904 p 30 (format "\\(%s\\|%s\\)\\'"
4905 shell-prompt-pattern tramp-shell-prompt-pattern))
4906 (pop-to-buffer (buffer-name))
4907 (error "Remote `%s' didn't come up. See buffer `%s' for details"
4908 (tramp-get-remote-sh multi-method method user host)
4909 (buffer-name)))
4910 (tramp-message 9 "Setting up remote shell environment")
4911 (tramp-discard-garbage-erase-buffer p multi-method method user host)
4912 (process-send-string
4913 nil (format "stty -inlcr -echo kill '^U'%s" tramp-rsh-end-of-line))
4914 (unless (tramp-wait-for-regexp
4915 p 30 (format "\\(%s\\|%s\\)\\'"
4916 shell-prompt-pattern tramp-shell-prompt-pattern))
4917 (pop-to-buffer (buffer-name))
4918 (error "Couldn't `stty -echo', see buffer `%s'" (buffer-name)))
4919 (erase-buffer)
4920 (process-send-string nil (format "TERM=dumb; export TERM%s"
4921 tramp-rsh-end-of-line))
4922 (unless (tramp-wait-for-regexp
4923 p 30 (format "\\(%s\\|%s\\)\\'"
4924 shell-prompt-pattern tramp-shell-prompt-pattern))
4925 (pop-to-buffer (buffer-name))
4926 (error "Couldn't `TERM=dumb; export TERM', see buffer `%s'" (buffer-name)))
4927 ;; Try to set up the coding system correctly.
4928 ;; CCC this can't be the right way to do it. Hm.
4929 (save-excursion
4930 (erase-buffer)
4931 (tramp-message 9 "Determining coding system")
4932 (process-send-string nil (format "echo foo ; echo bar %s"
4933 tramp-rsh-end-of-line))
4934 (unless (tramp-wait-for-regexp
4935 p 30 (format "\\(%s\\|%s\\)\\'"
4936 shell-prompt-pattern tramp-shell-prompt-pattern))
4937 (pop-to-buffer (buffer-name))
4938 (error "Couldn't `echo foo; echo bar' to determine line endings'"))
4939 (goto-char (point-min))
4940 (if (featurep 'mule)
4941 ;; Use MULE to select the right EOL convention for communicating
4942 ;; with the process.
4943 (let* ((cs (or (process-coding-system p) (cons 'undecided 'undecided)))
4944 cs-decode cs-encode)
4945 (when (symbolp cs) (setq cs (cons cs cs)))
4946 (setq cs-decode (car cs))
4947 (setq cs-encode (cdr cs))
4948 (unless cs-decode (setq cs-decode 'undecided))
4949 (unless cs-encode (setq cs-encode 'undecided))
4950 (setq cs-encode (tramp-coding-system-change-eol-conversion
4951 cs-encode 'unix))
4952 (when (search-forward "\r" nil t)
4953 (setq cs-decode (tramp-coding-system-change-eol-conversion
4954 cs-decode 'dos)))
4955 (set-buffer-process-coding-system cs-decode cs-encode))
4956 ;; Look for ^M and do something useful if found.
4957 (when (search-forward "\r" nil t)
4958 ;; We have found a ^M but cannot frob the process coding system
4959 ;; because we're running on a non-MULE Emacs. Let's try
4960 ;; stty, instead.
4961 (tramp-message 9 "Trying `stty -onlcr'")
4962 (process-send-string nil (format "stty -onlcr%s" tramp-rsh-end-of-line))
4963 (unless (tramp-wait-for-regexp
4964 p 30 (format "\\(%s\\|%s\\)\\'"
4965 shell-prompt-pattern tramp-shell-prompt-pattern))
4966 (pop-to-buffer (buffer-name))
4967 (error "Couldn't `stty -onlcr', see buffer `%s'" (buffer-name))))))
4968 (erase-buffer)
4969 (tramp-message
4970 9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1'")
4971 (process-send-string
4972 nil (format "HISTFILE=$HOME/.tramp_history; HISTSIZE=1%s"
4973 tramp-rsh-end-of-line))
4974 (unless (tramp-wait-for-regexp
4975 p 30 (format "\\(%s\\|%s\\)\\'"
4976 shell-prompt-pattern tramp-shell-prompt-pattern))
4977 (pop-to-buffer (buffer-name))
4978 (error (concat "Couldn't `HISTFILE=$HOME/.tramp_history; "
4979 "HISTSIZE=1', see buffer `%s'")
4980 (buffer-name)))
4981 (erase-buffer)
4982 (tramp-message 9 "Waiting 30s for `set +o vi +o emacs'")
4983 (process-send-string
4984 nil (format "set +o vi +o emacs%s" ;mustn't `>/dev/null' with AIX?
4985 tramp-rsh-end-of-line))
4986 (unless (tramp-wait-for-regexp
4987 p 30 (format "\\(%s\\|%s\\)\\'"
4988 shell-prompt-pattern tramp-shell-prompt-pattern))
4989 (pop-to-buffer (buffer-name))
4990 (error "Couldn't `set +o vi +o emacs', see buffer `%s'"
4991 (buffer-name)))
4992 (erase-buffer)
4993 (tramp-message 9 "Waiting 30s for `unset MAIL MAILCHECK MAILPATH'")
4994 (process-send-string
4995 nil (format "unset MAIL MAILCHECK MAILPATH 1>/dev/null 2>/dev/null%s"
4996 tramp-rsh-end-of-line))
4997 (unless (tramp-wait-for-regexp
4998 p 30 (format "\\(%s\\|%s\\)\\'"
4999 shell-prompt-pattern tramp-shell-prompt-pattern))
5000 (pop-to-buffer (buffer-name))
5001 (error "Couldn't `unset MAIL MAILCHECK MAILPATH', see buffer `%s'"
5002 (buffer-name)))
5003 (erase-buffer)
5004 (tramp-message 9 "Waiting 30s for `unset CDPATH'")
5005 (process-send-string
5006 nil (format "unset CDPATH%s" tramp-rsh-end-of-line))
5007 (unless (tramp-wait-for-regexp
5008 p 30 (format "\\(%s\\|%s\\)\\'"
5009 shell-prompt-pattern tramp-shell-prompt-pattern))
5010 (pop-to-buffer (buffer-name))
5011 (error "Couldn't `unset CDPATH', see buffer `%s'"
5012 (buffer-name)))
5013 (erase-buffer)
5014 (tramp-message 9 "Setting shell prompt")
5015 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must
5016 ;; use "\n" here, not tramp-rsh-end-of-line.
5017 (tramp-send-command
5018 multi-method method user host
5019 (format "PS1='%s%s%s'; PS2=''; PS3=''"
5020 tramp-rsh-end-of-line
5021 tramp-end-of-output
5022 tramp-rsh-end-of-line))
5023 (tramp-wait-for-output))
5024
5025 (defun tramp-post-connection (multi-method method user host)
5026 "Prepare a remote shell before being able to work on it.
5027 METHOD, USER and HOST specify the connection.
5028 Among other things, this finds a shell which groks tilde expansion,
5029 tries to find an `ls' command which groks the `-n' option, sets the
5030 locale to C and sets up the remote shell search path."
5031 ;; Search for a good shell before searching for a command which
5032 ;; checks if a file exists. This is done because Tramp wants to use
5033 ;; "test foo; echo $?" to check if various conditions hold, and
5034 ;; there are buggy /bin/sh implementations which don't execute the
5035 ;; "echo $?" part if the "test" part has an error. In particular,
5036 ;; the Solaris /bin/sh is a problem. I'm betting that all systems
5037 ;; with buggy /bin/sh implementations will have a working bash or
5038 ;; ksh. Whee...
5039 (tramp-find-shell multi-method method user host)
5040 ;; Without (sit-for 0.1) at least, my machine will almost always blow
5041 ;; up on 'not numberp /root' - a race that causes the 'echo ~root'
5042 ;; output of (tramp-find-shell) to show up along with the output of
5043 ;; (tramp-find-ls-command) testing.
5044 ;;
5045 ;; I can't work out why this is a problem though. The (tramp-wait-for-output)
5046 ;; call in (tramp-find-shell) *should* make this not happen, I thought.
5047 ;;
5048 ;; After much debugging I couldn't find any problem with the implementation
5049 ;; of that function though. The workaround stays for me at least. :/
5050 ;;
5051 ;; Daniel Pittman <daniel@danann.net>
5052 (sleep-for 1)
5053 (erase-buffer)
5054 (tramp-find-file-exists-command multi-method method user host)
5055 (make-local-variable 'tramp-ls-command)
5056 (setq tramp-ls-command (tramp-find-ls-command multi-method method user host))
5057 (unless tramp-ls-command
5058 (tramp-message
5059 1
5060 "Danger! Couldn't find ls which groks -n. Muddling through anyway")
5061 (setq tramp-ls-command
5062 (tramp-find-executable multi-method method user host
5063 "ls" tramp-remote-path nil)))
5064 (unless tramp-ls-command
5065 (error "Fatal error: Couldn't find remote executable `ls'"))
5066 (tramp-message 5 "Using remote command `%s' for getting directory listings"
5067 tramp-ls-command)
5068 (tramp-send-command multi-method method user host
5069 (concat "tramp_set_exit_status () {" tramp-rsh-end-of-line
5070 "return $1" tramp-rsh-end-of-line
5071 "}"))
5072 (tramp-wait-for-output)
5073 ;; Set remote PATH variable.
5074 (tramp-set-remote-path multi-method method user host "PATH" tramp-remote-path)
5075 ;; Tell remote shell to use standard time format, needed for
5076 ;; parsing `ls -l' output.
5077 (tramp-send-command multi-method method user host
5078 "LC_TIME=C; export LC_TIME; echo huhu")
5079 (tramp-wait-for-output)
5080 (tramp-send-command multi-method method user host
5081 "mesg n; echo huhu")
5082 (tramp-wait-for-output)
5083 (tramp-send-command multi-method method user host
5084 "biff n ; echo huhu")
5085 (tramp-wait-for-output)
5086 ;; Unalias ls(1) to work around issues with those silly people who make it
5087 ;; spit out ANSI escapes or whatever.
5088 (tramp-send-command multi-method method user host
5089 "unalias ls; echo huhu")
5090 (tramp-wait-for-output)
5091 ;; Does `test A -nt B' work? Use abominable `find' construct if it
5092 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
5093 ;; for otherwise the shell crashes.
5094 (erase-buffer)
5095 (make-local-variable 'tramp-test-groks-nt)
5096 (tramp-send-command multi-method method user host
5097 "( test / -nt / )")
5098 (tramp-wait-for-output)
5099 (goto-char (point-min))
5100 (setq tramp-test-groks-nt
5101 (looking-at (format "\n%s\r?\n" (regexp-quote tramp-end-of-output))))
5102 (unless tramp-test-groks-nt
5103 (tramp-send-command
5104 multi-method method user host
5105 (concat "tramp_test_nt () {" tramp-rsh-end-of-line
5106 "test -n \"`find $1 -prune -newer $2 -print`\"" tramp-rsh-end-of-line
5107 "}")))
5108 (tramp-wait-for-output)
5109 ;; Send the fallback `uudecode' script.
5110 (erase-buffer)
5111 (tramp-send-linewise multi-method method user host tramp-uudecode)
5112 (tramp-wait-for-output)
5113 ;; Find a `perl'.
5114 (erase-buffer)
5115 (let ((tramp-remote-perl
5116 (or (tramp-find-executable multi-method method user host
5117 "perl5" tramp-remote-path nil)
5118 (tramp-find-executable multi-method method user host
5119 "perl" tramp-remote-path nil))))
5120 (when tramp-remote-perl
5121 (tramp-set-connection-property "perl" tramp-remote-perl
5122 multi-method method user host)
5123 ;; Set up stat in Perl if we can.
5124 (when tramp-remote-perl
5125 (tramp-message 5 "Sending the Perl `file-attributes' implementation.")
5126 (tramp-send-linewise
5127 multi-method method user host
5128 (concat "tramp_file_attributes () {\n"
5129 tramp-remote-perl
5130 " -e '" tramp-perl-file-attributes "' $1 2>/dev/null\n"
5131 "}"))
5132 (tramp-wait-for-output)
5133 (unless (tramp-get-rcp-program
5134 multi-method
5135 (tramp-find-method multi-method method user host)
5136 user host)
5137 (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
5138 (tramp-send-linewise
5139 multi-method method user host
5140 (concat "tramp_encode () {\n"
5141 (format tramp-perl-encode tramp-remote-perl)
5142 " 2>/dev/null"
5143 "\n}"))
5144 (tramp-wait-for-output)
5145 (tramp-send-linewise
5146 multi-method method user host
5147 (concat "tramp_encode_with_module () {\n"
5148 (format tramp-perl-encode-with-module tramp-remote-perl)
5149 " 2>/dev/null"
5150 "\n}"))
5151 (tramp-wait-for-output)
5152 (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
5153 (tramp-send-linewise
5154 multi-method method user host
5155 (concat "tramp_decode () {\n"
5156 (format tramp-perl-decode tramp-remote-perl)
5157 " 2>/dev/null"
5158 "\n}"))
5159 (tramp-wait-for-output)
5160 (tramp-send-linewise
5161 multi-method method user host
5162 (concat "tramp_decode_with_module () {\n"
5163 (format tramp-perl-decode-with-module tramp-remote-perl)
5164 " 2>/dev/null"
5165 "\n}"))
5166 (tramp-wait-for-output)))))
5167 ;; Find ln(1)
5168 (erase-buffer)
5169 (let ((ln (tramp-find-executable multi-method method user host
5170 "ln" tramp-remote-path nil)))
5171 (when ln
5172 (tramp-set-connection-property "ln" ln multi-method method user host)))
5173 (erase-buffer)
5174 ;; Find the right encoding/decoding commands to use.
5175 (unless (tramp-get-rcp-program
5176 multi-method
5177 (tramp-find-method multi-method method user host)
5178 user host)
5179 (tramp-find-inline-encoding multi-method method user host))
5180 ;; If encoding/decoding command are given, test to see if they work.
5181 ;; CCC: Maybe it would be useful to run the encoder both locally and
5182 ;; remotely to see if they produce the same result.
5183 (let ((rem-enc (tramp-get-remote-encoding multi-method method user host))
5184 (rem-dec (tramp-get-remote-decoding multi-method method user host))
5185 (magic-string "xyzzy"))
5186 (when (and (or rem-dec rem-enc) (not (and rem-dec rem-enc)))
5187 (tramp-kill-process multi-method method user host)
5188 ;; Improve error message and/or error check.
5189 (error
5190 "Must give both decoding and encoding command in method definition"))
5191 (when (and rem-enc rem-dec)
5192 (tramp-message
5193 5
5194 "Checking to see if encoding/decoding commands work on remote host...")
5195 (tramp-send-command
5196 multi-method method user host
5197 (format "echo %s | %s | %s"
5198 (tramp-shell-quote-argument magic-string) rem-enc rem-dec))
5199 (tramp-wait-for-output)
5200 (unless (looking-at (regexp-quote magic-string))
5201 (tramp-kill-process multi-method method user host)
5202 (error "Remote host cannot execute de/encoding commands. See buffer `%s' for details"
5203 (buffer-name)))
5204 (erase-buffer)
5205 (tramp-message
5206 5 "Checking to see if encoding/decoding commands work on remote host...done"))))
5207
5208 ;; CCC: We should either implement a Perl version of base64 encoding
5209 ;; and decoding. Then we just use that in the last item. The other
5210 ;; alternative is to use the Perl version of UU encoding. But then
5211 ;; we need a Lisp version of uuencode.
5212 ;;
5213 ;; Old text from documentation of tramp-methods:
5214 ;; Using a uuencode/uudecode inline method is discouraged, please use one
5215 ;; of the base64 methods instead since base64 encoding is much more
5216 ;; reliable and the commands are more standardized between the different
5217 ;; Unix versions. But if you can't use base64 for some reason, please
5218 ;; note that the default uudecode command does not work well for some
5219 ;; Unices, in particular AIX and Irix. For AIX, you might want to use
5220 ;; the following command for uudecode:
5221 ;;
5222 ;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
5223 ;;
5224 ;; For Irix, no solution is known yet.
5225
5226 (defvar tramp-coding-commands
5227 '(("mimencode -b" "mimencode -u -b"
5228 base64-encode-region base64-decode-region)
5229 ("mmencode -b" "mmencode -u -b"
5230 base64-encode-region base64-decode-region)
5231 ("recode data..base64" "recode base64..data"
5232 base64-encode-region base64-decode-region)
5233 ("uuencode xxx" "uudecode -o -"
5234 tramp-uuencode-region uudecode-decode-region)
5235 ("uuencode xxx" "uudecode -p"
5236 tramp-uuencode-region uudecode-decode-region)
5237 ("uuencode xxx" "tramp_uudecode"
5238 tramp-uuencode-region uudecode-decode-region)
5239 ("tramp_encode_with_module" "tramp_decode_with_module"
5240 base64-encode-region base64-decode-region)
5241 ("tramp_encode" "tramp_decode"
5242 base64-encode-region base64-decode-region))
5243 "List of coding commands for inline transfer.
5244 Each item is a list that looks like this:
5245
5246 \(REMOTE-ENCODING REMOTE-DECODING LOCAL-ENCODING LOCAL-DECODING)
5247
5248 The REMOTE-ENCODING should be a string, giving a command accepting a
5249 plain file on standard input and writing the encoded file to standard
5250 output. The REMOTE-DECODING should also be a string, giving a command
5251 accepting an encoded file on standard input and writing the decoded
5252 file to standard output.
5253
5254 LOCAL-ENCODING and LOCAL-DECODING can be strings, giving commands, or
5255 symbols, giving functions. If they are strings, then they can contain
5256 the \"%s\" format specifier. If that specifier is present, the input
5257 filename will be put into the command line at that spot. If the
5258 specifier is not present, the input should be read from standard
5259 input.
5260
5261 If they are functions, they will be called with two arguments, start
5262 and end of region, and are expected to replace the region contents
5263 with the encoded or decoded results, respectively.")
5264
5265 (defun tramp-find-inline-encoding (multi-method method user host)
5266 "Find an inline transfer encoding that works.
5267 Goes through the list `tramp-coding-commands'."
5268 (let ((commands tramp-coding-commands)
5269 item found)
5270 (while (and commands (null found))
5271 (setq item (pop commands))
5272 (catch 'wont-work
5273 (let ((rem-enc (nth 0 item))
5274 (rem-dec (nth 1 item))
5275 (loc-enc (nth 2 item))
5276 (loc-dec (nth 3 item)))
5277 ;; Check if remote encoding and decoding commands can be
5278 ;; called remotely with null input and output. This makes
5279 ;; sure there are no syntax errors and the command is really
5280 ;; found.
5281 (tramp-message-for-buffer
5282 multi-method method user host 9
5283 "Checking remote encoding command `%s' for sanity" rem-enc)
5284 (unless (zerop (tramp-send-command-and-check
5285 multi-method method user host
5286 (format "%s </dev/null >/dev/null" rem-enc) t))
5287 (throw 'wont-work nil))
5288 (tramp-message-for-buffer
5289 multi-method method user host 9
5290 "Checking remote decoding command `%s' for sanity" rem-dec)
5291 (unless (zerop (tramp-send-command-and-check
5292 multi-method method user host
5293 (format "echo xyzzy | %s | %s >/dev/null"
5294 rem-enc rem-dec) t))
5295 (throw 'wont-work nil))
5296 ;; If the local encoder or decoder is a string, the
5297 ;; corresponding command has to work locally.
5298 (when (stringp loc-enc)
5299 (tramp-message-for-buffer
5300 multi-method method user host 9
5301 "Checking local encoding command `%s' for sanity" loc-enc)
5302 (unless (zerop (tramp-call-local-coding-command
5303 loc-enc nil nil))
5304 (throw 'wont-work nil)))
5305 (when (stringp loc-dec)
5306 (tramp-message-for-buffer
5307 multi-method method user host 9
5308 "Checking local decoding command `%s' for sanity" loc-dec)
5309 (unless (zerop (tramp-call-local-coding-command
5310 loc-dec nil nil))
5311 (throw 'wont-work nil)))
5312 ;; CCC: At this point, maybe we should check that the output
5313 ;; of the commands is correct. But for the moment we will
5314 ;; assume that commands working on empty input will also
5315 ;; work in practice.
5316 (setq found item))))
5317 ;; Did we find something? If not, issue error. If so,
5318 ;; set connection properties.
5319 (unless found
5320 (error "Couldn't find an inline transfer encoding"))
5321 (let ((rem-enc (nth 0 found))
5322 (rem-dec (nth 1 found))
5323 (loc-enc (nth 2 found))
5324 (loc-dec (nth 3 found)))
5325 (tramp-message 10 "Using remote encoding %s" rem-enc)
5326 (tramp-set-remote-encoding multi-method method user host rem-enc)
5327 (tramp-message 10 "Using remote decoding %s" rem-dec)
5328 (tramp-set-remote-decoding multi-method method user host rem-dec)
5329 (tramp-message 10 "Using local encoding %s" loc-enc)
5330 (tramp-set-local-encoding multi-method method user host loc-enc)
5331 (tramp-message 10 "Using local decoding %s" loc-dec)
5332 (tramp-set-local-decoding multi-method method user host loc-dec))))
5333
5334 (defun tramp-call-local-coding-command (cmd input output)
5335 "Call the local encoding or decoding command.
5336 If CMD contains \"%s\", provide input file INPUT there in command.
5337 Otherwise, INPUT is passed via standard input.
5338 INPUT can also be nil which means `/dev/null'.
5339 OUTPUT can be a string (which specifies a filename), or t (which
5340 means standard output and thus the current buffer), or nil (which
5341 means discard it)."
5342 (call-process
5343 tramp-encoding-shell ;program
5344 (when (and input (not (string-match "%s" cmd)))
5345 input) ;input
5346 (if (eq output t) t nil) ;output
5347 nil ;redisplay
5348 tramp-encoding-command-switch
5349 ;; actual shell command
5350 (concat
5351 (if (string-match "%s" cmd) (format cmd input) cmd)
5352 (if (stringp output) (concat "> " output) ""))))
5353
5354 (defun tramp-maybe-open-connection (multi-method method user host)
5355 "Maybe open a connection to HOST, logging in as USER, using METHOD.
5356 Does not do anything if a connection is already open, but re-opens the
5357 connection if a previous connection has died for some reason."
5358 (let ((p (get-buffer-process
5359 (tramp-get-buffer multi-method method user host)))
5360 last-cmd-time)
5361 ;; If too much time has passed since last command was sent, look
5362 ;; whether process is still alive. If it isn't, kill it. When
5363 ;; using ssh, it can sometimes happen that the remote end has hung
5364 ;; up but the local ssh client doesn't recognize this until it
5365 ;; tries to send some data to the remote end. So that's why we
5366 ;; try to send a command from time to time, then look again
5367 ;; whether the process is really alive.
5368 (save-excursion
5369 (set-buffer (tramp-get-buffer multi-method method user host))
5370 (when (and tramp-last-cmd-time
5371 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60))
5372 (tramp-send-command
5373 multi-method method user host "echo are you awake" nil t)
5374 (unless (tramp-wait-for-output 10)
5375 (delete-process p)
5376 (setq p nil))
5377 (erase-buffer)))
5378 (unless (and p (processp p) (memq (process-status p) '(run open)))
5379 (when (and p (processp p))
5380 (delete-process p))
5381 (funcall (tramp-get-connection-function
5382 multi-method
5383 (tramp-find-method multi-method method user host)
5384 user host)
5385 multi-method method user host))))
5386
5387 (defun tramp-send-command
5388 (multi-method method user host command &optional noerase neveropen)
5389 "Send the COMMAND to USER at HOST (logged in using METHOD).
5390 Erases temporary buffer before sending the command (unless NOERASE
5391 is true).
5392 If optional seventh arg NEVEROPEN is non-nil, never try to open the
5393 connection. This is meant to be used from
5394 `tramp-maybe-open-connection' only."
5395 (or neveropen
5396 (tramp-maybe-open-connection multi-method method user host))
5397 (setq tramp-last-cmd-time (current-time))
5398 (when tramp-debug-buffer
5399 (save-excursion
5400 (set-buffer (tramp-get-debug-buffer multi-method method user host))
5401 (goto-char (point-max))
5402 (tramp-insert-with-face 'bold (format "$ %s\n" command))))
5403 (let ((proc nil))
5404 (set-buffer (tramp-get-buffer multi-method method user host))
5405 (unless noerase (erase-buffer))
5406 (setq proc (get-buffer-process (current-buffer)))
5407 (process-send-string proc
5408 (concat command tramp-rsh-end-of-line))))
5409
5410 ;; It seems that Tru64 Unix does not like it if long strings are sent
5411 ;; to it in one go. (This happens when sending the Perl
5412 ;; `file-attributes' implementation, for instance.) Therefore, we
5413 ;; have this function which waits a bit at each line.
5414 (defun tramp-send-linewise
5415 (multi-method method user host string &optional noerase)
5416 "Send the STRING to USER at HOST linewise.
5417 Erases temporary buffer before sending the STRING (unless NOERASE
5418 is true).
5419
5420 The STRING is expected to use Unix line-endings, but the lines sent to
5421 the remote host use line-endings as defined in the variable
5422 `tramp-rsh-end-of-line'."
5423 (tramp-maybe-open-connection multi-method method user host)
5424 (when tramp-debug-buffer
5425 (save-excursion
5426 (set-buffer (tramp-get-debug-buffer multi-method method user host))
5427 (goto-char (point-max))
5428 (tramp-insert-with-face 'bold (format "$ %s\n" string))))
5429 (let ((proc nil)
5430 (lines (split-string string "\n")))
5431 (set-buffer (tramp-get-buffer multi-method method user host))
5432 (unless noerase (erase-buffer))
5433 (setq proc (get-buffer-process (current-buffer)))
5434 (mapcar (lambda (x)
5435 (sleep-for 0.1)
5436 (process-send-string proc
5437 (concat x tramp-rsh-end-of-line)))
5438 lines)))
5439
5440 (defun tramp-wait-for-output (&optional timeout)
5441 "Wait for output from remote rsh command."
5442 (let ((proc (get-buffer-process (current-buffer)))
5443 (found nil)
5444 (start-time (current-time))
5445 (end-of-output (concat "^"
5446 (regexp-quote tramp-end-of-output)
5447 "\r?$")))
5448 ;; Algorithm: get waiting output. See if last line contains
5449 ;; end-of-output sentinel. If not, wait a bit and again get
5450 ;; waiting output. Repeat until timeout expires or end-of-output
5451 ;; sentinel is seen. Will hang if timeout is nil and
5452 ;; end-of-output sentinel never appears.
5453 (save-match-data
5454 (cond (timeout
5455 ;; Work around an XEmacs bug, where the timeout expires
5456 ;; faster than it should. This degenerates into polling
5457 ;; for buggy XEmacsen, but oh, well.
5458 (while (and (not found)
5459 (< (tramp-time-diff (current-time) start-time)
5460 timeout))
5461 (with-timeout (timeout)
5462 (while (not found)
5463 (accept-process-output proc 1)
5464 (goto-char (point-max))
5465 (forward-line -1)
5466 (setq found (looking-at end-of-output))))))
5467 (t
5468 (while (not found)
5469 (accept-process-output proc 1)
5470 (goto-char (point-max))
5471 (forward-line -1)
5472 (setq found (looking-at end-of-output))))))
5473 ;; At this point, either the timeout has expired or we have found
5474 ;; the end-of-output sentinel.
5475 (when found
5476 (goto-char (point-max))
5477 (forward-line -2)
5478 (delete-region (point) (point-max)))
5479 ;; Add output to debug buffer if appropriate.
5480 (when tramp-debug-buffer
5481 (append-to-buffer
5482 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
5483 tramp-current-user tramp-current-host)
5484 (point-min) (point-max))
5485 (when (not found)
5486 (save-excursion
5487 (set-buffer
5488 (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
5489 tramp-current-user tramp-current-host))
5490 (goto-char (point-max))
5491 (insert "[[Remote prompt `" end-of-output "' not found"
5492 (if timeout (format " in %d secs" timeout) "")
5493 "]]"))))
5494 (goto-char (point-min))
5495 ;; Return value is whether end-of-output sentinel was found.
5496 found))
5497
5498 (defun tramp-match-string-list (&optional string)
5499 "Returns list of all match strings.
5500 That is, (list (match-string 0) (match-string 1) ...), according to the
5501 number of matches."
5502 (let* ((nmatches (/ (length (match-data)) 2))
5503 (i (- nmatches 1))
5504 (res nil))
5505 (while (>= i 0)
5506 (setq res (cons (match-string i string) res))
5507 (setq i (- i 1)))
5508 res))
5509
5510 (defun tramp-send-command-and-check (multi-method method user host command
5511 &optional subshell)
5512 "Run COMMAND and check its exit status.
5513 MULTI-METHOD and METHOD specify how to log in (as USER) to the remote HOST.
5514 Sends `echo $?' along with the COMMAND for checking the exit status. If
5515 COMMAND is nil, just sends `echo $?'. Returns the exit status found.
5516
5517 If the optional argument SUBSHELL is non-nil, the command is executed in
5518 a subshell, ie surrounded by parentheses."
5519 (tramp-send-command multi-method method user host
5520 (concat (if subshell "( " "")
5521 command
5522 (if command " 2>/dev/null; " "")
5523 "echo tramp_exit_status $?"
5524 (if subshell " )" " ")))
5525 (tramp-wait-for-output)
5526 (goto-char (point-max))
5527 (unless (search-backward "tramp_exit_status " nil t)
5528 (error "Couldn't find exit status of `%s'" command))
5529 (skip-chars-forward "^ ")
5530 (read (current-buffer)))
5531
5532 (defun tramp-barf-unless-okay (multi-method method user host command subshell
5533 signal fmt &rest args)
5534 "Run COMMAND, check exit status, throw error if exit status not okay.
5535 Similar to `tramp-send-command-and-check' but accepts two more arguments
5536 FMT and ARGS which are passed to `error'."
5537 (unless (zerop (tramp-send-command-and-check
5538 multi-method method user host command subshell))
5539 ;; CCC: really pop-to-buffer? Maybe it's appropriate to be more
5540 ;; silent.
5541 (pop-to-buffer (current-buffer))
5542 (funcall 'signal signal (apply 'format fmt args))))
5543
5544 ;; Chunked sending kluge.
5545 (defvar tramp-chunksize nil
5546 "If non-nil, chunksize for sending things to remote host.")
5547
5548 (defun tramp-send-region (multi-method method user host start end)
5549 "Send the region from START to END to remote command
5550 running as USER on HOST using METHOD."
5551 (let ((proc (get-buffer-process
5552 (tramp-get-buffer multi-method method user host))))
5553 (unless proc
5554 (error "Can't send region to remote host -- not logged in"))
5555 (if tramp-chunksize
5556 (let ((pos start))
5557 (while (< pos end)
5558 (tramp-message-for-buffer
5559 multi-method method user host 10
5560 "Sending chunk from %s to %s" pos end)
5561 (process-send-region proc
5562 pos
5563 (min (+ pos tramp-chunksize)
5564 end))
5565 (setq pos (+ pos tramp-chunksize))
5566 (sleep-for 0.1)))
5567 (process-send-region proc start end))
5568 (when tramp-debug-buffer
5569 (append-to-buffer
5570 (tramp-get-debug-buffer multi-method method user host)
5571 start end))))
5572
5573 (defun tramp-send-eof (multi-method method user host)
5574 "Send EOF to the remote end.
5575 METHOD, HOST and USER specify the connection."
5576 (let ((proc (get-buffer-process
5577 (tramp-get-buffer multi-method method user host))))
5578 (unless proc
5579 (error "Can't send EOF to remote host -- not logged in"))
5580 (process-send-eof proc)))
5581 ; (process-send-string proc "\^D")))
5582
5583 (defun tramp-kill-process (multi-method method user host)
5584 "Kill the connection process used by Tramp.
5585 MULTI-METHOD, METHOD, USER, and HOST specify the connection."
5586 (let ((proc (get-buffer-process
5587 (tramp-get-buffer multi-method method user host))))
5588 (kill-process proc)))
5589
5590 (defun tramp-discard-garbage-erase-buffer (p multi-method method user host)
5591 "Erase buffer, then discard subsequent garbage.
5592 If `tramp-discard-garbage' is nil, just erase buffer."
5593 (if (not tramp-discard-garbage)
5594 (erase-buffer)
5595 (while (prog1 (erase-buffer) (accept-process-output p 0.25))
5596 (when tramp-debug-buffer
5597 (save-excursion
5598 (set-buffer (tramp-get-debug-buffer multi-method method user host))
5599 (goto-char (point-max))
5600 (tramp-insert-with-face
5601 'bold (format "Additional characters detected\n")))))))
5602
5603 (defun tramp-mode-string-to-int (mode-string)
5604 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
5605 (let* ((mode-chars (string-to-vector mode-string))
5606 (owner-read (aref mode-chars 1))
5607 (owner-write (aref mode-chars 2))
5608 (owner-execute-or-setid (aref mode-chars 3))
5609 (group-read (aref mode-chars 4))
5610 (group-write (aref mode-chars 5))
5611 (group-execute-or-setid (aref mode-chars 6))
5612 (other-read (aref mode-chars 7))
5613 (other-write (aref mode-chars 8))
5614 (other-execute-or-sticky (aref mode-chars 9)))
5615 (save-match-data
5616 (logior
5617 (case owner-read
5618 (?r (tramp-octal-to-decimal "00400")) (?- 0)
5619 (t (error "Second char `%c' must be one of `r-'" owner-read)))
5620 (case owner-write
5621 (?w (tramp-octal-to-decimal "00200")) (?- 0)
5622 (t (error "Third char `%c' must be one of `w-'" owner-write)))
5623 (case owner-execute-or-setid
5624 (?x (tramp-octal-to-decimal "00100"))
5625 (?S (tramp-octal-to-decimal "04000"))
5626 (?s (tramp-octal-to-decimal "04100"))
5627 (?- 0)
5628 (t (error "Fourth char `%c' must be one of `xsS-'"
5629 owner-execute-or-setid)))
5630 (case group-read
5631 (?r (tramp-octal-to-decimal "00040")) (?- 0)
5632 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
5633 (case group-write
5634 (?w (tramp-octal-to-decimal "00020")) (?- 0)
5635 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
5636 (case group-execute-or-setid
5637 (?x (tramp-octal-to-decimal "00010"))
5638 (?S (tramp-octal-to-decimal "02000"))
5639 (?s (tramp-octal-to-decimal "02010"))
5640 (?- 0)
5641 (t (error "Seventh char `%c' must be one of `xsS-'"
5642 group-execute-or-setid)))
5643 (case other-read
5644 (?r (tramp-octal-to-decimal "00004")) (?- 0)
5645 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
5646 (case other-write
5647 (?w (tramp-octal-to-decimal "00002")) (?- 0)
5648 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
5649 (case other-execute-or-sticky
5650 (?x (tramp-octal-to-decimal "00001"))
5651 (?T (tramp-octal-to-decimal "01000"))
5652 (?t (tramp-octal-to-decimal "01001"))
5653 (?- 0)
5654 (t (error "Tenth char `%c' must be one of `xtT-'"
5655 other-execute-or-sticky)))))))
5656
5657
5658 (defun tramp-file-mode-from-int (mode)
5659 "Turn an integer representing a file mode into an ls(1)-like string."
5660 (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
5661 (user (logand (lsh mode -6) 7))
5662 (group (logand (lsh mode -3) 7))
5663 (other (logand (lsh mode -0) 7))
5664 (suid (> (logand (lsh mode -9) 4) 0))
5665 (sgid (> (logand (lsh mode -9) 2) 0))
5666 (sticky (> (logand (lsh mode -9) 1) 0)))
5667 (setq user (tramp-file-mode-permissions user suid "s"))
5668 (setq group (tramp-file-mode-permissions group sgid "s"))
5669 (setq other (tramp-file-mode-permissions other sticky "t"))
5670 (concat type user group other)))
5671
5672
5673 (defun tramp-file-mode-permissions (perm suid suid-text)
5674 "Convert a permission bitset into a string.
5675 This is used internally by `tramp-file-mode-from-int'."
5676 (let ((r (> (logand perm 4) 0))
5677 (w (> (logand perm 2) 0))
5678 (x (> (logand perm 1) 0)))
5679 (concat (or (and r "r") "-")
5680 (or (and w "w") "-")
5681 (or (and suid x suid-text) ; suid, execute
5682 (and suid (upcase suid-text)) ; suid, !execute
5683 (and x "x") "-")))) ; !suid
5684
5685
5686 (defun tramp-decimal-to-octal (i)
5687 "Return a string consisting of the octal digits of I.
5688 Not actually used. Use `(format \"%o\" i)' instead?"
5689 (cond ((< i 0) (error "Cannot convert negative number to octal"))
5690 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
5691 ((zerop i) "0")
5692 (t (concat (tramp-decimal-to-octal (/ i 8))
5693 (number-to-string (% i 8))))))
5694
5695
5696 ;;(defun tramp-octal-to-decimal (ostr)
5697 ;; "Given a string of octal digits, return a decimal number."
5698 ;; (cond ((null ostr) 0)
5699 ;; ((string= "" ostr) 0)
5700 ;; (t (let ((last (aref ostr (1- (length ostr))))
5701 ;; (rest (substring ostr 0 (1- (length ostr)))))
5702 ;; (unless (and (>= last ?0)
5703 ;; (<= last ?7))
5704 ;; (error "Not an octal digit: %c" last))
5705 ;; (+ (- last ?0) (* 8 (tramp-octal-to-decimal rest)))))))
5706 ;; Kudos to Gerd Moellmann for this suggestion.
5707 (defun tramp-octal-to-decimal (ostr)
5708 "Given a string of octal digits, return a decimal number."
5709 (let ((x (or ostr "")))
5710 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
5711 (unless (string-match "\\`[0-7]*\\'" x)
5712 (error "Non-octal junk in string `%s'" x))
5713 (string-to-number ostr 8)))
5714
5715 (defun tramp-shell-case-fold (string)
5716 "Converts STRING to shell glob pattern which ignores case."
5717 (mapconcat
5718 (lambda (c)
5719 (if (equal (downcase c) (upcase c))
5720 (vector c)
5721 (format "[%c%c]" (downcase c) (upcase c))))
5722 string
5723 ""))
5724
5725
5726 ;; ------------------------------------------------------------
5727 ;; -- TRAMP file names --
5728 ;; ------------------------------------------------------------
5729 ;; Conversion functions between external representation and
5730 ;; internal data structure. Convenience functions for internal
5731 ;; data structure.
5732
5733 (defstruct tramp-file-name multi-method method user host path)
5734
5735 (defun tramp-tramp-file-p (name)
5736 "Return t iff NAME is a tramp file."
5737 (save-match-data
5738 (string-match tramp-file-name-regexp name)))
5739
5740 ;; HHH: Changed. Used to assign the return value of (user-login-name)
5741 ;; to the `user' part of the structure if a user name was not
5742 ;; provided, now it assigns nil.
5743 (defun tramp-dissect-file-name (name)
5744 "Return an `tramp-file-name' structure.
5745 The structure consists of remote method, remote user, remote host and
5746 remote path name."
5747 (let (method)
5748 (save-match-data
5749 (unless (string-match (nth 0 tramp-file-name-structure) name)
5750 (error "Not a tramp file name: %s" name))
5751 (setq method (match-string (nth 1 tramp-file-name-structure) name))
5752 (if (and method (member method tramp-multi-methods))
5753 ;; If it's a multi method, the file name structure contains
5754 ;; arrays of method, user and host.
5755 (tramp-dissect-multi-file-name name)
5756 ;; Normal method. First, find out default method.
5757 (let ((user (match-string (nth 2 tramp-file-name-structure) name))
5758 (host (match-string (nth 3 tramp-file-name-structure) name))
5759 (path (match-string (nth 4 tramp-file-name-structure) name)))
5760 (make-tramp-file-name
5761 :multi-method nil
5762 :method method
5763 :user (or user nil)
5764 :host host
5765 :path path))))))
5766
5767 (defun tramp-find-default-method (user host)
5768 "Look up the right method to use in `tramp-default-method-alist'."
5769 (let ((choices tramp-default-method-alist)
5770 (method tramp-default-method)
5771 item)
5772 (while choices
5773 (setq item (pop choices))
5774 (when (and (string-match (nth 0 item) (or host ""))
5775 (string-match (nth 1 item) (or user "")))
5776 (setq method (nth 2 item))
5777 (setq choices nil)))
5778 method))
5779
5780 (defun tramp-find-method (multi-method method user host)
5781 "Return the right method string to use.
5782 This is MULTI-METHOD, if non-nil. Otherwise, it is METHOD, if non-nil.
5783 If both MULTI-METHOD and METHOD are nil, do a lookup in
5784 `tramp-default-method-alist'."
5785 (or multi-method method (tramp-find-default-method user host)))
5786
5787 ;; HHH: Not Changed. Multi method. Will probably not handle the case where
5788 ;; a user name is not provided in the "file name" very well.
5789 (defun tramp-dissect-multi-file-name (name)
5790 "Not implemented yet."
5791 (let ((regexp (nth 0 tramp-multi-file-name-structure))
5792 (method-index (nth 1 tramp-multi-file-name-structure))
5793 (hops-index (nth 2 tramp-multi-file-name-structure))
5794 (path-index (nth 3 tramp-multi-file-name-structure))
5795 (hop-regexp (nth 0 tramp-multi-file-name-hop-structure))
5796 (hop-method-index (nth 1 tramp-multi-file-name-hop-structure))
5797 (hop-user-index (nth 2 tramp-multi-file-name-hop-structure))
5798 (hop-host-index (nth 3 tramp-multi-file-name-hop-structure))
5799 method hops len hop-methods hop-users hop-hosts path)
5800 (unless (string-match (format regexp hop-regexp) name)
5801 (error "Not a multi tramp file name: %s" name))
5802 (setq method (match-string method-index name))
5803 (setq hops (match-string hops-index name))
5804 (setq len (/ (length (match-data t)) 2))
5805 (when (< path-index 0) (incf path-index len))
5806 (setq path (match-string path-index name))
5807 (let ((index 0))
5808 (while (string-match hop-regexp hops index)
5809 (setq index (match-end 0))
5810 (setq hop-methods
5811 (cons (match-string hop-method-index hops) hop-methods))
5812 (setq hop-users
5813 (cons (match-string hop-user-index hops) hop-users))
5814 (setq hop-hosts
5815 (cons (match-string hop-host-index hops) hop-hosts))))
5816 (make-tramp-file-name
5817 :multi-method method
5818 :method (apply 'vector (reverse hop-methods))
5819 :user (apply 'vector (reverse hop-users))
5820 :host (apply 'vector (reverse hop-hosts))
5821 :path path)))
5822
5823 (defun tramp-make-tramp-file-name (multi-method method user host path)
5824 "Constructs a tramp file name from METHOD, USER, HOST and PATH."
5825 (if multi-method
5826 (tramp-make-tramp-multi-file-name multi-method method user host path)
5827 (format-spec
5828 (concat tramp-prefix-format
5829 (when method (concat "%m" tramp-postfix-single-method-format))
5830 (when user (concat "%u" tramp-postfix-user-format))
5831 (when host (concat "%h" tramp-postfix-host-format))
5832 (when path (concat "%p")))
5833 `((?m . ,method) (?u . ,user) (?h . ,host) (?p . ,path)))))
5834
5835 ;; CCC: Henrik Holm: Not Changed. Multi Method. What should be done
5836 ;; with this when USER is nil?
5837 (defun tramp-make-tramp-multi-file-name (multi-method method user host path)
5838 "Constructs a tramp file name for a multi-hop method."
5839 (unless tramp-make-multi-tramp-file-format
5840 (error "`tramp-make-multi-tramp-file-format' is nil"))
5841 (let* ((prefix-format (nth 0 tramp-make-multi-tramp-file-format))
5842 (hop-format (nth 1 tramp-make-multi-tramp-file-format))
5843 (path-format (nth 2 tramp-make-multi-tramp-file-format))
5844 (prefix (format-spec prefix-format `((?m . ,multi-method))))
5845 (hops "")
5846 (path (format-spec path-format `((?p . ,path))))
5847 (i 0)
5848 (len (length method)))
5849 (while (< i len)
5850 (let ((m (aref method i)) (u (aref user i)) (h (aref host i)))
5851 (setq hops (concat hops (format-spec hop-format
5852 `((?m . ,m) (?u . ,u) (?h . ,h)))))
5853 (incf i)))
5854 (concat prefix hops path)))
5855
5856 (defun tramp-make-rcp-program-file-name (user host path)
5857 "Create a file name suitable to be passed to `rcp'."
5858 (if user
5859 (format "%s@%s:%s" user host path)
5860 (format "%s:%s" host path)))
5861
5862 (defun tramp-make-ange-ftp-file-name (user host path)
5863 "Given user, host, and path, return an Ange-FTP filename."
5864 (if user
5865 (format "/%s@%s:%s" user host path)
5866 (format "/%s:%s" host path)))
5867
5868 (defun tramp-method-out-of-band-p (multi-method method user host)
5869 "Return t if this is an out-of-band method, nil otherwise.
5870 It is important to check for this condition, since it is not possible
5871 to enter a password for the `tramp-rcp-program'."
5872 (tramp-get-rcp-program
5873 multi-method
5874 (tramp-find-method multi-method method user host)
5875 user host))
5876
5877 ;; Variables local to connection.
5878
5879 (defun tramp-get-ls-command (multi-method method user host)
5880 (save-excursion
5881 (tramp-maybe-open-connection multi-method method user host)
5882 (set-buffer (tramp-get-buffer multi-method method user host))
5883 tramp-ls-command))
5884
5885 (defun tramp-get-test-groks-nt (multi-method method user host)
5886 (save-excursion
5887 (tramp-maybe-open-connection multi-method method user host)
5888 (set-buffer (tramp-get-buffer multi-method method user host))
5889 tramp-test-groks-nt))
5890
5891 (defun tramp-get-file-exists-command (multi-method method user host)
5892 (save-excursion
5893 (tramp-maybe-open-connection multi-method method user host)
5894 (set-buffer (tramp-get-buffer multi-method method user host))
5895 tramp-file-exists-command))
5896
5897 (defun tramp-get-remote-perl (multi-method method user host)
5898 (tramp-get-connection-property "perl" nil multi-method method user host))
5899
5900 (defun tramp-get-remote-ln (multi-method method user host)
5901 (tramp-get-connection-property "ln" nil multi-method method user host))
5902
5903 ;; Get a property of a TRAMP connection.
5904 (defun tramp-get-connection-property
5905 (property default multi-method method user host)
5906 "Get the named property for the connection.
5907 If the value is not set for the connection, return `default'"
5908 (tramp-maybe-open-connection multi-method method user host)
5909 (with-current-buffer (tramp-get-buffer multi-method method user host)
5910 (let (error)
5911 (condition-case nil
5912 (symbol-value (intern (concat "tramp-connection-property-" property)))
5913 (error default)))))
5914
5915 ;; Set a property of a TRAMP connection.
5916 (defun tramp-set-connection-property
5917 (property value multi-method method user host)
5918 "Set the named property of a TRAMP connection."
5919 (tramp-maybe-open-connection multi-method method user host)
5920 (with-current-buffer (tramp-get-buffer multi-method method user host)
5921 (set (make-local-variable
5922 (intern (concat "tramp-connection-property-" property)))
5923 value)))
5924
5925 ;; Some predefined connection properties.
5926 (defun tramp-set-remote-encoding (multi-method method user host rem-enc)
5927 (tramp-set-connection-property "remote-encoding" rem-enc
5928 multi-method method user host))
5929 (defun tramp-get-remote-encoding (multi-method method user host)
5930 (tramp-get-connection-property "remote-encoding" nil
5931 multi-method method user host))
5932
5933 (defun tramp-set-remote-decoding (multi-method method user host rem-dec)
5934 (tramp-set-connection-property "remote-decoding" rem-dec
5935 multi-method method user host))
5936 (defun tramp-get-remote-decoding (multi-method method user host)
5937 (tramp-get-connection-property "remote-decoding" nil
5938 multi-method method user host))
5939
5940 (defun tramp-set-local-encoding (multi-method method user host loc-enc)
5941 (tramp-set-connection-property "local-encoding" loc-enc
5942 multi-method method user host))
5943 (defun tramp-get-local-encoding (multi-method method user host)
5944 (tramp-get-connection-property "local-encoding" nil
5945 multi-method method user host))
5946
5947 (defun tramp-set-local-decoding (multi-method method user host loc-dec)
5948 (tramp-set-connection-property "local-decoding" loc-dec
5949 multi-method method user host))
5950 (defun tramp-get-local-decoding (multi-method method user host)
5951 (tramp-get-connection-property "local-decoding" nil
5952 multi-method method user host))
5953
5954
5955
5956 (defun tramp-get-connection-function (multi-method method user host)
5957 (second (or (assoc 'tramp-connection-function
5958 (assoc (tramp-find-method multi-method method user host)
5959 tramp-methods))
5960 (error "Method `%s' didn't specify a connection function"
5961 (or multi-method method)))))
5962
5963 (defun tramp-get-remote-sh (multi-method method user host)
5964 (second (or (assoc 'tramp-remote-sh
5965 (assoc (tramp-find-method multi-method method user host)
5966 tramp-methods))
5967 (error "Method `%s' didn't specify a remote shell"
5968 (or multi-method method)))))
5969
5970 (defun tramp-get-rsh-program (multi-method method user host)
5971 (second (or (assoc 'tramp-rsh-program
5972 (assoc (tramp-find-method multi-method method user host)
5973 tramp-methods))
5974 (error "Method `%s' didn't specify an rsh program"
5975 (or multi-method method)))))
5976
5977 (defun tramp-get-rsh-args (multi-method method user host)
5978 (second (or (assoc 'tramp-rsh-args
5979 (assoc (tramp-find-method multi-method method user host)
5980 tramp-methods))
5981 (error "Method `%s' didn't specify rsh args"
5982 (or multi-method method)))))
5983
5984 (defun tramp-get-rcp-program (multi-method method user host)
5985 (second (or (assoc 'tramp-rcp-program
5986 (assoc (tramp-find-method multi-method method user host)
5987 tramp-methods))
5988 (error "Method `%s' didn't specify an rcp program"
5989 (or multi-method method)))))
5990
5991 (defun tramp-get-rcp-args (multi-method method user host)
5992 (second (or (assoc 'tramp-rcp-args
5993 (assoc (tramp-find-method multi-method method user host)
5994 tramp-methods))
5995 (error "Method `%s' didn't specify rcp args"
5996 (or multi-method method)))))
5997
5998 (defun tramp-get-rcp-keep-date-arg (multi-method method user host)
5999 (second (or (assoc 'tramp-rcp-keep-date-arg
6000 (assoc (tramp-find-method multi-method method user host)
6001 tramp-methods))
6002 (error "Method `%s' didn't specify `keep-date' arg for tramp"
6003 (or multi-method method)))))
6004
6005 (defun tramp-get-su-program (multi-method method user host)
6006 (second (or (assoc 'tramp-su-program
6007 (assoc (tramp-find-method multi-method method user host)
6008 tramp-methods))
6009 (error "Method `%s' didn't specify a su program"
6010 (or multi-method method)))))
6011
6012 (defun tramp-get-su-args (multi-method method user host)
6013 (second (or (assoc 'tramp-su-args
6014 (assoc (tramp-find-method multi-method method user host)
6015 tramp-methods))
6016 (error "Method `%s' didn't specify su args"
6017 (or multi-method method)))))
6018
6019 (defun tramp-get-telnet-program (multi-method method user host)
6020 (second (or (assoc 'tramp-telnet-program
6021 (assoc (tramp-find-method multi-method method user host)
6022 tramp-methods))
6023 (error "Method `%s' didn't specify a telnet program"
6024 (or multi-method method)))))
6025
6026 (defun tramp-get-telnet-args (multi-method method user host)
6027 (second (or (assoc 'tramp-telnet-args
6028 (assoc (tramp-find-method multi-method method user host)
6029 tramp-methods))
6030 (error "Method `%s' didn't specify telnet args"
6031 (or multi-method method)))))
6032
6033
6034 ;; Auto saving to a special directory.
6035
6036 (defun tramp-make-auto-save-file-name (fn)
6037 "Returns a file name in `tramp-auto-save-directory' for autosaving this file."
6038 (when tramp-auto-save-directory
6039 (unless (file-exists-p tramp-auto-save-directory)
6040 (make-directory tramp-auto-save-directory t)))
6041 ;; jka-compr doesn't like auto-saving, so by appending "~" to the
6042 ;; file name we make sure that jka-compr isn't used for the
6043 ;; auto-save file.
6044 (let ((buffer-file-name (expand-file-name
6045 (tramp-subst-strs-in-string '(("_" . "|")
6046 ("/" . "_a")
6047 (":" . "_b")
6048 ("|" . "__")
6049 ("[" . "_l")
6050 ("]" . "_r"))
6051 fn)
6052 tramp-auto-save-directory)))
6053 (make-auto-save-file-name)))
6054
6055 (defadvice make-auto-save-file-name
6056 (around tramp-advice-make-auto-save-file-name () activate)
6057 "Invoke `tramp-make-auto-save-file-name' for tramp files."
6058 (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))
6059 tramp-auto-save-directory)
6060 (setq ad-return-value
6061 (tramp-make-auto-save-file-name (buffer-file-name)))
6062 ad-do-it))
6063
6064 (defun tramp-subst-strs-in-string (alist string)
6065 "Replace all occurrences of the string FROM with TO in STRING.
6066 ALIST is of the form ((FROM . TO) ...)."
6067 (save-match-data
6068 (while alist
6069 (let* ((pr (car alist))
6070 (from (car pr))
6071 (to (cdr pr)))
6072 (while (string-match (regexp-quote from) string)
6073 (setq string (replace-match to t t string)))
6074 (setq alist (cdr alist))))
6075 string))
6076
6077 (defun tramp-insert-with-face (face string)
6078 "Insert text with a specific face."
6079 (let ((start (point)))
6080 (insert string)
6081 (add-text-properties start (point) (list 'face face))))
6082
6083 ;; ------------------------------------------------------------
6084 ;; -- Compatibility functions section --
6085 ;; ------------------------------------------------------------
6086
6087 (defun tramp-temporary-file-directory ()
6088 "Return name of directory for temporary files (compat function).
6089 For Emacs, this is the variable `temporary-file-directory', for XEmacs
6090 this is the function `temp-directory'."
6091 (cond ((boundp 'temporary-file-directory)
6092 (symbol-value 'temporary-file-directory))
6093 ((fboundp 'temp-directory)
6094 (funcall (symbol-function 'temp-directory))) ;pacify byte-compiler
6095 ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
6096 (file-name-as-directory (getenv "TEMP")))
6097 ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
6098 (file-name-as-directory (getenv "TMP")))
6099 ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
6100 (file-name-as-directory (getenv "TMPDIR")))
6101 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
6102 (t (message (concat "Neither `temporary-file-directory' nor "
6103 "`temp-directory' is defined -- using /tmp."))
6104 (file-name-as-directory "/tmp"))))
6105
6106 (defun tramp-read-passwd (prompt)
6107 "Read a password from user (compat function).
6108 Invokes `read-passwd' if that is defined, else `ange-ftp-read-passwd'."
6109 (apply
6110 (if (fboundp 'read-passwd) #'read-passwd #'ange-ftp-read-passwd)
6111 (list prompt)))
6112
6113 (defun tramp-time-diff (t1 t2)
6114 "Return the difference between the two times, in seconds.
6115 T1 and T2 are time values (as returned by `current-time' for example).
6116
6117 NOTE: This function will fail if the time difference is too large to
6118 fit in an integer."
6119 ;; Pacify byte-compiler with `symbol-function'.
6120 (cond ((fboundp 'subtract-time)
6121 (cadr (funcall (symbol-function 'subtract-time) t1 t2)))
6122 ((fboundp 'itimer-time-difference)
6123 (floor (funcall
6124 (symbol-function 'itimer-time-difference)
6125 (if (< (length t1) 3) (append t1 '(0)) t1)
6126 (if (< (length t2) 3) (append t2 '(0)) t2))))
6127 (t
6128 ;; snarfed from Emacs 21 time-date.el
6129 (cadr (let ((borrow (< (cadr t1) (cadr t2))))
6130 (list (- (car t1) (car t2) (if borrow 1 0))
6131 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))))))
6132
6133 (defun tramp-coding-system-change-eol-conversion (coding-system eol-type)
6134 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
6135 EOL-TYPE can be one of `dos', `unix', or `mac'."
6136 (cond ((fboundp 'coding-system-change-eol-conversion)
6137 (apply #'coding-system-change-eol-conversion
6138 (list coding-system eol-type)))
6139 ((fboundp 'subsidiary-coding-system)
6140 (apply
6141 #'subsidiary-coding-system
6142 (list coding-system
6143 (cond ((eq eol-type 'dos) 'crlf)
6144 ((eq eol-type 'unix) 'lf)
6145 ((eq eol-type 'mac) 'cr)
6146 (t
6147 (error "Unknown EOL-TYPE `%s', must be %s"
6148 eol-type
6149 "`dos', `unix', or `mac'"))))))
6150 (t (error "Can't change EOL conversion -- is MULE missing?"))))
6151
6152 (defun tramp-split-string (string pattern)
6153 "Like `split-string' but omit empty strings.
6154 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
6155 This is, the first, empty, element is omitted. In XEmacs, the first
6156 element is not omitted.
6157
6158 Note: this function has been written for `tramp-handle-file-truename'.
6159 If you want to use it for something else, you'll have to check whether
6160 it does the right thing."
6161 (delete "" (split-string string pattern)))
6162
6163 ;; ------------------------------------------------------------
6164 ;; -- Kludges section --
6165 ;; ------------------------------------------------------------
6166
6167 ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
6168 ;; does not deal well with newline characters. Newline is replaced by
6169 ;; backslash newline. But if, say, the string `a backslash newline b'
6170 ;; is passed to a shell, the shell will expand this into "ab",
6171 ;; completely omitting the newline. This is not what was intended.
6172 ;; It does not appear to be possible to make the function
6173 ;; `shell-quote-argument' work with newlines without making it
6174 ;; dependent on the shell used. But within this package, we know that
6175 ;; we will always use a Bourne-like shell, so we use an approach which
6176 ;; groks newlines.
6177 ;;
6178 ;; The approach is simple: we call `shell-quote-argument', then
6179 ;; massage the newline part of the result.
6180 ;;
6181 ;; This function should produce a string which is grokked by a Unix
6182 ;; shell, even if the Emacs is running on Windows. Since this is the
6183 ;; kludges section, we bind `system-type' in such a way that
6184 ;; `shell-quote-arguments' behaves as if on Unix.
6185 ;;
6186 ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
6187 ;; function to work with Bourne-like shells.
6188 ;;
6189 ;; CCC: This function should be rewritten so that
6190 ;; `shell-quote-argument' is not used. This way, we are safe from
6191 ;; changes in `shell-quote-argument'.
6192 (defun tramp-shell-quote-argument (s)
6193 "Similar to `shell-quote-argument', but groks newlines.
6194 Only works for Bourne-like shells."
6195 (let ((system-type 'not-windows))
6196 (save-match-data
6197 (let ((result (shell-quote-argument s))
6198 (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
6199 (when (and (>= (length result) 2)
6200 (string= (substring result 0 2) "\\~"))
6201 (setq result (substring result 1)))
6202 (while (string-match nl result)
6203 (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
6204 t t result)))
6205 result))))
6206
6207 ;; ;; EFS hooks itself into the file name handling stuff in more places
6208 ;; ;; than just `file-name-handler-alist'. The following tells EFS to stay
6209 ;; ;; away from tramp.el paths.
6210 ;; ;;
6211 ;; ;; This is needed because EFS installs (efs-dired-before-readin) into
6212 ;; ;; 'dired-before-readin-hook'. This prevents EFS from opening an FTP
6213 ;; ;; connection to help it's dired process. Not that I have any real
6214 ;; ;; idea *why* this is helpful to dired.
6215 ;; ;;
6216 ;; ;; Anyway, this advice fixes the problem (with a sledgehammer :)
6217 ;; ;;
6218 ;; ;; Daniel Pittman <daniel@danann.net>
6219 ;; ;;
6220 ;; ;; CCC: when the other defadvice calls have disappeared, make sure
6221 ;; ;; not to call defadvice unless it's necessary. How do we find out whether
6222 ;; ;; it is necessary? (featurep 'efs) is surely the wrong way --
6223 ;; ;; EFS might nicht be loaded yet.
6224 ;; (defadvice efs-ftp-path (around dont-match-tramp-path activate protect)
6225 ;; "Cause efs-ftp-path to fail when the path is a TRAMP path."
6226 ;; (if (tramp-tramp-file-p (ad-get-arg 0))
6227 ;; nil
6228 ;; ad-do-it))
6229
6230 ;; We currently (sometimes) use "[" and "]" in the filename format.
6231 ;; This means that Emacs wants to expand wildcards if
6232 ;; `find-file-wildcards' is non-nil, and then barfs because no
6233 ;; expansion could be found. We detect this situation and do
6234 ;; something really awful: we have `file-expand-wildcards' return the
6235 ;; original filename if it can't expand anything. Let's just hope
6236 ;; that this doesn't break anything else.
6237 ;; CCC: This check is now also really awful; we should search all
6238 ;; of the filename format, not just the prefix.
6239 (when (string-match "\\[" tramp-prefix-format)
6240 (defadvice file-expand-wildcards (around tramp-fix activate)
6241 (let ((name (ad-get-arg 0)))
6242 (if (tramp-tramp-file-p name)
6243 ;; If it's a Tramp file, dissect it and look if wildcards
6244 ;; need to be expanded at all.
6245 (let ((v (tramp-dissect-file-name name)))
6246 (if (string-match "[[*?]" (tramp-file-name-path v))
6247 (let ((res ad-do-it))
6248 (setq ad-return-value (or res (list name))))
6249 (setq ad-return-value (list name))))
6250 ;; If it is not a Tramp file, just run the original function.
6251 (let ((res ad-do-it))
6252 (setq ad-return-value (or res (list name)))))))
6253 )
6254
6255 ;; Tramp version is useful in a number of situations.
6256
6257 (defun tramp-version (arg)
6258 "Print version number of tramp.el in minibuffer or current buffer."
6259 (interactive "P")
6260 (if arg (insert tramp-version) (message tramp-version)))
6261
6262 ;; Make the `reporter` functionality available for making bug reports about
6263 ;; the package. A most useful piece of code.
6264
6265 (unless (fboundp 'reporter-submit-bug-report)
6266 (autoload 'reporter-submit-bug-report "reporter"))
6267
6268 (defun tramp-bug ()
6269 "Submit a bug report to the TRAMP developers."
6270 (interactive)
6271 (require 'reporter)
6272 (let ((reporter-prompt-for-summary-p t))
6273 (reporter-submit-bug-report
6274 tramp-bug-report-address ; to-address
6275 (format "tramp (%s)" tramp-version) ; package name and version
6276 `(;; Current state
6277 tramp-ls-command
6278 tramp-test-groks-nt
6279 tramp-file-exists-command
6280 tramp-current-multi-method
6281 tramp-current-method
6282 tramp-current-user
6283 tramp-current-host
6284
6285 ;; System defaults
6286 tramp-auto-save-directory ; vars to dump
6287 tramp-default-method
6288 tramp-rsh-end-of-line
6289 tramp-password-end-of-line
6290 tramp-remote-path
6291 tramp-login-prompt-regexp
6292 tramp-password-prompt-regexp
6293 tramp-wrong-passwd-regexp
6294 tramp-yesno-prompt-regexp
6295 tramp-yn-prompt-regexp
6296 tramp-temp-name-prefix
6297 tramp-file-name-structure
6298 tramp-file-name-regexp
6299 tramp-multi-file-name-structure
6300 tramp-multi-file-name-hop-structure
6301 tramp-multi-methods
6302 tramp-multi-connection-function-alist
6303 tramp-methods
6304 tramp-end-of-output
6305 tramp-coding-commands
6306 tramp-actions-before-shell
6307 tramp-multi-actions
6308 tramp-terminal-type
6309 tramp-shell-prompt-pattern
6310
6311 ;; Non-tramp variables of interest
6312 shell-prompt-pattern
6313 backup-by-copying
6314 backup-by-copying-when-linked
6315 backup-by-copying-when-mismatch
6316 ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
6317 'backup-by-copying-when-privileged-mismatch)
6318 file-name-handler-alist)
6319 nil ; pre-hook
6320 nil ; post-hook
6321 "\
6322 Enter your bug report in this message, including as much detail as you
6323 possibly can about the problem, what you did to cause it and what the
6324 local and remote machines are.
6325
6326 If you can give a simple set of instructions to make this bug happen
6327 reliably, please include those. Thank you for helping kill bugs in
6328 TRAMP.
6329
6330 Another useful thing to do is to put (setq tramp-debug-buffer t) in
6331 the ~/.emacs file and to repeat the bug. Then, include the contents
6332 of the *tramp/foo* buffer and the *debug tramp/foo* buffer in your bug
6333 report.
6334
6335 --bug report follows this line--
6336 ")))
6337
6338 (defalias 'tramp-submit-bug 'tramp-bug)
6339
6340 (provide 'tramp)
6341
6342 ;; Make sure that we get integration with the VC package.
6343 ;; When it is loaded, we need to pull in the integration module.
6344 ;; This must come after (provide 'tramp) because tramp-vc.el
6345 ;; requires tramp.
6346 (eval-after-load "vc"
6347 '(require 'tramp-vc))
6348
6349 ;;; TODO:
6350
6351 ;; * Autodetect if remote `ls' groks the "--dired" switch.
6352 ;; * Add fallback for inline encodings. This should be used
6353 ;; if the remote end doesn't support mimencode or a similar program.
6354 ;; For reading files from the remote host, we can just parse the output
6355 ;; of `od -b'. For writing files to the remote host, we construct
6356 ;; a shell program which contains only "safe" ascii characters
6357 ;; and which writes the right bytes to the file. We can use printf(1)
6358 ;; or "echo -e" or the printf function in awk and use octal escapes
6359 ;; for the "dangerous" characters. The null byte might be a problem.
6360 ;; On some systems, the octal escape doesn't work. So we try the following
6361 ;; two commands to write a null byte:
6362 ;; dd if=/dev/zero bs=1 count=1
6363 ;; echo | tr '\n' '\000'
6364 ;; * Separate local `tramp-coding-commands' from remote ones. Connect
6365 ;; the two via a format which can be `uu' or `b64'. Then we can search
6366 ;; for the right local commands and the right remote commands separately.
6367 ;; * Cooperate with PCL-CVS. It uses start-process, which doesn't
6368 ;; work for remote files.
6369 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
6370 ;; `shell-quote-argument'.
6371 ;; * Completion gets confused when you leave out the method name.
6372 ;; * Support `dired-compress-file' filename handler.
6373 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
6374 ;; by the files in that directory. Add this here.
6375 ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
6376 ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
6377 ;; * When logging in, keep looking for questions according to an alist
6378 ;; and then invoke the right function.
6379 ;; * Case-insensitive filename completion. (Norbert Goevert.)
6380 ;; * Running CVS remotely doesn't appear to work right. It thinks
6381 ;; files are locked by somebody else even if I'm the locking user.
6382 ;; Sometimes, one gets `No CVSROOT specified' errors from CVS.
6383 ;; (Skip Montanaro)
6384 ;; * Don't use globbing for directories with many files, as this is
6385 ;; likely to produce long command lines, and some shells choke on
6386 ;; long command lines.
6387 ;; * Find out about the new auto-save mechanism in Emacs 21 and
6388 ;; do the right thing.
6389 ;; * `vc-directory' does not work. It never displays any files, even
6390 ;; if it does show files when run locally.
6391 ;; * Allow correction of passwords, if the remote end allows this.
6392 ;; (Mark Hershberger)
6393 ;; * Make sure permissions of tmp file are good.
6394 ;; (Nelson Minar <nelson@media.mit.edu>)
6395 ;; * Grok passwd prompts with scp? (David Winter
6396 ;; <winter@nevis1.nevis.columbia.edu>). Maybe just do `ssh -l user
6397 ;; host', then wait a while for the passwd or passphrase prompt. If
6398 ;; there is one, remember the passwd/phrase.
6399 ;; * How to deal with MULE in `insert-file-contents' and `write-region'?
6400 ;; * Do asynchronous `shell-command's.
6401 ;; * Grok `append' parameter for `write-region'.
6402 ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
6403 ;; * abbreviate-file-name
6404 ;; * grok ~ in tramp-remote-path (Henrik Holm <henrikh@tele.ntnu.no>)
6405 ;; * `C' in dired gives error `not tramp file name'.
6406 ;; * Also allow to omit user names when doing multi-hop. Not sure yet
6407 ;; what the user names should default to, though.
6408 ;; * better error checking. At least whenever we see something
6409 ;; strange when doing zerop, we should kill the process and start
6410 ;; again. (Greg Stark)
6411 ;; * Add caching for filename completion. (Greg Stark)
6412 ;; Of course, this has issues with usability (stale cache bites)
6413 ;; -- <daniel@danann.net>
6414 ;; * Provide a local cache of old versions of remote files for the rsync
6415 ;; transfer method to use. (Greg Stark)
6416 ;; * Remove unneeded parameters from methods.
6417 ;; * Invoke rsync once for copying a whole directory hierarchy.
6418 ;; (Francesco Potortì)
6419 ;; * Should we set PATH ourselves or should we rely on the remote end
6420 ;; to do it?
6421 ;; * Do the autoconf thing.
6422 ;; * Make it work for XEmacs 20, which is missing `with-timeout'.
6423 ;; * Allow non-Unix remote systems. (More a long-term thing.)
6424 ;; * Make it work for different encodings, and for different file name
6425 ;; encodings, too. (Daniel Pittman)
6426 ;; * Change applicable functions to pass a struct tramp-file-name rather
6427 ;; than the individual items MULTI-METHOD, METHOD, USER, HOST, PATH.
6428 ;; * Implement asynchronous shell commands.
6429 ;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
6430 ;; * Progress reports while copying files. (Michael Kifer)
6431 ;; * `Smart' connection method that uses inline for small and out of
6432 ;; band for large files. (Michael Kifer)
6433 ;; * Don't search for perl5 and perl. Instead, only search for perl and
6434 ;; then look if it's the right version (with `perl -v').
6435 ;; * When editing a remote CVS controlled file as a different user, VC
6436 ;; gets confused about the file locking status. Try to find out why
6437 ;; the workaround doesn't work.
6438 ;; * When user is running ssh-agent, it would be useful to add the
6439 ;; passwords typed by the user to that agent. This way, the next time
6440 ;; round, the users don't have to type all this in again.
6441 ;; This would be especially useful for start-process, I think.
6442 ;; An easy way to implement start-process is to open a second shell
6443 ;; connection which is inconvenient if the user has to reenter
6444 ;; passwords.
6445 ;; * Change `copy-file' to grok the case where the filename handler
6446 ;; for the source and the target file are different. Right now,
6447 ;; it looks at the source file and then calls that handler, if
6448 ;; there is one. But since ange-ftp, for instance, does not know
6449 ;; about Tramp, it does not do the right thing if the target file
6450 ;; name is a Tramp name.
6451 ;; * Username and hostname completion.
6452 ;; ** If `partial-completion-mode' isn't loaded, "/foo:bla" tries to
6453 ;; connect to host "blabla" already if that host is unique. No idea
6454 ;; how to suppress. Maybe not an essential problem.
6455 ;; ** For "/ssh1-old:", `(file-name-all-completions "ssh1" "/")' is called
6456 ;; only. Likely due to word delimeter property of "-". Maybe we can remove
6457 ;; all the "*-old" methods? Or rename them to "*_old"?
6458 ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode'.
6459 ;; ** Handle quoted file names, starting with "/:". Problem is that
6460 ;; `file-name-non-special' calls later on `file-name-all-completions'
6461 ;; without ":". Hmm. Worth a bug report?
6462 ;; ** Acknowledge port numbers.
6463 ;; ** Extend `tramp-get-completion-su' for NIS and shadow passwords.
6464 ;; ** Unify `tramp-parse-{rhosts,shosts,hosts,passwd}'.
6465 ;; Code is nearly identical.
6466 ;; ** Decide whiche files to take for searching user/host names depending on
6467 ;; operating system (windows-nt) in `tramp-completion-function-alist'.
6468 ;; ** Enhance variables for debug.
6469 ;; ** Implement "/multi:" completion.
6470 ;; ** Add a learning mode for completion. Make results persistent.
6471
6472 ;; Functions for file-name-handler-alist:
6473 ;; diff-latest-backup-file -- in diff.el
6474 ;; dired-compress-file
6475 ;; dired-uncache -- this will be needed when we do insert-directory caching
6476 ;; file-name-as-directory -- use primitive?
6477 ;; file-name-directory -- use primitive?
6478 ;; file-name-nondirectory -- use primitive?
6479 ;; file-name-sans-versions -- use primitive?
6480 ;; file-newer-than-file-p
6481 ;; find-backup-file-name
6482 ;; get-file-buffer -- use primitive
6483 ;; load
6484 ;; unhandled-file-name-directory
6485 ;; vc-registered
6486
6487 ;;; tramp.el ends here