]> code.delx.au - gnu-emacs/blob - lisp/net/tramp.el
* net/tramp.el (tramp-default-file-modes) New defun. Replace all
[gnu-emacs] / lisp / net / tramp.el
1 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
2
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5
6 ;; (copyright statements below in code to be updated with the above notice)
7
8 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
9 ;; Michael Albinus <michael.albinus@gmx.de>
10 ;; Keywords: comm, processes
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; This package provides remote file editing, similar to ange-ftp.
30 ;; The difference is that ange-ftp uses FTP to transfer files between
31 ;; the local and the remote host, whereas tramp.el uses a combination
32 ;; of rsh and rcp or other work-alike programs, such as ssh/scp.
33 ;;
34 ;; For more detailed instructions, please see the info file.
35 ;;
36 ;; Notes:
37 ;; -----
38 ;;
39 ;; This package only works for Emacs 21.1 and higher, and for XEmacs 21.4
40 ;; and higher. For XEmacs 21, you need the package `fsf-compat' for
41 ;; the `with-timeout' macro.)
42 ;;
43 ;; Also see the todo list at the bottom of this file.
44 ;;
45 ;; The current version of Tramp can be retrieved from the following URL:
46 ;; http://ftp.gnu.org/gnu/tramp/
47 ;;
48 ;; There's a mailing list for this, as well. Its name is:
49 ;; tramp-devel@gnu.org
50 ;; You can use the Web to subscribe, under the following URL:
51 ;; http://lists.gnu.org/mailman/listinfo/tramp-devel
52 ;;
53 ;; For the adventurous, the current development sources are available
54 ;; via CVS. You can find instructions about this at the following URL:
55 ;; http://savannah.gnu.org/projects/tramp/
56 ;; Click on "CVS" in the navigation bar near the top.
57 ;;
58 ;; Don't forget to put on your asbestos longjohns, first!
59
60 ;;; Code:
61
62 ;; Since Emacs 23.1, loading messages have been disabled during
63 ;; autoload. However, loading Tramp takes a while, and it could
64 ;; happen while typing a filename in the minibuffer. Therefore, Tramp
65 ;; shall inform about.
66 (when (and load-in-progress (null (current-message)))
67 (message "Loading tramp..."))
68
69 ;; The Tramp version number and bug report address, as prepared by configure.
70 (require 'trampver)
71 (add-hook 'tramp-unload-hook
72 '(lambda ()
73 (when (featurep 'trampver)
74 (unload-feature 'trampver 'force))))
75
76 (require 'tramp-compat)
77 (add-hook 'tramp-unload-hook
78 '(lambda ()
79 (when (featurep 'tramp-compat)
80 (unload-feature 'tramp-compat 'force))))
81
82 (require 'format-spec) ; from Gnus 5.8, also in tar ball
83 ;; As long as password.el is not part of (X)Emacs, it shouldn't
84 ;; be mandatory
85 (if (featurep 'xemacs)
86 (load "password" 'noerror)
87 (or (require 'password-cache nil 'noerror)
88 (require 'password nil 'noerror))) ; from No Gnus, also in tar ball
89
90 (require 'shell)
91 (require 'advice)
92
93 (eval-and-compile
94 (if (featurep 'xemacs)
95 (load "auth-source" 'noerror)
96 (require 'auth-source nil 'noerror)))
97
98 ;; Requiring 'tramp-cache results in an endless loop.
99 (autoload 'tramp-get-file-property "tramp-cache")
100 (autoload 'tramp-set-file-property "tramp-cache")
101 (autoload 'tramp-flush-file-property "tramp-cache")
102 (autoload 'tramp-flush-directory-property "tramp-cache")
103 (autoload 'tramp-get-connection-property "tramp-cache")
104 (autoload 'tramp-set-connection-property "tramp-cache")
105 (autoload 'tramp-flush-connection-property "tramp-cache")
106 (autoload 'tramp-parse-connection-properties "tramp-cache")
107 (add-hook 'tramp-unload-hook
108 '(lambda ()
109 (when (featurep 'tramp-cache)
110 (unload-feature 'tramp-cache 'force))))
111
112 (autoload 'tramp-uuencode-region "tramp-uu"
113 "Implementation of `uuencode' in Lisp.")
114 (add-hook 'tramp-unload-hook
115 '(lambda ()
116 (when (featurep 'tramp-uu)
117 (unload-feature 'tramp-uu 'force))))
118
119 (autoload 'uudecode-decode-region "uudecode")
120
121 ;; The following Tramp packages must be loaded after tramp.el, because
122 ;; they require it as well.
123 (eval-after-load "tramp"
124 '(dolist
125 (feature
126 (list
127
128 ;; Tramp interactive commands.
129 'tramp-cmds
130
131 ;; Load foreign FTP method.
132 (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
133
134 ;; tramp-smb uses "smbclient" from Samba. Not available
135 ;; under Cygwin and Windows, because they don't offer
136 ;; "smbclient". And even not necessary there, because Emacs
137 ;; supports UNC file names like "//host/share/localname".
138 (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
139
140 ;; Load foreign FISH method.
141 'tramp-fish
142
143 ;; Load gateways. It needs `make-network-process' from Emacs 22.
144 (when (functionp 'make-network-process) 'tramp-gw)))
145
146 (when feature
147 (require feature)
148 (add-hook 'tramp-unload-hook
149 `(lambda ()
150 (when (featurep (quote ,feature))
151 (unload-feature (quote ,feature) 'force)))))))
152
153 ;;; User Customizable Internal Variables:
154
155 (defgroup tramp nil
156 "Edit remote files with a combination of rsh and rcp or similar programs."
157 :group 'files
158 :version "22.1")
159
160 ;; Maybe we need once a real Tramp mode, with key bindings etc.
161 ;;;###autoload
162 (defcustom tramp-mode t
163 "*Whether Tramp is enabled.
164 If it is set to nil, all remote file names are used literally."
165 :group 'tramp
166 :type 'boolean)
167
168 (defcustom tramp-verbose 3
169 "*Verbosity level for Tramp.
170 Any level x includes messages for all levels 1 .. x-1. The levels are
171
172 0 silent (no tramp messages at all)
173 1 errors
174 2 warnings
175 3 connection to remote hosts (default level)
176 4 activities
177 5 internal
178 6 sent and received strings
179 7 file caching
180 8 connection properties
181 10 traces (huge)."
182 :group 'tramp
183 :type 'integer)
184
185 ;; Emacs case
186 (eval-and-compile
187 (when (boundp 'backup-directory-alist)
188 (defcustom tramp-backup-directory-alist nil
189 "Alist of filename patterns and backup directory names.
190 Each element looks like (REGEXP . DIRECTORY), with the same meaning like
191 in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
192 is a local file name, the backup directory is prepended with Tramp file
193 name prefix \(method, user, host\) of file.
194
195 \(setq tramp-backup-directory-alist backup-directory-alist\)
196
197 gives the same backup policy for Tramp files on their hosts like the
198 policy for local files."
199 :group 'tramp
200 :type '(repeat (cons (regexp :tag "Regexp matching filename")
201 (directory :tag "Backup directory name"))))))
202
203 ;; XEmacs case. We cannot check for `bkup-backup-directory-info', because
204 ;; the package "backup-dir" might not be loaded yet.
205 (eval-and-compile
206 (when (featurep 'xemacs)
207 (defcustom tramp-bkup-backup-directory-info nil
208 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
209 It has the same meaning like `bkup-backup-directory-info' from package
210 `backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
211 file name, the backup directory is prepended with Tramp file name prefix
212 \(method, user, host\) of file.
213
214 \(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
215
216 gives the same backup policy for Tramp files on their hosts like the
217 policy for local files."
218 :type '(repeat
219 (list (regexp :tag "File regexp")
220 (string :tag "Backup Dir")
221 (set :inline t
222 (const ok-create)
223 (const full-path)
224 (const prepend-name)
225 (const search-upward))))
226 :group 'tramp)))
227
228 (defcustom tramp-auto-save-directory nil
229 "*Put auto-save files in this directory, if set.
230 The idea is to use a local directory so that auto-saving is faster."
231 :group 'tramp
232 :type '(choice (const nil) string))
233
234 (defcustom tramp-encoding-shell
235 (if (memq system-type '(windows-nt))
236 (getenv "COMSPEC")
237 "/bin/sh")
238 "*Use this program for encoding and decoding commands on the local host.
239 This shell is used to execute the encoding and decoding command on the
240 local host, so if you want to use `~' in those commands, you should
241 choose a shell here which groks tilde expansion. `/bin/sh' normally
242 does not understand tilde expansion.
243
244 For encoding and deocding, commands like the following are executed:
245
246 /bin/sh -c COMMAND < INPUT > OUTPUT
247
248 This variable can be used to change the \"/bin/sh\" part. See the
249 variable `tramp-encoding-command-switch' for the \"-c\" part.
250
251 Note that this variable is not used for remote commands. There are
252 mechanisms in tramp.el which automatically determine the right shell to
253 use for the remote host."
254 :group 'tramp
255 :type '(file :must-match t))
256
257 (defcustom tramp-encoding-command-switch
258 (if (string-match "cmd\\.exe" tramp-encoding-shell)
259 "/c"
260 "-c")
261 "*Use this switch together with `tramp-encoding-shell' for local commands.
262 See the variable `tramp-encoding-shell' for more information."
263 :group 'tramp
264 :type 'string)
265
266 (defcustom tramp-copy-size-limit 10240
267 "*The maximum file size where inline copying is preferred over an out-of-the-band copy."
268 :group 'tramp
269 :type 'integer)
270
271 (defcustom tramp-terminal-type "dumb"
272 "*Value of TERM environment variable for logging in to remote host.
273 Because Tramp wants to parse the output of the remote shell, it is easily
274 confused by ANSI color escape sequences and suchlike. Often, shell init
275 files conditionalize this setup based on the TERM environment variable."
276 :group 'tramp
277 :type 'string)
278
279 (defvar tramp-methods
280 `(("rcp" (tramp-login-program "rsh")
281 (tramp-login-args (("%h") ("-l" "%u")))
282 (tramp-remote-sh "/bin/sh")
283 (tramp-copy-program "rcp")
284 (tramp-copy-args (("-p" "%k")))
285 (tramp-copy-keep-date t)
286 (tramp-password-end-of-line nil))
287 ("scp" (tramp-login-program "ssh")
288 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
289 ("-e" "none")))
290 (tramp-remote-sh "/bin/sh")
291 (tramp-copy-program "scp")
292 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")))
293 (tramp-copy-keep-date t)
294 (tramp-password-end-of-line nil)
295 (tramp-gw-args (("-o"
296 "GlobalKnownHostsFile=/dev/null")
297 ("-o" "UserKnownHostsFile=/dev/null")
298 ("-o" "StrictHostKeyChecking=no")))
299 (tramp-default-port 22))
300 ("scp1" (tramp-login-program "ssh")
301 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
302 ("-1" "-e" "none")))
303 (tramp-remote-sh "/bin/sh")
304 (tramp-copy-program "scp")
305 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
306 ("-q")))
307 (tramp-copy-keep-date t)
308 (tramp-password-end-of-line nil)
309 (tramp-gw-args (("-o"
310 "GlobalKnownHostsFile=/dev/null")
311 ("-o" "UserKnownHostsFile=/dev/null")
312 ("-o" "StrictHostKeyChecking=no")))
313 (tramp-default-port 22))
314 ("scp2" (tramp-login-program "ssh")
315 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
316 ("-2" "-e" "none")))
317 (tramp-remote-sh "/bin/sh")
318 (tramp-copy-program "scp")
319 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
320 ("-q")))
321 (tramp-copy-keep-date t)
322 (tramp-password-end-of-line nil)
323 (tramp-gw-args (("-o"
324 "GlobalKnownHostsFile=/dev/null")
325 ("-o" "UserKnownHostsFile=/dev/null")
326 ("-o" "StrictHostKeyChecking=no")))
327 (tramp-default-port 22))
328 ("scp1_old"
329 (tramp-login-program "ssh1")
330 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
331 ("-e" "none")))
332 (tramp-remote-sh "/bin/sh")
333 (tramp-copy-program "scp1")
334 (tramp-copy-args (("-p" "%k")))
335 (tramp-copy-keep-date t)
336 (tramp-password-end-of-line nil))
337 ("scp2_old"
338 (tramp-login-program "ssh2")
339 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
340 ("-e" "none")))
341 (tramp-remote-sh "/bin/sh")
342 (tramp-copy-program "scp2")
343 (tramp-copy-args (("-p" "%k")))
344 (tramp-copy-keep-date t)
345 (tramp-password-end-of-line nil))
346 ("sftp" (tramp-login-program "ssh")
347 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
348 ("-e" "none")))
349 (tramp-remote-sh "/bin/sh")
350 (tramp-copy-program "sftp")
351 (tramp-copy-args nil)
352 (tramp-copy-keep-date nil)
353 (tramp-password-end-of-line nil))
354 ("rsync" (tramp-login-program "ssh")
355 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
356 ("-e" "none")))
357 (tramp-remote-sh "/bin/sh")
358 (tramp-copy-program "rsync")
359 (tramp-copy-args (("-e" "ssh") ("-t" "%k")))
360 (tramp-copy-keep-date t)
361 (tramp-password-end-of-line nil))
362 ("remcp" (tramp-login-program "remsh")
363 (tramp-login-args (("%h") ("-l" "%u")))
364 (tramp-remote-sh "/bin/sh")
365 (tramp-copy-program "rcp")
366 (tramp-copy-args (("-p" "%k")))
367 (tramp-copy-keep-date t)
368 (tramp-password-end-of-line nil))
369 ("rsh" (tramp-login-program "rsh")
370 (tramp-login-args (("%h") ("-l" "%u")))
371 (tramp-remote-sh "/bin/sh")
372 (tramp-copy-program nil)
373 (tramp-copy-args nil)
374 (tramp-copy-keep-date nil)
375 (tramp-password-end-of-line nil))
376 ("ssh" (tramp-login-program "ssh")
377 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
378 ("-e" "none")))
379 (tramp-remote-sh "/bin/sh")
380 (tramp-copy-program nil)
381 (tramp-copy-args nil)
382 (tramp-copy-keep-date nil)
383 (tramp-password-end-of-line nil)
384 (tramp-gw-args (("-o"
385 "GlobalKnownHostsFile=/dev/null")
386 ("-o" "UserKnownHostsFile=/dev/null")
387 ("-o" "StrictHostKeyChecking=no")))
388 (tramp-default-port 22))
389 ("ssh1" (tramp-login-program "ssh")
390 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
391 ("-1" "-e" "none")))
392 (tramp-remote-sh "/bin/sh")
393 (tramp-copy-program nil)
394 (tramp-copy-args nil)
395 (tramp-copy-keep-date nil)
396 (tramp-password-end-of-line nil)
397 (tramp-gw-args (("-o"
398 "GlobalKnownHostsFile=/dev/null")
399 ("-o" "UserKnownHostsFile=/dev/null")
400 ("-o" "StrictHostKeyChecking=no")))
401 (tramp-default-port 22))
402 ("ssh2" (tramp-login-program "ssh")
403 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
404 ("-2" "-e" "none")))
405 (tramp-remote-sh "/bin/sh")
406 (tramp-copy-program nil)
407 (tramp-copy-args nil)
408 (tramp-copy-keep-date nil)
409 (tramp-password-end-of-line nil)
410 (tramp-gw-args (("-o"
411 "GlobalKnownHostsFile=/dev/null")
412 ("-o" "UserKnownHostsFile=/dev/null")
413 ("-o" "StrictHostKeyChecking=no")))
414 (tramp-default-port 22))
415 ("ssh1_old"
416 (tramp-login-program "ssh1")
417 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
418 ("-e" "none")))
419 (tramp-remote-sh "/bin/sh")
420 (tramp-copy-program nil)
421 (tramp-copy-args nil)
422 (tramp-copy-keep-date nil)
423 (tramp-password-end-of-line nil))
424 ("ssh2_old"
425 (tramp-login-program "ssh2")
426 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
427 ("-e" "none")))
428 (tramp-remote-sh "/bin/sh")
429 (tramp-copy-program nil)
430 (tramp-copy-args nil)
431 (tramp-copy-keep-date nil)
432 (tramp-password-end-of-line nil))
433 ("remsh" (tramp-login-program "remsh")
434 (tramp-login-args (("%h") ("-l" "%u")))
435 (tramp-remote-sh "/bin/sh")
436 (tramp-copy-program nil)
437 (tramp-copy-args nil)
438 (tramp-copy-keep-date nil)
439 (tramp-password-end-of-line nil))
440 ("telnet"
441 (tramp-login-program "telnet")
442 (tramp-login-args (("%h") ("%p")))
443 (tramp-remote-sh "/bin/sh")
444 (tramp-copy-program nil)
445 (tramp-copy-args nil)
446 (tramp-copy-keep-date nil)
447 (tramp-password-end-of-line nil)
448 (tramp-default-port 23))
449 ("su" (tramp-login-program "su")
450 (tramp-login-args (("-") ("%u")))
451 (tramp-remote-sh "/bin/sh")
452 (tramp-copy-program nil)
453 (tramp-copy-args nil)
454 (tramp-copy-keep-date nil)
455 (tramp-password-end-of-line nil))
456 ("sudo" (tramp-login-program "sudo")
457 (tramp-login-args (("-u" "%u")
458 ("-s") ("-H") ("-p" "Password:")))
459 (tramp-remote-sh "/bin/sh")
460 (tramp-copy-program nil)
461 (tramp-copy-args nil)
462 (tramp-copy-keep-date nil)
463 (tramp-password-end-of-line nil))
464 ("scpc" (tramp-login-program "ssh")
465 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
466 ("-o" "ControlPath=%t.%%r@%%h:%%p")
467 ("-o" "ControlMaster=yes")
468 ("-e" "none")))
469 (tramp-remote-sh "/bin/sh")
470 (tramp-copy-program "scp")
471 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
472 ("-o" "ControlPath=%t.%%r@%%h:%%p")
473 ("-o" "ControlMaster=auto")))
474 (tramp-copy-keep-date t)
475 (tramp-password-end-of-line nil)
476 (tramp-gw-args (("-o"
477 "GlobalKnownHostsFile=/dev/null")
478 ("-o" "UserKnownHostsFile=/dev/null")
479 ("-o" "StrictHostKeyChecking=no")))
480 (tramp-default-port 22))
481 ("scpx" (tramp-login-program "ssh")
482 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
483 ("-e" "none" "-t" "-t" "/bin/sh")))
484 (tramp-remote-sh "/bin/sh")
485 (tramp-copy-program "scp")
486 (tramp-copy-args (("-p" "%k")))
487 (tramp-copy-keep-date t)
488 (tramp-password-end-of-line nil)
489 (tramp-gw-args (("-o"
490 "GlobalKnownHostsFile=/dev/null")
491 ("-o" "UserKnownHostsFile=/dev/null")
492 ("-o" "StrictHostKeyChecking=no")))
493 (tramp-default-port 22))
494 ("sshx" (tramp-login-program "ssh")
495 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
496 ("-e" "none" "-t" "-t" "/bin/sh")))
497 (tramp-remote-sh "/bin/sh")
498 (tramp-copy-program nil)
499 (tramp-copy-args nil)
500 (tramp-copy-keep-date nil)
501 (tramp-password-end-of-line nil)
502 (tramp-gw-args (("-o"
503 "GlobalKnownHostsFile=/dev/null")
504 ("-o" "UserKnownHostsFile=/dev/null")
505 ("-o" "StrictHostKeyChecking=no")))
506 (tramp-default-port 22))
507 ("krlogin"
508 (tramp-login-program "krlogin")
509 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
510 (tramp-remote-sh "/bin/sh")
511 (tramp-copy-program nil)
512 (tramp-copy-args nil)
513 (tramp-copy-keep-date nil)
514 (tramp-password-end-of-line nil))
515 ("plink" (tramp-login-program "plink")
516 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
517 ("-ssh")))
518 (tramp-remote-sh "/bin/sh")
519 (tramp-copy-program nil)
520 (tramp-copy-args nil)
521 (tramp-copy-keep-date nil)
522 (tramp-password-end-of-line "xy") ;see docstring for "xy"
523 (tramp-default-port 22))
524 ("plink1"
525 (tramp-login-program "plink")
526 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
527 ("-1" "-ssh")))
528 (tramp-remote-sh "/bin/sh")
529 (tramp-copy-program nil)
530 (tramp-copy-args nil)
531 (tramp-copy-keep-date nil)
532 (tramp-password-end-of-line "xy") ;see docstring for "xy"
533 (tramp-default-port 22))
534 ("plinkx"
535 (tramp-login-program "plink")
536 ;; ("%h") must be a single element, see
537 ;; `tramp-compute-multi-hops'.
538 (tramp-login-args (("-load") ("%h") ("-t")
539 (,(format
540 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '"
541 tramp-terminal-type))
542 ("/bin/sh")))
543 (tramp-remote-sh "/bin/sh")
544 (tramp-copy-program nil)
545 (tramp-copy-args nil)
546 (tramp-copy-keep-date nil)
547 (tramp-password-end-of-line nil))
548 ("pscp" (tramp-login-program "plink")
549 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
550 ("-ssh")))
551 (tramp-remote-sh "/bin/sh")
552 (tramp-copy-program "pscp")
553 (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
554 (tramp-copy-keep-date t)
555 (tramp-password-end-of-line "xy") ;see docstring for "xy"
556 (tramp-default-port 22))
557 ("psftp" (tramp-login-program "plink")
558 (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
559 ("-ssh")))
560 (tramp-remote-sh "/bin/sh")
561 (tramp-copy-program "pscp")
562 (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
563 (tramp-copy-keep-date t)
564 (tramp-password-end-of-line "xy")) ;see docstring for "xy"
565 ("fcp" (tramp-login-program "fsh")
566 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
567 (tramp-remote-sh "/bin/sh -i")
568 (tramp-copy-program "fcp")
569 (tramp-copy-args (("-p" "%k")))
570 (tramp-copy-keep-date t)
571 (tramp-password-end-of-line nil)))
572 "*Alist of methods for remote files.
573 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
574 Each NAME stands for a remote access method. Each PARAM is a
575 pair of the form (KEY VALUE). The following KEYs are defined:
576 * `tramp-remote-sh'
577 This specifies the Bourne shell to use on the remote host. This
578 MUST be a Bourne-like shell. It is normally not necessary to set
579 this to any value other than \"/bin/sh\": Tramp wants to use a shell
580 which groks tilde expansion, but it can search for it. Also note
581 that \"/bin/sh\" exists on all Unixen, this might not be true for
582 the value that you decide to use. You Have Been Warned.
583 * `tramp-login-program'
584 This specifies the name of the program to use for logging in to the
585 remote host. This may be the name of rsh or a workalike program,
586 or the name of telnet or a workalike, or the name of su or a workalike.
587 * `tramp-login-args'
588 This specifies the list of arguments to pass to the above
589 mentioned program. Please note that this is a list of list of arguments,
590 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
591 here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
592 There are some patterns: \"%h\" in this list is replaced by the host
593 name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
594 port number, and \"%%\" can be used to obtain a literal percent character.
595 If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
596 expansion (i.e. no host or no user specified), this list is not used as
597 argument. By this, arguments like (\"-l\" \"%u\") are optional.
598 \"%t\" is replaced by the temporary file name produced with
599 `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
600 parameter of a program, if exists.
601 * `tramp-copy-program'
602 This specifies the name of the program to use for remotely copying
603 the file; this might be the absolute filename of rcp or the name of
604 a workalike program.
605 * `tramp-copy-args'
606 This specifies the list of parameters to pass to the above mentioned
607 program, the hints for `tramp-login-args' also apply here.
608 * `tramp-copy-keep-date'
609 This specifies whether the copying program when the preserves the
610 timestamp of the original file.
611 * `tramp-default-port'
612 The default port of a method is needed in case of gateway connections.
613 Additionally, it is used as indication which method is prepared for
614 passing gateways.
615 * `tramp-gw-args'
616 As the attribute name says, additional arguments are specified here
617 when a method is applied via a gateway.
618 * `tramp-password-end-of-line'
619 This specifies the string to use for terminating the line after
620 submitting the password. If this method parameter is nil, then the
621 value of the normal variable `tramp-default-password-end-of-line'
622 is used. This parameter is necessary because the \"plink\" program
623 requires any two characters after sending the password. These do
624 not have to be newline or carriage return characters. Other login
625 programs are happy with just one character, the newline character.
626 We use \"xy\" as the value for methods using \"plink\".
627
628 What does all this mean? Well, you should specify `tramp-login-program'
629 for all methods; this program is used to log in to the remote site. Then,
630 there are two ways to actually transfer the files between the local and the
631 remote side. One way is using an additional rcp-like program. If you want
632 to do this, set `tramp-copy-program' in the method.
633
634 Another possibility for file transfer is inline transfer, i.e. the
635 file is passed through the same buffer used by `tramp-login-program'. In
636 this case, the file contents need to be protected since the
637 `tramp-login-program' might use escape codes or the connection might not
638 be eight-bit clean. Therefore, file contents are encoded for transit.
639 See the variables `tramp-local-coding-commands' and
640 `tramp-remote-coding-commands' for details.
641
642 So, to summarize: if the method is an out-of-band method, then you
643 must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
644 inline method, then these two parameters should be nil. Methods which
645 are fit for gateways must have `tramp-default-port' at least.
646
647 Notes:
648
649 When using `su' or `sudo' the phrase `open connection to a remote
650 host' sounds strange, but it is used nevertheless, for consistency.
651 No connection is opened to a remote host, but `su' or `sudo' is
652 started on the local host. You should specify a remote host
653 `localhost' or the name of the local host. Another host name is
654 useful only in combination with `tramp-default-proxies-alist'.")
655
656 (defcustom tramp-default-method
657 ;; An external copy method seems to be preferred, because it is much
658 ;; more performant for large files, and it hasn't too serious delays
659 ;; for small files. But it must be ensured that there aren't
660 ;; permanent password queries. Either a password agent like
661 ;; "ssh-agent" or "Pageant" shall run, or the optional password.el
662 ;; package shall be active for password caching. "scpc" would be
663 ;; another good choice because of the "ControlMaster" option, but
664 ;; this is a more modern alternative in OpenSSH 4, which cannot be
665 ;; taken as default.
666 (cond
667 ;; PuTTY is installed.
668 ((executable-find "pscp")
669 (if (or (fboundp 'password-read)
670 ;; Pageant is running.
671 (and (fboundp 'w32-window-exists-p)
672 (funcall (symbol-function 'w32-window-exists-p)
673 "Pageant" "Pageant")))
674 "pscp"
675 "plink"))
676 ;; There is an ssh installation.
677 ((executable-find "scp")
678 (if (or (fboundp 'password-read)
679 ;; ssh-agent is running.
680 (getenv "SSH_AUTH_SOCK")
681 (getenv "SSH_AGENT_PID"))
682 "scp"
683 "ssh"))
684 ;; Fallback.
685 (t "ftp"))
686 "*Default method to use for transferring files.
687 See `tramp-methods' for possibilities.
688 Also see `tramp-default-method-alist'."
689 :group 'tramp
690 :type 'string)
691
692 (defcustom tramp-default-method-alist
693 '(("\\`localhost\\'" "\\`root\\'" "su"))
694 "*Default method to use for specific host/user pairs.
695 This is an alist of items (HOST USER METHOD). The first matching item
696 specifies the method to use for a file name which does not specify a
697 method. HOST and USER are regular expressions or nil, which is
698 interpreted as a regular expression which always matches. If no entry
699 matches, the variable `tramp-default-method' takes effect.
700
701 If the file name does not specify the user, lookup is done using the
702 empty string for the user name.
703
704 See `tramp-methods' for a list of possibilities for METHOD."
705 :group 'tramp
706 :type '(repeat (list (regexp :tag "Host regexp")
707 (regexp :tag "User regexp")
708 (string :tag "Method"))))
709
710 (defcustom tramp-default-user
711 nil
712 "*Default user to use for transferring files.
713 It is nil by default; otherwise settings in configuration files like
714 \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
715
716 This variable is regarded as obsolete, and will be removed soon."
717 :group 'tramp
718 :type '(choice (const nil) string))
719
720 (defcustom tramp-default-user-alist
721 `(("\\`su\\(do\\)?\\'" nil "root")
722 ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
723 nil ,(user-login-name)))
724 "*Default user to use for specific method/host pairs.
725 This is an alist of items (METHOD HOST USER). The first matching item
726 specifies the user to use for a file name which does not specify a
727 user. METHOD and USER are regular expressions or nil, which is
728 interpreted as a regular expression which always matches. If no entry
729 matches, the variable `tramp-default-user' takes effect.
730
731 If the file name does not specify the method, lookup is done using the
732 empty string for the method name."
733 :group 'tramp
734 :type '(repeat (list (regexp :tag "Method regexp")
735 (regexp :tag "Host regexp")
736 (string :tag "User"))))
737
738 (defcustom tramp-default-host
739 (system-name)
740 "*Default host to use for transferring files.
741 Useful for su and sudo methods mostly."
742 :group 'tramp
743 :type 'string)
744
745 (defcustom tramp-default-proxies-alist nil
746 "*Route to be followed for specific host/user pairs.
747 This is an alist of items (HOST USER PROXY). The first matching
748 item specifies the proxy to be passed for a file name located on
749 a remote target matching USER@HOST. HOST and USER are regular
750 expressions or nil, which is interpreted as a regular expression
751 which always matches. PROXY must be a Tramp filename without a
752 localname part. Method and user name on PROXY are optional,
753 which is interpreted with the default values. PROXY can contain
754 the patterns %h and %u, which are replaced by the strings
755 matching HOST or USER, respectively."
756 :group 'tramp
757 :type '(repeat (list (regexp :tag "Host regexp")
758 (regexp :tag "User regexp")
759 (string :tag "Proxy remote name"))))
760
761 (defconst tramp-local-host-regexp
762 (concat
763 "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$")
764 "*Host names which are regarded as local host.")
765
766 (defconst tramp-completion-function-alist-rsh
767 '((tramp-parse-rhosts "/etc/hosts.equiv")
768 (tramp-parse-rhosts "~/.rhosts"))
769 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
770
771 (defconst tramp-completion-function-alist-ssh
772 '((tramp-parse-rhosts "/etc/hosts.equiv")
773 (tramp-parse-rhosts "/etc/shosts.equiv")
774 (tramp-parse-shosts "/etc/ssh_known_hosts")
775 (tramp-parse-sconfig "/etc/ssh_config")
776 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
777 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
778 (tramp-parse-rhosts "~/.rhosts")
779 (tramp-parse-rhosts "~/.shosts")
780 (tramp-parse-shosts "~/.ssh/known_hosts")
781 (tramp-parse-sconfig "~/.ssh/config")
782 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
783 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
784 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
785
786 (defconst tramp-completion-function-alist-telnet
787 '((tramp-parse-hosts "/etc/hosts"))
788 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
789
790 (defconst tramp-completion-function-alist-su
791 '((tramp-parse-passwd "/etc/passwd"))
792 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
793
794 (defconst tramp-completion-function-alist-putty
795 '((tramp-parse-putty
796 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
797 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
798
799 (defvar tramp-completion-function-alist nil
800 "*Alist of methods for remote files.
801 This is a list of entries of the form (NAME PAIR1 PAIR2 ...).
802 Each NAME stands for a remote access method. Each PAIR is of the form
803 \(FUNCTION FILE). FUNCTION is responsible to extract user names and host
804 names from FILE for completion. The following predefined FUNCTIONs exists:
805
806 * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
807 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
808 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
809 * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
810 * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
811 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
812 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
813 * `tramp-parse-netrc' for \"~/.netrc\" like files.
814 * `tramp-parse-putty' for PuTTY registry keys.
815
816 FUNCTION can also be a customer defined function. For more details see
817 the info pages.")
818
819 (eval-after-load "tramp"
820 '(progn
821 (tramp-set-completion-function
822 "rcp" tramp-completion-function-alist-rsh)
823 (tramp-set-completion-function
824 "scp" tramp-completion-function-alist-ssh)
825 (tramp-set-completion-function
826 "scp1" tramp-completion-function-alist-ssh)
827 (tramp-set-completion-function
828 "scp2" tramp-completion-function-alist-ssh)
829 (tramp-set-completion-function
830 "scp1_old" tramp-completion-function-alist-ssh)
831 (tramp-set-completion-function
832 "scp2_old" tramp-completion-function-alist-ssh)
833 (tramp-set-completion-function
834 "rsync" tramp-completion-function-alist-rsh)
835 (tramp-set-completion-function
836 "remcp" tramp-completion-function-alist-rsh)
837 (tramp-set-completion-function
838 "rsh" tramp-completion-function-alist-rsh)
839 (tramp-set-completion-function
840 "ssh" tramp-completion-function-alist-ssh)
841 (tramp-set-completion-function
842 "ssh1" tramp-completion-function-alist-ssh)
843 (tramp-set-completion-function
844 "ssh2" tramp-completion-function-alist-ssh)
845 (tramp-set-completion-function
846 "ssh1_old" tramp-completion-function-alist-ssh)
847 (tramp-set-completion-function
848 "ssh2_old" tramp-completion-function-alist-ssh)
849 (tramp-set-completion-function
850 "remsh" tramp-completion-function-alist-rsh)
851 (tramp-set-completion-function
852 "telnet" tramp-completion-function-alist-telnet)
853 (tramp-set-completion-function
854 "su" tramp-completion-function-alist-su)
855 (tramp-set-completion-function
856 "sudo" tramp-completion-function-alist-su)
857 (tramp-set-completion-function
858 "scpx" tramp-completion-function-alist-ssh)
859 (tramp-set-completion-function
860 "sshx" tramp-completion-function-alist-ssh)
861 (tramp-set-completion-function
862 "krlogin" tramp-completion-function-alist-rsh)
863 (tramp-set-completion-function
864 "plink" tramp-completion-function-alist-ssh)
865 (tramp-set-completion-function
866 "plink1" tramp-completion-function-alist-ssh)
867 (tramp-set-completion-function
868 "plinkx" tramp-completion-function-alist-putty)
869 (tramp-set-completion-function
870 "pscp" tramp-completion-function-alist-ssh)
871 (tramp-set-completion-function
872 "fcp" tramp-completion-function-alist-ssh)))
873
874 (defconst tramp-echo-mark-marker "_echo"
875 "String marker to surround echoed commands.")
876
877 (defconst tramp-echo-mark "_echo\b\b\b\b\b"
878 "String mark to be transmitted around shell commands.
879 Used to separate their echo from the output they produce. This
880 will only be used if we cannot disable remote echo via stty.
881 This string must have no effect on the remote shell except for
882 producing some echo which can later be detected by
883 `tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
884 followed by an equal number of backspaces to erase them will
885 usually suffice.")
886
887 (defconst tramp-echoed-echo-mark-regexp "_echo\\(\b\\( \b\\)?\\)\\{5\\}"
888 "Regexp which matches `tramp-echo-mark' as it gets echoed by
889 the remote shell.")
890
891 (defcustom tramp-rsh-end-of-line "\n"
892 "*String used for end of line in rsh connections.
893 I don't think this ever needs to be changed, so please tell me about it
894 if you need to change this.
895 Also see the method parameter `tramp-password-end-of-line' and the normal
896 variable `tramp-default-password-end-of-line'."
897 :group 'tramp
898 :type 'string)
899
900 (defcustom tramp-default-password-end-of-line
901 tramp-rsh-end-of-line
902 "*String used for end of line after sending a password.
903 This variable provides the default value for the method parameter
904 `tramp-password-end-of-line', see `tramp-methods' for more details.
905
906 It seems that people using plink under Windows need to send
907 \"\\r\\n\" (carriage-return, then newline) after a password, but just
908 \"\\n\" after all other lines. This variable can be used for the
909 password, see `tramp-rsh-end-of-line' for the other cases.
910
911 The default value is to use the same value as `tramp-rsh-end-of-line'."
912 :group 'tramp
913 :type 'string)
914
915 ;; "getconf PATH" yields:
916 ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
917 ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
918 ;; GNU/Linux (Debian, Suse): /bin:/usr/bin
919 ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
920 (defcustom tramp-remote-path
921 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
922 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
923 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
924 "*List of directories to search for executables on remote host.
925 For every remote host, this variable will be set buffer local,
926 keeping the list of existing directories on that host.
927
928 You can use `~' in this list, but when searching for a shell which groks
929 tilde expansion, all directory names starting with `~' will be ignored.
930
931 `Default Directories' represent the list of directories given by
932 the command \"getconf PATH\". It is recommended to use this
933 entry on top of this list, because these are the default
934 directories for POSIX compatible commands."
935 :group 'tramp
936 :type '(repeat (choice
937 (const :tag "Default Directories" tramp-default-remote-path)
938 (string :tag "Directory"))))
939
940 (defcustom tramp-remote-process-environment
941 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
942 ,(concat "TERM=" tramp-terminal-type)
943 "EMACS=t" ;; Deprecated.
944 ,(format "INSIDE_EMACS=%s,tramp:%s" emacs-version tramp-version)
945 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
946 "autocorrect=" "correct=")
947
948 "*List of environment variables to be set on the remote host.
949
950 Each element should be a string of the form ENVVARNAME=VALUE. An
951 entry ENVVARNAME= diables the corresponding environment variable,
952 which might have been set in the init files like ~/.profile.
953
954 Special handling is applied to the PATH environment, which should
955 not be set here. Instead of, it should be set via `tramp-remote-path'."
956 :group 'tramp
957 :type '(repeat string))
958
959 (defcustom tramp-login-prompt-regexp
960 ".*ogin\\( .*\\)?: *"
961 "*Regexp matching login-like prompts.
962 The regexp should match at end of buffer.
963
964 Sometimes the prompt is reported to look like \"login as:\"."
965 :group 'tramp
966 :type 'regexp)
967
968 (defcustom tramp-shell-prompt-pattern
969 "^[^#$%>\n]*[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*"
970 "Regexp to match prompts from remote shell.
971 Normally, Tramp expects you to configure `shell-prompt-pattern'
972 correctly, but sometimes it happens that you are connecting to a
973 remote host which sends a different kind of shell prompt. Therefore,
974 Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
975 and also things matched by this variable. The default value of this
976 variable is similar to the default value of `shell-prompt-pattern',
977 which should work well in many cases."
978 :group 'tramp
979 :type 'regexp)
980
981 (defcustom tramp-password-prompt-regexp
982 "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
983 "*Regexp matching password-like prompts.
984 The regexp should match at end of buffer.
985
986 The `sudo' program appears to insert a `^@' character into the prompt."
987 :group 'tramp
988 :type 'regexp)
989
990 (defcustom tramp-wrong-passwd-regexp
991 (concat "^.*"
992 ;; These strings should be on the last line
993 (regexp-opt '("Permission denied"
994 "Login incorrect"
995 "Login Incorrect"
996 "Connection refused"
997 "Connection closed"
998 "Sorry, try again."
999 "Name or service not known"
1000 "Host key verification failed."
1001 "No supported authentication methods left to try!"
1002 "Tramp connection closed") t)
1003 ".*"
1004 "\\|"
1005 "^.*\\("
1006 ;; Here comes a list of regexes, separated by \\|
1007 "Received signal [0-9]+"
1008 "\\).*")
1009 "*Regexp matching a `login failed' message.
1010 The regexp should match at end of buffer."
1011 :group 'tramp
1012 :type 'regexp)
1013
1014 (defcustom tramp-yesno-prompt-regexp
1015 (concat
1016 (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
1017 "\\s-*")
1018 "Regular expression matching all yes/no queries which need to be confirmed.
1019 The confirmation should be done with yes or no.
1020 The regexp should match at end of buffer.
1021 See also `tramp-yn-prompt-regexp'."
1022 :group 'tramp
1023 :type 'regexp)
1024
1025 (defcustom tramp-yn-prompt-regexp
1026 (concat
1027 (regexp-opt '("Store key in cache? (y/n)"
1028 "Update cached key? (y/n, Return cancels connection)") t)
1029 "\\s-*")
1030 "Regular expression matching all y/n queries which need to be confirmed.
1031 The confirmation should be done with y or n.
1032 The regexp should match at end of buffer.
1033 See also `tramp-yesno-prompt-regexp'."
1034 :group 'tramp
1035 :type 'regexp)
1036
1037 (defcustom tramp-terminal-prompt-regexp
1038 (concat "\\("
1039 "TERM = (.*)"
1040 "\\|"
1041 "Terminal type\\? \\[.*\\]"
1042 "\\)\\s-*")
1043 "Regular expression matching all terminal setting prompts.
1044 The regexp should match at end of buffer.
1045 The answer will be provided by `tramp-action-terminal', which see."
1046 :group 'tramp
1047 :type 'regexp)
1048
1049 (defcustom tramp-operation-not-permitted-regexp
1050 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
1051 (regexp-opt '("Operation not permitted") t))
1052 "Regular expression matching keep-date problems in (s)cp operations.
1053 Copying has been performed successfully already, so this message can
1054 be ignored safely."
1055 :group 'tramp
1056 :type 'regexp)
1057
1058 (defcustom tramp-copy-failed-regexp
1059 (concat "\\(.+: "
1060 (regexp-opt '("Permission denied"
1061 "not a regular file"
1062 "is a directory"
1063 "No such file or directory") t)
1064 "\\)\\s-*")
1065 "Regular expression matching copy problems in (s)cp operations."
1066 :group 'tramp
1067 :type 'regexp)
1068
1069 (defcustom tramp-process-alive-regexp
1070 ""
1071 "Regular expression indicating a process has finished.
1072 In fact this expression is empty by intention, it will be used only to
1073 check regularly the status of the associated process.
1074 The answer will be provided by `tramp-action-process-alive',
1075 `tramp-action-out-of-band', which see."
1076 :group 'tramp
1077 :type 'regexp)
1078
1079 (defcustom tramp-temp-name-prefix "tramp."
1080 "*Prefix to use for temporary files.
1081 If this is a relative file name (such as \"tramp.\"), it is considered
1082 relative to the directory name returned by the function
1083 `tramp-compat-temporary-file-directory' (which see). It may also be an
1084 absolute file name; don't forget to include a prefix for the filename
1085 part, though."
1086 :group 'tramp
1087 :type 'string)
1088
1089 (defconst tramp-temp-buffer-name " *tramp temp*"
1090 "Buffer name for a temporary buffer.
1091 It shall be used in combination with `generate-new-buffer-name'.")
1092
1093 (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
1094 "*Alist specifying extra arguments to pass to the remote shell.
1095 Entries are (REGEXP . ARGS) where REGEXP is a regular expression
1096 matching the shell file name and ARGS is a string specifying the
1097 arguments.
1098
1099 This variable is only used when Tramp needs to start up another shell
1100 for tilde expansion. The extra arguments should typically prevent the
1101 shell from reading its init file."
1102 :group 'tramp
1103 ;; This might be the wrong way to test whether the widget type
1104 ;; `alist' is available. Who knows the right way to test it?
1105 :type (if (get 'alist 'widget-type)
1106 '(alist :key-type string :value-type string)
1107 '(repeat (cons string string))))
1108
1109 ;; XEmacs is distributed with few Lisp packages. Further packages are
1110 ;; installed using EFS. If we use a unified filename format, then
1111 ;; Tramp is required in addition to EFS. (But why can't Tramp just
1112 ;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
1113 ;; just like before.) Another reason for using a separate filename
1114 ;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
1115 ;; Tramp only knows how to deal with `file-name-handler-alist', not
1116 ;; the other places.
1117
1118 ;; Currently, we have the choice between 'ftp, 'sep, and 'url.
1119 ;;;###autoload
1120 (defcustom tramp-syntax
1121 (if (featurep 'xemacs) 'sep 'ftp)
1122 "Tramp filename syntax to be used.
1123
1124 It can have the following values:
1125
1126 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
1127 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
1128 'url -- URL-like syntax."
1129 :group 'tramp
1130 :type (if (featurep 'xemacs)
1131 '(choice (const :tag "EFS" ftp)
1132 (const :tag "XEmacs" sep)
1133 (const :tag "URL" url))
1134 '(choice (const :tag "Ange-FTP" ftp)
1135 (const :tag "URL" url))))
1136
1137 (defconst tramp-prefix-format
1138 (cond ((equal tramp-syntax 'ftp) "/")
1139 ((equal tramp-syntax 'sep) "/[")
1140 ((equal tramp-syntax 'url) "/")
1141 (t (error "Wrong `tramp-syntax' defined")))
1142 "*String matching the very beginning of Tramp file names.
1143 Used in `tramp-make-tramp-file-name'.")
1144
1145 (defconst tramp-prefix-regexp
1146 (concat "^" (regexp-quote tramp-prefix-format))
1147 "*Regexp matching the very beginning of Tramp file names.
1148 Should always start with \"^\". Derived from `tramp-prefix-format'.")
1149
1150 (defconst tramp-method-regexp
1151 "[a-zA-Z_0-9-]+"
1152 "*Regexp matching methods identifiers.")
1153
1154 (defconst tramp-postfix-method-format
1155 (cond ((equal tramp-syntax 'ftp) ":")
1156 ((equal tramp-syntax 'sep) "/")
1157 ((equal tramp-syntax 'url) "://")
1158 (t (error "Wrong `tramp-syntax' defined")))
1159 "*String matching delimeter between method and user or host names.
1160 Used in `tramp-make-tramp-file-name'.")
1161
1162 (defconst tramp-postfix-method-regexp
1163 (regexp-quote tramp-postfix-method-format)
1164 "*Regexp matching delimeter between method and user or host names.
1165 Derived from `tramp-postfix-method-format'.")
1166
1167 (defconst tramp-user-regexp
1168 "[^:/ \t]+"
1169 "*Regexp matching user names.")
1170
1171 (defconst tramp-prefix-domain-format "%"
1172 "*String matching delimeter between user and domain names.")
1173
1174 (defconst tramp-prefix-domain-regexp
1175 (regexp-quote tramp-prefix-domain-format)
1176 "*Regexp matching delimeter between user and domain names.
1177 Derived from `tramp-prefix-domain-format'.")
1178
1179 (defconst tramp-domain-regexp
1180 "[a-zA-Z0-9]+"
1181 "*Regexp matching domain names.")
1182
1183 (defconst tramp-user-with-domain-regexp
1184 (concat "\\(" tramp-user-regexp "\\)"
1185 tramp-prefix-domain-regexp
1186 "\\(" tramp-domain-regexp "\\)")
1187 "*Regexp matching user names with domain names.")
1188
1189 (defconst tramp-postfix-user-format
1190 "@"
1191 "*String matching delimeter between user and host names.
1192 Used in `tramp-make-tramp-file-name'.")
1193
1194 (defconst tramp-postfix-user-regexp
1195 (regexp-quote tramp-postfix-user-format)
1196 "*Regexp matching delimeter between user and host names.
1197 Derived from `tramp-postfix-user-format'.")
1198
1199 (defconst tramp-host-regexp
1200 "[a-zA-Z0-9_.-]+"
1201 "*Regexp matching host names.")
1202
1203 (defconst tramp-prefix-ipv6-format
1204 (cond ((equal tramp-syntax 'ftp) "[")
1205 ((equal tramp-syntax 'sep) "")
1206 ((equal tramp-syntax 'url) "[")
1207 (t (error "Wrong `tramp-syntax' defined")))
1208 "*String matching left hand side of IPv6 addresses.
1209 Used in `tramp-make-tramp-file-name'.")
1210
1211 (defconst tramp-prefix-ipv6-regexp
1212 (regexp-quote tramp-prefix-ipv6-format)
1213 "*Regexp matching left hand side of IPv6 addresses.
1214 Derived from `tramp-prefix-ipv6-format'.")
1215
1216 ;; The following regexp is a bit sloppy. But it shall serve our
1217 ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
1218 ;; "::ffff:192.168.0.1".
1219 (defconst tramp-ipv6-regexp
1220 "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
1221 "*Regexp matching IPv6 addresses.")
1222
1223 (defconst tramp-postfix-ipv6-format
1224 (cond ((equal tramp-syntax 'ftp) "]")
1225 ((equal tramp-syntax 'sep) "")
1226 ((equal tramp-syntax 'url) "]")
1227 (t (error "Wrong `tramp-syntax' defined")))
1228 "*String matching right hand side of IPv6 addresses.
1229 Used in `tramp-make-tramp-file-name'.")
1230
1231 (defconst tramp-postfix-ipv6-regexp
1232 (regexp-quote tramp-postfix-ipv6-format)
1233 "*Regexp matching right hand side of IPv6 addresses.
1234 Derived from `tramp-postfix-ipv6-format'.")
1235
1236 (defconst tramp-prefix-port-format
1237 (cond ((equal tramp-syntax 'ftp) "#")
1238 ((equal tramp-syntax 'sep) "#")
1239 ((equal tramp-syntax 'url) ":")
1240 (t (error "Wrong `tramp-syntax' defined")))
1241 "*String matching delimeter between host names and port numbers.")
1242
1243 (defconst tramp-prefix-port-regexp
1244 (regexp-quote tramp-prefix-port-format)
1245 "*Regexp matching delimeter between host names and port numbers.
1246 Derived from `tramp-prefix-port-format'.")
1247
1248 (defconst tramp-port-regexp
1249 "[0-9]+"
1250 "*Regexp matching port numbers.")
1251
1252 (defconst tramp-host-with-port-regexp
1253 (concat "\\(" tramp-host-regexp "\\)"
1254 tramp-prefix-port-regexp
1255 "\\(" tramp-port-regexp "\\)")
1256 "*Regexp matching host names with port numbers.")
1257
1258 (defconst tramp-postfix-host-format
1259 (cond ((equal tramp-syntax 'ftp) ":")
1260 ((equal tramp-syntax 'sep) "]")
1261 ((equal tramp-syntax 'url) "")
1262 (t (error "Wrong `tramp-syntax' defined")))
1263 "*String matching delimeter between host names and localnames.
1264 Used in `tramp-make-tramp-file-name'.")
1265
1266 (defconst tramp-postfix-host-regexp
1267 (regexp-quote tramp-postfix-host-format)
1268 "*Regexp matching delimeter between host names and localnames.
1269 Derived from `tramp-postfix-host-format'.")
1270
1271 (defconst tramp-localname-regexp
1272 ".*$"
1273 "*Regexp matching localnames.")
1274
1275 ;; File name format.
1276
1277 (defconst tramp-file-name-structure
1278 (list
1279 (concat
1280 tramp-prefix-regexp
1281 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
1282 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
1283 "\\(" "\\(" tramp-host-regexp
1284 "\\|"
1285 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
1286 tramp-postfix-ipv6-regexp "\\)"
1287 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
1288 tramp-postfix-host-regexp
1289 "\\(" tramp-localname-regexp "\\)")
1290 2 4 5 8)
1291
1292 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
1293 the Tramp file name structure.
1294
1295 The first element REGEXP is a regular expression matching a Tramp file
1296 name. The regex should contain parentheses around the method name,
1297 the user name, the host name, and the file name parts.
1298
1299 The second element METHOD is a number, saying which pair of
1300 parentheses matches the method name. The third element USER is
1301 similar, but for the user name. The fourth element HOST is similar,
1302 but for the host name. The fifth element FILE is for the file name.
1303 These numbers are passed directly to `match-string', which see. That
1304 means the opening parentheses are counted to identify the pair.
1305
1306 See also `tramp-file-name-regexp'.")
1307
1308 ;;;###autoload
1309 (defconst tramp-file-name-regexp-unified
1310 "\\`/\\([^[/:]+\\|[^/]+]\\):"
1311 "Value for `tramp-file-name-regexp' for unified remoting.
1312 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1313 Tramp. See `tramp-file-name-structure' for more explanations.")
1314
1315 ;;;###autoload
1316 (defconst tramp-file-name-regexp-separate
1317 "\\`/\\[.*\\]"
1318 "Value for `tramp-file-name-regexp' for separate remoting.
1319 XEmacs uses a separate filename syntax for Tramp and EFS.
1320 See `tramp-file-name-structure' for more explanations.")
1321
1322 ;;;###autoload
1323 (defconst tramp-file-name-regexp-url
1324 "\\`/[^/:]+://"
1325 "Value for `tramp-file-name-regexp' for URL-like remoting.
1326 See `tramp-file-name-structure' for more explanations.")
1327
1328 ;;;###autoload
1329 (defconst tramp-file-name-regexp
1330 (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
1331 ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
1332 ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
1333 (t (error "Wrong `tramp-syntax' defined")))
1334 "*Regular expression matching file names handled by Tramp.
1335 This regexp should match Tramp file names but no other file names.
1336 \(When tramp.el is loaded, this regular expression is prepended to
1337 `file-name-handler-alist', and that is searched sequentially. Thus,
1338 if the Tramp entry appears rather early in the `file-name-handler-alist'
1339 and is a bit too general, then some files might be considered Tramp
1340 files which are not really Tramp files.
1341
1342 Please note that the entry in `file-name-handler-alist' is made when
1343 this file (tramp.el) is loaded. This means that this variable must be set
1344 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1345 updated after changing this variable.
1346
1347 Also see `tramp-file-name-structure'.")
1348
1349 ;;;###autoload
1350 (defconst tramp-root-regexp
1351 (if (memq system-type '(cygwin windows-nt))
1352 "^\\([a-zA-Z]:\\)?/"
1353 "^/")
1354 "Beginning of an incomplete Tramp file name.
1355 Usually, it is just \"^/\". On W32 systems, there might be a
1356 volume letter, which will be removed by `tramp-drop-volume-letter'.")
1357
1358 ;;;###autoload
1359 (defconst tramp-completion-file-name-regexp-unified
1360 (concat tramp-root-regexp "[^/]*$")
1361 "Value for `tramp-completion-file-name-regexp' for unified remoting.
1362 GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
1363 See `tramp-file-name-structure' for more explanations.")
1364
1365 ;;;###autoload
1366 (defconst tramp-completion-file-name-regexp-separate
1367 (concat tramp-root-regexp "\\([[][^]]*\\)?$")
1368 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1369 XEmacs uses a separate filename syntax for Tramp and EFS.
1370 See `tramp-file-name-structure' for more explanations.")
1371
1372 ;;;###autoload
1373 (defconst tramp-completion-file-name-regexp-url
1374 (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
1375 "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
1376 See `tramp-file-name-structure' for more explanations.")
1377
1378 ;;;###autoload
1379 (defconst tramp-completion-file-name-regexp
1380 (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
1381 ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
1382 ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
1383 (t (error "Wrong `tramp-syntax' defined")))
1384 "*Regular expression matching file names handled by Tramp completion.
1385 This regexp should match partial Tramp file names only.
1386
1387 Please note that the entry in `file-name-handler-alist' is made when
1388 this file (tramp.el) is loaded. This means that this variable must be set
1389 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1390 updated after changing this variable.
1391
1392 Also see `tramp-file-name-structure'.")
1393
1394 (defconst tramp-actions-before-shell
1395 '((tramp-login-prompt-regexp tramp-action-login)
1396 (tramp-password-prompt-regexp tramp-action-password)
1397 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1398 (shell-prompt-pattern tramp-action-succeed)
1399 (tramp-shell-prompt-pattern tramp-action-succeed)
1400 (tramp-yesno-prompt-regexp tramp-action-yesno)
1401 (tramp-yn-prompt-regexp tramp-action-yn)
1402 (tramp-terminal-prompt-regexp tramp-action-terminal)
1403 (tramp-process-alive-regexp tramp-action-process-alive))
1404 "List of pattern/action pairs.
1405 Whenever a pattern matches, the corresponding action is performed.
1406 Each item looks like (PATTERN ACTION).
1407
1408 The PATTERN should be a symbol, a variable. The value of this
1409 variable gives the regular expression to search for. Note that the
1410 regexp must match at the end of the buffer, \"\\'\" is implicitly
1411 appended to it.
1412
1413 The ACTION should also be a symbol, but a function. When the
1414 corresponding PATTERN matches, the ACTION function is called.")
1415
1416 (defconst tramp-actions-copy-out-of-band
1417 '((tramp-password-prompt-regexp tramp-action-password)
1418 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1419 (tramp-copy-failed-regexp tramp-action-permission-denied)
1420 (tramp-process-alive-regexp tramp-action-out-of-band))
1421 "List of pattern/action pairs.
1422 This list is used for copying/renaming with out-of-band methods.
1423
1424 See `tramp-actions-before-shell' for more info.")
1425
1426 ;; Chunked sending kludge. We set this to 500 for black-listed constellations
1427 ;; known to have a bug in `process-send-string'; some ssh connections appear
1428 ;; to drop bytes when data is sent too quickly. There is also a connection
1429 ;; buffer local variable, which is computed depending on remote host properties
1430 ;; when `tramp-chunksize' is zero or nil.
1431 (defcustom tramp-chunksize
1432 (when (and (not (featurep 'xemacs))
1433 (memq system-type '(hpux)))
1434 500)
1435 ;; Parentheses in docstring starting at beginning of line are escaped.
1436 ;; Fontification is messed up when
1437 ;; `open-paren-in-column-0-is-defun-start' set to t.
1438 "*If non-nil, chunksize for sending input to local process.
1439 It is necessary only on systems which have a buggy `process-send-string'
1440 implementation. The necessity, whether this variable must be set, can be
1441 checked via the following code:
1442
1443 (with-temp-buffer
1444 (let* ((user \"xxx\") (host \"yyy\")
1445 (init 0) (step 50)
1446 (sent init) (received init))
1447 (while (= sent received)
1448 (setq sent (+ sent step))
1449 (erase-buffer)
1450 (let ((proc (start-process (buffer-name) (current-buffer)
1451 \"ssh\" \"-l\" user host \"wc\" \"-c\")))
1452 (when (memq (process-status proc) '(run open))
1453 (process-send-string proc (make-string sent ?\\ ))
1454 (process-send-eof proc)
1455 (process-send-eof proc))
1456 (while (not (progn (goto-char (point-min))
1457 (re-search-forward \"\\\\w+\" (point-max) t)))
1458 (accept-process-output proc 1))
1459 (when (memq (process-status proc) '(run open))
1460 (setq received (string-to-number (match-string 0)))
1461 (delete-process proc)
1462 (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
1463 (sit-for 0))))
1464 (if (> sent (+ init step))
1465 (message \"You should set `tramp-chunksize' to a maximum of %s\"
1466 (- sent step))
1467 (message \"Test does not work\")
1468 (display-buffer (current-buffer))
1469 (sit-for 30))))
1470
1471 In the Emacs normally running Tramp, evaluate the above code
1472 \(replace \"xxx\" and \"yyy\" by the remote user and host name,
1473 respectively). You can do this, for example, by pasting it into
1474 the `*scratch*' buffer and then hitting C-j with the cursor after the
1475 last closing parenthesis. Note that it works only if you have configured
1476 \"ssh\" to run without password query, see ssh-agent(1).
1477
1478 You will see the number of bytes sent successfully to the remote host.
1479 If that number exceeds 1000, you can stop the execution by hitting
1480 C-g, because your Emacs is likely clean.
1481
1482 When it is necessary to set `tramp-chunksize', you might consider to
1483 use an out-of-the-band method (like \"scp\") instead of an internal one
1484 \(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
1485 performance.
1486
1487 If your Emacs is buggy, the code stops and gives you an indication
1488 about the value `tramp-chunksize' should be set. Maybe you could just
1489 experiment a bit, e.g. changing the values of `init' and `step'
1490 in the third line of the code.
1491
1492 Please raise a bug report via \"M-x tramp-bug\" if your system needs
1493 this variable to be set as well."
1494 :group 'tramp
1495 :type '(choice (const nil) integer))
1496
1497 ;; Logging in to a remote host normally requires obtaining a pty. But
1498 ;; Emacs on MacOS X has process-connection-type set to nil by default,
1499 ;; so on those systems Tramp doesn't obtain a pty. Here, we allow
1500 ;; for an override of the system default.
1501 (defcustom tramp-process-connection-type t
1502 "Overrides `process-connection-type' for connections from Tramp.
1503 Tramp binds process-connection-type to the value given here before
1504 opening a connection to a remote host."
1505 :group 'tramp
1506 :type '(choice (const nil) (const t) (const pty)))
1507
1508 (defcustom tramp-completion-reread-directory-timeout 10
1509 "Defines seconds since last remote command before rereading a directory.
1510 A remote directory might have changed its contents. In order to
1511 make it visible during file name completion in the minibuffer,
1512 Tramp flushes its cache and rereads the directory contents when
1513 more than `tramp-completion-reread-directory-timeout' seconds
1514 have been gone since last remote command execution. A value of 0
1515 would require an immediate reread during filename completion, nil
1516 means to use always cached values for the directory contents."
1517 :group 'tramp
1518 :type '(choice (const nil) integer))
1519
1520 ;;; Internal Variables:
1521
1522 (defvar tramp-end-of-output
1523 (format
1524 "%s///%s%s"
1525 tramp-rsh-end-of-line
1526 (md5 (concat (prin1-to-string process-environment) (current-time-string)))
1527 tramp-rsh-end-of-line)
1528 "String used to recognize end of output.")
1529
1530 (defvar tramp-current-method nil
1531 "Connection method for this *tramp* buffer.")
1532
1533 (defvar tramp-current-user nil
1534 "Remote login name for this *tramp* buffer.")
1535
1536 (defvar tramp-current-host nil
1537 "Remote host for this *tramp* buffer.")
1538
1539 (defconst tramp-uudecode
1540 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1541 cat /tmp/tramp.$$
1542 rm -f /tmp/tramp.$$"
1543 "Shell function to implement `uudecode' to standard output.
1544 Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
1545 for this or `uudecode -p', but some systems don't, and for them
1546 we have this shell function.")
1547
1548 ;; Perl script to implement `file-attributes' in a Lisp `read'able
1549 ;; output. If you are hacking on this, note that you get *no* output
1550 ;; unless this spits out a complete line, including the '\n' at the
1551 ;; end.
1552 ;; The device number is returned as "-1", because there will be a virtual
1553 ;; device number set in `tramp-handle-file-attributes'.
1554 (defconst tramp-perl-file-attributes
1555 "%s -e '
1556 @stat = lstat($ARGV[0]);
1557 if (($stat[2] & 0170000) == 0120000)
1558 {
1559 $type = readlink($ARGV[0]);
1560 $type = \"\\\"$type\\\"\";
1561 }
1562 elsif (($stat[2] & 0170000) == 040000)
1563 {
1564 $type = \"t\";
1565 }
1566 else
1567 {
1568 $type = \"nil\"
1569 };
1570 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1571 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1572 printf(
1573 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\",
1574 $type,
1575 $stat[3],
1576 $uid,
1577 $gid,
1578 $stat[8] >> 16 & 0xffff,
1579 $stat[8] & 0xffff,
1580 $stat[9] >> 16 & 0xffff,
1581 $stat[9] & 0xffff,
1582 $stat[10] >> 16 & 0xffff,
1583 $stat[10] & 0xffff,
1584 $stat[7],
1585 $stat[2],
1586 $stat[1] >> 16 & 0xffff,
1587 $stat[1] & 0xffff
1588 );' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1589 "Perl script to produce output suitable for use with `file-attributes'
1590 on the remote file system.
1591 Escape sequence %s is replaced with name of Perl binary.
1592 This string is passed to `format', so percent characters need to be doubled.")
1593
1594 (defconst tramp-perl-directory-files-and-attributes
1595 "%s -e '
1596 chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
1597 opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
1598 @list = readdir(DIR);
1599 closedir(DIR);
1600 $n = scalar(@list);
1601 printf(\"(\\n\");
1602 for($i = 0; $i < $n; $i++)
1603 {
1604 $filename = $list[$i];
1605 @stat = lstat($filename);
1606 if (($stat[2] & 0170000) == 0120000)
1607 {
1608 $type = readlink($filename);
1609 $type = \"\\\"$type\\\"\";
1610 }
1611 elsif (($stat[2] & 0170000) == 040000)
1612 {
1613 $type = \"t\";
1614 }
1615 else
1616 {
1617 $type = \"nil\"
1618 };
1619 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1620 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1621 printf(
1622 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
1623 $filename,
1624 $type,
1625 $stat[3],
1626 $uid,
1627 $gid,
1628 $stat[8] >> 16 & 0xffff,
1629 $stat[8] & 0xffff,
1630 $stat[9] >> 16 & 0xffff,
1631 $stat[9] & 0xffff,
1632 $stat[10] >> 16 & 0xffff,
1633 $stat[10] & 0xffff,
1634 $stat[7],
1635 $stat[2],
1636 $stat[1] >> 16 & 0xffff,
1637 $stat[1] & 0xffff,
1638 $stat[0] >> 16 & 0xffff,
1639 $stat[0] & 0xffff);
1640 }
1641 printf(\")\\n\");' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1642 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1643 output.
1644 Escape sequence %s is replaced with name of Perl binary.
1645 This string is passed to `format', so percent characters need to be doubled.")
1646
1647 ;; ;; These two use uu encoding.
1648 ;; (defvar tramp-perl-encode "%s -e'\
1649 ;; print qq(begin 644 xxx\n);
1650 ;; my $s = q();
1651 ;; my $res = q();
1652 ;; while (read(STDIN, $s, 45)) {
1653 ;; print pack(q(u), $s);
1654 ;; }
1655 ;; print qq(`\n);
1656 ;; print qq(end\n);
1657 ;; '"
1658 ;; "Perl program to use for encoding a file.
1659 ;; Escape sequence %s is replaced with name of Perl binary.")
1660
1661 ;; (defvar tramp-perl-decode "%s -ne '
1662 ;; print unpack q(u), $_;
1663 ;; '"
1664 ;; "Perl program to use for decoding a file.
1665 ;; Escape sequence %s is replaced with name of Perl binary.")
1666
1667 ;; These two use base64 encoding.
1668 (defconst tramp-perl-encode-with-module
1669 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
1670 "Perl program to use for encoding a file.
1671 Escape sequence %s is replaced with name of Perl binary.
1672 This string is passed to `format', so percent characters need to be doubled.
1673 This implementation requires the MIME::Base64 Perl module to be installed
1674 on the remote host.")
1675
1676 (defconst tramp-perl-decode-with-module
1677 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
1678 "Perl program to use for decoding a file.
1679 Escape sequence %s is replaced with name of Perl binary.
1680 This string is passed to `format', so percent characters need to be doubled.
1681 This implementation requires the MIME::Base64 Perl module to be installed
1682 on the remote host.")
1683
1684 (defconst tramp-perl-encode
1685 "%s -e '
1686 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1687 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
1688 # Free Software Foundation, Inc.
1689 use strict;
1690
1691 my %%trans = do {
1692 my $i = 0;
1693 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
1694 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
1695 };
1696
1697 binmode(\\*STDIN);
1698
1699 # We read in chunks of 54 bytes, to generate output lines
1700 # of 72 chars (plus end of line)
1701 $/ = \\54;
1702
1703 while (my $data = <STDIN>) {
1704 my $pad = q();
1705
1706 # Only for the last chunk, and only if did not fill the last three-byte packet
1707 if (eof) {
1708 my $mod = length($data) %% 3;
1709 $pad = q(=) x (3 - $mod) if $mod;
1710 }
1711
1712 # Not the fastest method, but it is simple: unpack to binary string, split
1713 # by groups of 6 bits and convert back from binary to byte; then map into
1714 # the translation table
1715 print
1716 join q(),
1717 map($trans{$_},
1718 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1719 $pad,
1720 qq(\\n);
1721 }' 2>/dev/null"
1722 "Perl program to use for encoding a file.
1723 Escape sequence %s is replaced with name of Perl binary.
1724 This string is passed to `format', so percent characters need to be doubled.")
1725
1726 (defconst tramp-perl-decode
1727 "%s -e '
1728 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1729 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
1730 # Free Software Foundation, Inc.
1731 use strict;
1732
1733 my %%trans = do {
1734 my $i = 0;
1735 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
1736 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
1737 };
1738
1739 my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
1740
1741 binmode(\\*STDOUT);
1742
1743 # We are going to accumulate into $pending to accept any line length
1744 # (we do not check they are <= 76 chars as the RFC says)
1745 my $pending = q();
1746
1747 while (my $data = <STDIN>) {
1748 chomp $data;
1749
1750 # If we find one or two =, we have reached the end and
1751 # any following data is to be discarded
1752 my $finished = $data =~ s/(==?).*/$1/;
1753 $pending .= $data;
1754
1755 my $len = length($pending);
1756 my $chunk = substr($pending, 0, $len & ~3);
1757 $pending = substr($pending, $len & ~3 + 1);
1758
1759 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
1760 # split in 8-bit chunks and convert back to char.
1761 print join q(),
1762 map $bytes{$_},
1763 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1764
1765 last if $finished;
1766 }' 2>/dev/null"
1767 "Perl program to use for decoding a file.
1768 Escape sequence %s is replaced with name of Perl binary.
1769 This string is passed to `format', so percent characters need to be doubled.")
1770
1771 (defconst tramp-file-mode-type-map
1772 '((0 . "-") ; Normal file (SVID-v2 and XPG2)
1773 (1 . "p") ; fifo
1774 (2 . "c") ; character device
1775 (3 . "m") ; multiplexed character device (v7)
1776 (4 . "d") ; directory
1777 (5 . "?") ; Named special file (XENIX)
1778 (6 . "b") ; block device
1779 (7 . "?") ; multiplexed block device (v7)
1780 (8 . "-") ; regular file
1781 (9 . "n") ; network special file (HP-UX)
1782 (10 . "l") ; symlink
1783 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
1784 (12 . "s") ; socket
1785 (13 . "D") ; door special (Solaris)
1786 (14 . "w")) ; whiteout (BSD)
1787 "A list of file types returned from the `stat' system call.
1788 This is used to map a mode number to a permission string.")
1789
1790 ;; New handlers should be added here. The following operations can be
1791 ;; handled using the normal primitives: file-name-sans-versions,
1792 ;; get-file-buffer.
1793 (defconst tramp-file-name-handler-alist
1794 '((load . tramp-handle-load)
1795 (make-symbolic-link . tramp-handle-make-symbolic-link)
1796 (file-name-as-directory . tramp-handle-file-name-as-directory)
1797 (file-name-directory . tramp-handle-file-name-directory)
1798 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
1799 (file-truename . tramp-handle-file-truename)
1800 (file-exists-p . tramp-handle-file-exists-p)
1801 (file-directory-p . tramp-handle-file-directory-p)
1802 (file-executable-p . tramp-handle-file-executable-p)
1803 (file-readable-p . tramp-handle-file-readable-p)
1804 (file-regular-p . tramp-handle-file-regular-p)
1805 (file-symlink-p . tramp-handle-file-symlink-p)
1806 (file-writable-p . tramp-handle-file-writable-p)
1807 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
1808 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
1809 (file-attributes . tramp-handle-file-attributes)
1810 (file-modes . tramp-handle-file-modes)
1811 (directory-files . tramp-handle-directory-files)
1812 (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
1813 (file-name-all-completions . tramp-handle-file-name-all-completions)
1814 (file-name-completion . tramp-handle-file-name-completion)
1815 (add-name-to-file . tramp-handle-add-name-to-file)
1816 (copy-file . tramp-handle-copy-file)
1817 (rename-file . tramp-handle-rename-file)
1818 (set-file-modes . tramp-handle-set-file-modes)
1819 (set-file-times . tramp-handle-set-file-times)
1820 (make-directory . tramp-handle-make-directory)
1821 (delete-directory . tramp-handle-delete-directory)
1822 (delete-file . tramp-handle-delete-file)
1823 (directory-file-name . tramp-handle-directory-file-name)
1824 ;; `executable-find' is not official yet.
1825 (executable-find . tramp-handle-executable-find)
1826 (start-file-process . tramp-handle-start-file-process)
1827 (process-file . tramp-handle-process-file)
1828 (shell-command . tramp-handle-shell-command)
1829 (insert-directory . tramp-handle-insert-directory)
1830 (expand-file-name . tramp-handle-expand-file-name)
1831 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
1832 (file-local-copy . tramp-handle-file-local-copy)
1833 (file-remote-p . tramp-handle-file-remote-p)
1834 (insert-file-contents . tramp-handle-insert-file-contents)
1835 (insert-file-contents-literally
1836 . tramp-handle-insert-file-contents-literally)
1837 (write-region . tramp-handle-write-region)
1838 (find-backup-file-name . tramp-handle-find-backup-file-name)
1839 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
1840 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
1841 (dired-compress-file . tramp-handle-dired-compress-file)
1842 (dired-recursive-delete-directory
1843 . tramp-handle-dired-recursive-delete-directory)
1844 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
1845 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime))
1846 "Alist of handler functions.
1847 Operations not mentioned here will be handled by the normal Emacs functions.")
1848
1849 ;; Handlers for partial Tramp file names. For Emacs just
1850 ;; `file-name-all-completions' is needed.
1851 ;;;###autoload
1852 (defconst tramp-completion-file-name-handler-alist
1853 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
1854 (file-name-completion . tramp-completion-handle-file-name-completion))
1855 "Alist of completion handler functions.
1856 Used for file names matching `tramp-file-name-regexp'. Operations not
1857 mentioned here will be handled by `tramp-file-name-handler-alist' or the
1858 normal Emacs functions.")
1859
1860 ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
1861 (defvar tramp-foreign-file-name-handler-alist
1862 ;; (identity . tramp-sh-file-name-handler) should always be the last
1863 ;; entry, since `identity' always matches.
1864 '((identity . tramp-sh-file-name-handler))
1865 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
1866 If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
1867 calling HANDLER.")
1868
1869 ;;; Internal functions which must come first:
1870
1871 (defsubst tramp-debug-message (vec fmt-string &rest args)
1872 "Append message to debug buffer.
1873 Message is formatted with FMT-STRING as control string and the remaining
1874 ARGS to actually emit the message (if applicable)."
1875 (when (get-buffer (tramp-buffer-name vec))
1876 (with-current-buffer (tramp-get-debug-buffer vec)
1877 (goto-char (point-max))
1878 (unless (bolp)
1879 (insert "\n"))
1880 ;; Timestamp
1881 (insert (format-time-string "%T "))
1882 ;; Calling function
1883 (let ((btn 1) btf fn)
1884 (while (not fn)
1885 (setq btf (nth 1 (backtrace-frame btn)))
1886 (if (not btf)
1887 (setq fn "")
1888 (when (symbolp btf)
1889 (setq fn (symbol-name btf))
1890 (unless (and (string-match "^tramp" fn)
1891 (not (string-match
1892 "^tramp\\(-debug\\)?\\(-message\\|-error\\)$"
1893 fn)))
1894 (setq fn nil)))
1895 (setq btn (1+ btn))))
1896 ;; The following code inserts filename and line number.
1897 ;; Should be deactivated by default, because it is time
1898 ;; consuming.
1899 ; (let ((ffn (find-function-noselect (intern fn))))
1900 ; (insert
1901 ; (format
1902 ; "%s:%d: "
1903 ; (file-name-nondirectory (buffer-file-name (car ffn)))
1904 ; (with-current-buffer (car ffn)
1905 ; (1+ (count-lines (point-min) (cdr ffn)))))))
1906 (insert (format "%s " fn)))
1907 ;; The message
1908 (insert (apply 'format fmt-string args)))))
1909
1910 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
1911 "Emit a message depending on verbosity level.
1912 VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
1913 vector or a process. LEVEL says to be quiet if `tramp-verbose' is
1914 less than LEVEL. The message is emitted only if `tramp-verbose' is
1915 greater than or equal to LEVEL.
1916
1917 The message is also logged into the debug buffer when `tramp-verbose'
1918 is greater than or equal 4.
1919
1920 Calls functions `message' and `tramp-debug-message' with FMT-STRING as
1921 control string and the remaining ARGS to actually emit the message (if
1922 applicable)."
1923 (condition-case nil
1924 (when (<= level tramp-verbose)
1925 ;; Match data must be preserved!
1926 (save-match-data
1927 ;; Display only when there is a minimum level.
1928 (when (<= level 3)
1929 (apply 'message
1930 (concat
1931 (cond
1932 ((= level 0) "")
1933 ((= level 1) "")
1934 ((= level 2) "Warning: ")
1935 (t "Tramp: "))
1936 fmt-string)
1937 args))
1938 ;; Log only when there is a minimum level.
1939 (when (>= tramp-verbose 4)
1940 (when (and vec-or-proc
1941 (processp vec-or-proc)
1942 (buffer-name (process-buffer vec-or-proc)))
1943 (with-current-buffer (process-buffer vec-or-proc)
1944 ;; Translate proc to vec.
1945 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
1946 (when (and vec-or-proc (vectorp vec-or-proc))
1947 (apply 'tramp-debug-message
1948 vec-or-proc
1949 (concat (format "(%d) # " level) fmt-string)
1950 args)))))
1951 ;; Suppress all errors.
1952 (error nil)))
1953
1954 (defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
1955 "Emit an error.
1956 VEC-OR-PROC identifies the connection to use, SIGNAL is the
1957 signal identifier to be raised, remaining args passed to
1958 `tramp-message'. Finally, signal SIGNAL is raised."
1959 (tramp-message
1960 vec-or-proc 1 "%s"
1961 (error-message-string
1962 (list signal (get signal 'error-message) (apply 'format fmt-string args))))
1963 (signal signal (list (apply 'format fmt-string args))))
1964
1965 (defsubst tramp-error-with-buffer
1966 (buffer vec-or-proc signal fmt-string &rest args)
1967 "Emit an error, and show BUFFER.
1968 If BUFFER is nil, show the connection buffer. Wait for 30\", or until
1969 an input event arrives. The other arguments are passed to `tramp-error'."
1970 (save-window-excursion
1971 (unwind-protect
1972 (apply 'tramp-error vec-or-proc signal fmt-string args)
1973 (when (and vec-or-proc (not (zerop tramp-verbose)))
1974 (let ((enable-recursive-minibuffers t))
1975 (pop-to-buffer
1976 (or (and (bufferp buffer) buffer)
1977 (and (processp vec-or-proc) (process-buffer vec-or-proc))
1978 (tramp-get-buffer vec-or-proc)))
1979 (sit-for 30))))))
1980
1981 (defmacro with-parsed-tramp-file-name (filename var &rest body)
1982 "Parse a Tramp filename and make components available in the body.
1983
1984 First arg FILENAME is evaluated and dissected into its components.
1985 Second arg VAR is a symbol. It is used as a variable name to hold
1986 the filename structure. It is also used as a prefix for the variables
1987 holding the components. For example, if VAR is the symbol `foo', then
1988 `foo' will be bound to the whole structure, `foo-method' will be bound to
1989 the method component, and so on for `foo-user', `foo-host', `foo-localname'.
1990
1991 Remaining args are Lisp expressions to be evaluated (inside an implicit
1992 `progn').
1993
1994 If VAR is nil, then we bind `v' to the structure and `method', `user',
1995 `host', `localname' to the components."
1996 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1997 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
1998 (tramp-file-name-method ,(or var 'v)))
1999 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
2000 (tramp-file-name-user ,(or var 'v)))
2001 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
2002 (tramp-file-name-host ,(or var 'v)))
2003 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
2004 (tramp-file-name-localname ,(or var 'v))))
2005 ,@body))
2006
2007 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
2008 (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
2009 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
2010
2011 (defmacro with-file-property (vec file property &rest body)
2012 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
2013 FILE must be a local file name on a connection identified via VEC."
2014 `(if (file-name-absolute-p ,file)
2015 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
2016 (when (eq value 'undef)
2017 ;; We cannot pass @body as parameter to
2018 ;; `tramp-set-file-property' because it mangles our
2019 ;; debug messages.
2020 (setq value (progn ,@body))
2021 (tramp-set-file-property ,vec ,file ,property value))
2022 value)
2023 ,@body))
2024
2025 (put 'with-file-property 'lisp-indent-function 3)
2026 (put 'with-file-property 'edebug-form-spec t)
2027 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
2028
2029 (defmacro with-connection-property (key property &rest body)
2030 "Checks in Tramp for property PROPERTY, otherwise executes BODY and set."
2031 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
2032 (when (eq value 'undef)
2033 ;; We cannot pass ,@body as parameter to
2034 ;; `tramp-set-connection-property' because it mangles our debug
2035 ;; messages.
2036 (setq value (progn ,@body))
2037 (tramp-set-connection-property ,key ,property value))
2038 value))
2039
2040 (put 'with-connection-property 'lisp-indent-function 2)
2041 (put 'with-connection-property 'edebug-form-spec t)
2042 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
2043
2044 (eval-and-compile ; silence compiler
2045 (if (memq system-type '(cygwin windows-nt))
2046 (defun tramp-drop-volume-letter (name)
2047 "Cut off unnecessary drive letter from file NAME.
2048 The function `tramp-handle-expand-file-name' calls `expand-file-name'
2049 locally on a remote file name. When the local system is a W32 system
2050 but the remote system is Unix, this introduces a superfluous drive
2051 letter into the file name. This function removes it."
2052 (save-match-data
2053 (if (string-match tramp-root-regexp name)
2054 (replace-match "/" nil t name)
2055 name)))
2056
2057 (defalias 'tramp-drop-volume-letter 'identity)))
2058
2059 (defsubst tramp-make-tramp-temp-file (vec)
2060 "Create a temporary file on the remote host identified by VEC.
2061 Return the local name of the temporary file."
2062 (let ((prefix
2063 (tramp-make-tramp-file-name
2064 (tramp-file-name-method vec)
2065 (tramp-file-name-user vec)
2066 (tramp-file-name-host vec)
2067 (tramp-drop-volume-letter
2068 (expand-file-name
2069 tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
2070 result)
2071 (while (not result)
2072 ;; `make-temp-file' would be the natural choice for
2073 ;; implementation. But it calls `write-region' internally,
2074 ;; which also needs a temporary file - we would end in an
2075 ;; infinite loop.
2076 (setq result (make-temp-name prefix))
2077 (if (file-exists-p result)
2078 (setq result nil)
2079 ;; This creates the file by side effect.
2080 (set-file-times result)
2081 (set-file-modes result (tramp-octal-to-decimal "0700"))))
2082
2083 ;; Return the local part.
2084 (with-parsed-tramp-file-name result nil localname)))
2085
2086
2087 ;;; Config Manipulation Functions:
2088
2089 (defun tramp-set-completion-function (method function-list)
2090 "Sets the list of completion functions for METHOD.
2091 FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
2092 The FUNCTION is intended to parse FILE according its syntax.
2093 It might be a predefined FUNCTION, or a user defined FUNCTION.
2094 Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
2095 `tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
2096 and `tramp-parse-netrc'.
2097
2098 Example:
2099
2100 (tramp-set-completion-function
2101 \"ssh\"
2102 '((tramp-parse-sconfig \"/etc/ssh_config\")
2103 (tramp-parse-sconfig \"~/.ssh/config\")))"
2104
2105 (let ((r function-list)
2106 (v function-list))
2107 (setq tramp-completion-function-alist
2108 (delete (assoc method tramp-completion-function-alist)
2109 tramp-completion-function-alist))
2110
2111 (while v
2112 ;; Remove double entries.
2113 (when (member (car v) (cdr v))
2114 (setcdr v (delete (car v) (cdr v))))
2115 ;; Check for function and file or registry key.
2116 (unless (and (functionp (nth 0 (car v)))
2117 (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
2118 ;; Windows registry.
2119 (and (memq system-type '(cygwin windows-nt))
2120 (zerop
2121 (tramp-local-call-process
2122 "reg" nil nil nil "query" (nth 1 (car v)))))
2123 ;; Configuration file.
2124 (file-exists-p (nth 1 (car v)))))
2125 (setq r (delete (car v) r)))
2126 (setq v (cdr v)))
2127
2128 (when r
2129 (add-to-list 'tramp-completion-function-alist
2130 (cons method r)))))
2131
2132 (defun tramp-get-completion-function (method)
2133 "Returns a list of completion functions for METHOD.
2134 For definition of that list see `tramp-set-completion-function'."
2135 (cons
2136 ;; Hosts visited once shall be remembered.
2137 `(tramp-parse-connection-properties ,method)
2138 ;; The method related defaults.
2139 (cdr (assoc method tramp-completion-function-alist))))
2140
2141
2142 ;;; Fontification of `read-file-name':
2143
2144 ;; rfn-eshadow.el is part of Emacs 22. It is autoloaded.
2145 (defvar tramp-rfn-eshadow-overlay)
2146 (make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
2147
2148 (defun tramp-rfn-eshadow-setup-minibuffer ()
2149 "Set up a minibuffer for `file-name-shadow-mode'.
2150 Adds another overlay hiding filename parts according to Tramp's
2151 special handling of `substitute-in-file-name'."
2152 (when (symbol-value 'minibuffer-completing-file-name)
2153 (setq tramp-rfn-eshadow-overlay
2154 (funcall (symbol-function 'make-overlay)
2155 (funcall (symbol-function 'minibuffer-prompt-end))
2156 (funcall (symbol-function 'minibuffer-prompt-end))))
2157 ;; Copy rfn-eshadow-overlay properties.
2158 (let ((props (funcall (symbol-function 'overlay-properties)
2159 (symbol-value 'rfn-eshadow-overlay))))
2160 (while props
2161 (funcall (symbol-function 'overlay-put)
2162 tramp-rfn-eshadow-overlay (pop props) (pop props))))))
2163
2164 (when (boundp 'rfn-eshadow-setup-minibuffer-hook)
2165 (add-hook 'rfn-eshadow-setup-minibuffer-hook
2166 'tramp-rfn-eshadow-setup-minibuffer)
2167 (add-hook 'tramp-unload-hook
2168 '(lambda ()
2169 (remove-hook 'rfn-eshadow-setup-minibuffer-hook
2170 'tramp-rfn-eshadow-setup-minibuffer))))
2171
2172 (defun tramp-rfn-eshadow-update-overlay ()
2173 "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
2174 This is intended to be used as a minibuffer `post-command-hook' for
2175 `file-name-shadow-mode'; the minibuffer should have already
2176 been set up by `rfn-eshadow-setup-minibuffer'."
2177 ;; In remote files name, there is a shadowing just for the local part.
2178 (let ((end (or (funcall (symbol-function 'overlay-end)
2179 (symbol-value 'rfn-eshadow-overlay))
2180 (funcall (symbol-function 'minibuffer-prompt-end)))))
2181 (when (file-remote-p (buffer-substring-no-properties end (point-max)))
2182 (save-excursion
2183 (save-restriction
2184 (narrow-to-region
2185 (1+ (or (string-match "/" (buffer-string) end) end)) (point-max))
2186 (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
2187 (rfn-eshadow-update-overlay-hook nil))
2188 (move-overlay rfn-eshadow-overlay (point-max) (point-max))
2189 (funcall (symbol-function 'rfn-eshadow-update-overlay))))))))
2190
2191 (when (boundp 'rfn-eshadow-update-overlay-hook)
2192 (add-hook 'rfn-eshadow-update-overlay-hook
2193 'tramp-rfn-eshadow-update-overlay))
2194
2195
2196 ;;; File Name Handler Functions:
2197
2198 (defun tramp-handle-make-symbolic-link
2199 (filename linkname &optional ok-if-already-exists)
2200 "Like `make-symbolic-link' for Tramp files.
2201 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
2202 the symlink. If LINKNAME is a Tramp file, only the localname component is
2203 used as the target of the symlink.
2204
2205 If LINKNAME is a Tramp file and the localname component is relative, then
2206 it is expanded first, before the localname component is taken. Note that
2207 this can give surprising results if the user/host for the source and
2208 target of the symlink differ."
2209 (with-parsed-tramp-file-name linkname l
2210 (let ((ln (tramp-get-remote-ln l))
2211 (cwd (tramp-run-real-handler
2212 'file-name-directory (list l-localname))))
2213 (unless ln
2214 (tramp-error
2215 l 'file-error
2216 "Making a symbolic link. ln(1) does not exist on the remote host."))
2217
2218 ;; Do the 'confirm if exists' thing.
2219 (when (file-exists-p linkname)
2220 ;; What to do?
2221 (if (or (null ok-if-already-exists) ; not allowed to exist
2222 (and (numberp ok-if-already-exists)
2223 (not (yes-or-no-p
2224 (format
2225 "File %s already exists; make it a link anyway? "
2226 l-localname)))))
2227 (tramp-error
2228 l 'file-already-exists "File %s already exists" l-localname)
2229 (delete-file linkname)))
2230
2231 ;; If FILENAME is a Tramp name, use just the localname component.
2232 (when (tramp-tramp-file-p filename)
2233 (setq filename
2234 (tramp-file-name-localname
2235 (tramp-dissect-file-name (expand-file-name filename)))))
2236
2237 ;; Right, they are on the same host, regardless of user, method, etc.
2238 ;; We now make the link on the remote machine. This will occur as the user
2239 ;; that FILENAME belongs to.
2240 (zerop
2241 (tramp-send-command-and-check
2242 l (format "cd %s && %s -sf %s %s" cwd ln filename l-localname) t)))))
2243
2244 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2245 "Like `load' for Tramp files."
2246 (with-parsed-tramp-file-name (expand-file-name file) nil
2247 (unless nosuffix
2248 (cond ((file-exists-p (concat file ".elc"))
2249 (setq file (concat file ".elc")))
2250 ((file-exists-p (concat file ".el"))
2251 (setq file (concat file ".el")))))
2252 (when must-suffix
2253 ;; The first condition is always true for absolute file names.
2254 ;; Included for safety's sake.
2255 (unless (or (file-name-directory file)
2256 (string-match "\\.elc?\\'" file))
2257 (tramp-error
2258 v 'file-error
2259 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2260 (unless noerror
2261 (when (not (file-exists-p file))
2262 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2263 (if (not (file-exists-p file))
2264 nil
2265 (unless nomessage (tramp-message v 0 "Loading %s..." file))
2266 (let ((local-copy (file-local-copy file)))
2267 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2268 (unwind-protect
2269 (load local-copy noerror t t)
2270 (delete-file local-copy)))
2271 (unless nomessage (tramp-message v 0 "Loading %s...done" file))
2272 t)))
2273
2274 ;; Localname manipulation functions that grok Tramp localnames...
2275 (defun tramp-handle-file-name-as-directory (file)
2276 "Like `file-name-as-directory' but aware of Tramp files."
2277 ;; `file-name-as-directory' would be sufficient except localname is
2278 ;; the empty string.
2279 (let ((v (tramp-dissect-file-name file t)))
2280 ;; Run the command on the localname portion only.
2281 (tramp-make-tramp-file-name
2282 (tramp-file-name-method v)
2283 (tramp-file-name-user v)
2284 (tramp-file-name-host v)
2285 (tramp-run-real-handler
2286 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
2287
2288 (defun tramp-handle-file-name-directory (file)
2289 "Like `file-name-directory' but aware of Tramp files."
2290 ;; Everything except the last filename thing is the directory. We
2291 ;; cannot apply `with-parsed-tramp-file-name', because this expands
2292 ;; the remote file name parts. This is a problem when we are in
2293 ;; file name completion.
2294 (let ((v (tramp-dissect-file-name file t)))
2295 ;; Run the command on the localname portion only.
2296 (tramp-make-tramp-file-name
2297 (tramp-file-name-method v)
2298 (tramp-file-name-user v)
2299 (tramp-file-name-host v)
2300 (tramp-run-real-handler
2301 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
2302
2303 (defun tramp-handle-file-name-nondirectory (file)
2304 "Like `file-name-nondirectory' but aware of Tramp files."
2305 (with-parsed-tramp-file-name file nil
2306 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
2307
2308 (defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2309 "Like `file-truename' for Tramp files."
2310 (with-parsed-tramp-file-name (expand-file-name filename) nil
2311 (with-file-property v localname "file-truename"
2312 (let* ((directory-sep-char ?/) ; for XEmacs
2313 (steps (tramp-split-string localname "/"))
2314 (localnamedir (tramp-run-real-handler
2315 'file-name-as-directory (list localname)))
2316 (is-dir (string= localname localnamedir))
2317 (thisstep nil)
2318 (numchase 0)
2319 ;; Don't make the following value larger than necessary.
2320 ;; People expect an error message in a timely fashion when
2321 ;; something is wrong; otherwise they might think that Emacs
2322 ;; is hung. Of course, correctness has to come first.
2323 (numchase-limit 20)
2324 (result nil) ;result steps in reverse order
2325 symlink-target)
2326 (tramp-message v 4 "Finding true name for `%s'" filename)
2327 (while (and steps (< numchase numchase-limit))
2328 (setq thisstep (pop steps))
2329 (tramp-message
2330 v 5 "Check %s"
2331 (mapconcat 'identity
2332 (append '("") (reverse result) (list thisstep))
2333 "/"))
2334 (setq symlink-target
2335 (nth 0 (file-attributes
2336 (tramp-make-tramp-file-name
2337 method user host
2338 (mapconcat 'identity
2339 (append '("")
2340 (reverse result)
2341 (list thisstep))
2342 "/")))))
2343 (cond ((string= "." thisstep)
2344 (tramp-message v 5 "Ignoring step `.'"))
2345 ((string= ".." thisstep)
2346 (tramp-message v 5 "Processing step `..'")
2347 (pop result))
2348 ((stringp symlink-target)
2349 ;; It's a symlink, follow it.
2350 (tramp-message v 5 "Follow symlink to %s" symlink-target)
2351 (setq numchase (1+ numchase))
2352 (when (file-name-absolute-p symlink-target)
2353 (setq result nil))
2354 ;; If the symlink was absolute, we'll get a string like
2355 ;; "/user@host:/some/target"; extract the
2356 ;; "/some/target" part from it.
2357 (when (tramp-tramp-file-p symlink-target)
2358 (unless (tramp-equal-remote filename symlink-target)
2359 (tramp-error
2360 v 'file-error
2361 "Symlink target `%s' on wrong host" symlink-target))
2362 (setq symlink-target localname))
2363 (setq steps
2364 (append (tramp-split-string symlink-target "/")
2365 steps)))
2366 (t
2367 ;; It's a file.
2368 (setq result (cons thisstep result)))))
2369 (when (>= numchase numchase-limit)
2370 (tramp-error
2371 v 'file-error
2372 "Maximum number (%d) of symlinks exceeded" numchase-limit))
2373 (setq result (reverse result))
2374 ;; Combine list to form string.
2375 (setq result
2376 (if result
2377 (mapconcat 'identity (cons "" result) "/")
2378 "/"))
2379 (when (and is-dir (or (string= "" result)
2380 (not (string= (substring result -1) "/"))))
2381 (setq result (concat result "/")))
2382 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
2383 (tramp-make-tramp-file-name method user host result)))))
2384
2385 ;; Basic functions.
2386
2387 (defun tramp-handle-file-exists-p (filename)
2388 "Like `file-exists-p' for Tramp files."
2389 (with-parsed-tramp-file-name filename nil
2390 (with-file-property v localname "file-exists-p"
2391 (zerop (tramp-send-command-and-check
2392 v
2393 (format
2394 "%s %s"
2395 (tramp-get-file-exists-command v)
2396 (tramp-shell-quote-argument localname)))))))
2397
2398 ;; Inodes don't exist for some file systems. Therefore we must
2399 ;; generate virtual ones. Used in `find-buffer-visiting'. The method
2400 ;; applied might be not so efficient (Ange-FTP uses hashes). But
2401 ;; performance isn't the major issue given that file transfer will
2402 ;; take time.
2403 (defvar tramp-inodes nil
2404 "Keeps virtual inodes numbers.")
2405
2406 ;; Devices must distinguish physical file systems. The device numbers
2407 ;; provided by "lstat" aren't unique, because we operate on different hosts.
2408 ;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
2409 ;; EFS use device number "-1". In order to be different, we use device number
2410 ;; (-1 . x), whereby "x" is unique for a given (method user host).
2411 (defvar tramp-devices nil
2412 "Keeps virtual device numbers.")
2413
2414 ;; CCC: This should check for an error condition and signal failure
2415 ;; when something goes wrong.
2416 ;; Daniel Pittman <daniel@danann.net>
2417 (defun tramp-handle-file-attributes (filename &optional id-format)
2418 "Like `file-attributes' for Tramp files."
2419 (unless id-format (setq id-format 'integer))
2420 (with-parsed-tramp-file-name (expand-file-name filename) nil
2421 (with-file-property v localname (format "file-attributes-%s" id-format)
2422 (when (file-exists-p filename)
2423 ;; file exists, find out stuff
2424 (save-excursion
2425 (tramp-convert-file-attributes
2426 v
2427 (if (tramp-get-remote-stat v)
2428 (tramp-handle-file-attributes-with-stat v localname id-format)
2429 (if (tramp-get-remote-perl v)
2430 (tramp-handle-file-attributes-with-perl v localname id-format)
2431 (tramp-handle-file-attributes-with-ls
2432 v localname id-format)))))))))
2433
2434 (defun tramp-handle-file-attributes-with-ls (vec localname &optional id-format)
2435 "Implement `file-attributes' for Tramp files using the ls(1) command."
2436 (let (symlinkp dirp
2437 res-inode res-filemodes res-numlinks
2438 res-uid res-gid res-size res-symlink-target)
2439 (tramp-message vec 5 "file attributes with ls: %s" localname)
2440 (tramp-send-command
2441 vec
2442 (format "%s %s %s"
2443 (tramp-get-ls-command vec)
2444 (if (eq id-format 'integer) "-ildn" "-ild")
2445 (tramp-shell-quote-argument localname)))
2446 ;; parse `ls -l' output ...
2447 (with-current-buffer (tramp-get-buffer vec)
2448 (goto-char (point-min))
2449 ;; ... inode
2450 (setq res-inode
2451 (condition-case err
2452 (read (current-buffer))
2453 (invalid-read-syntax
2454 (when (and (equal (cadr err)
2455 "Integer constant overflow in reader")
2456 (string-match
2457 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
2458 (car (cddr err))))
2459 (let* ((big (read (substring (car (cddr err)) 0
2460 (match-beginning 1))))
2461 (small (read (match-string 1 (car (cddr err)))))
2462 (twiddle (/ small 65536)))
2463 (cons (+ big twiddle)
2464 (- small (* twiddle 65536))))))))
2465 ;; ... file mode flags
2466 (setq res-filemodes (symbol-name (read (current-buffer))))
2467 ;; ... number links
2468 (setq res-numlinks (read (current-buffer)))
2469 ;; ... uid and gid
2470 (setq res-uid (read (current-buffer)))
2471 (setq res-gid (read (current-buffer)))
2472 (if (eq id-format 'integer)
2473 (progn
2474 (unless (numberp res-uid) (setq res-uid -1))
2475 (unless (numberp res-gid) (setq res-gid -1)))
2476 (progn
2477 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
2478 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
2479 ;; ... size
2480 (setq res-size (read (current-buffer)))
2481 ;; From the file modes, figure out other stuff.
2482 (setq symlinkp (eq ?l (aref res-filemodes 0)))
2483 (setq dirp (eq ?d (aref res-filemodes 0)))
2484 ;; if symlink, find out file name pointed to
2485 (when symlinkp
2486 (search-forward "-> ")
2487 (setq res-symlink-target
2488 (buffer-substring (point) (tramp-compat-line-end-position))))
2489 ;; return data gathered
2490 (list
2491 ;; 0. t for directory, string (name linked to) for symbolic
2492 ;; link, or nil.
2493 (or dirp res-symlink-target)
2494 ;; 1. Number of links to file.
2495 res-numlinks
2496 ;; 2. File uid.
2497 res-uid
2498 ;; 3. File gid.
2499 res-gid
2500 ;; 4. Last access time, as a list of two integers. First
2501 ;; integer has high-order 16 bits of time, second has low 16
2502 ;; bits.
2503 ;; 5. Last modification time, likewise.
2504 ;; 6. Last status change time, likewise.
2505 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2506 ;; 7. Size in bytes (-1, if number is out of range).
2507 res-size
2508 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2509 res-filemodes
2510 ;; 9. t if file's gid would change if file were deleted and
2511 ;; recreated. Will be set in `tramp-convert-file-attributes'
2512 t
2513 ;; 10. inode number.
2514 res-inode
2515 ;; 11. Device number. Will be replaced by a virtual device number.
2516 -1
2517 ))))
2518
2519 (defun tramp-handle-file-attributes-with-perl
2520 (vec localname &optional id-format)
2521 "Implement `file-attributes' for Tramp files using a Perl script."
2522 (tramp-message vec 5 "file attributes with perl: %s" localname)
2523 (tramp-maybe-send-script
2524 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
2525 (tramp-send-command-and-read
2526 vec
2527 (format "tramp_perl_file_attributes %s %s"
2528 (tramp-shell-quote-argument localname) id-format)))
2529
2530 (defun tramp-handle-file-attributes-with-stat
2531 (vec localname &optional id-format)
2532 "Implement `file-attributes' for Tramp files using stat(1) command."
2533 (tramp-message vec 5 "file attributes with stat: %s" localname)
2534 (tramp-send-command-and-read
2535 vec
2536 (format
2537 "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s"
2538 (tramp-get-remote-stat vec)
2539 (if (eq id-format 'integer) "%u" "\"%U\"")
2540 (if (eq id-format 'integer) "%g" "\"%G\"")
2541 (tramp-shell-quote-argument localname))))
2542
2543 (defun tramp-handle-set-visited-file-modtime (&optional time-list)
2544 "Like `set-visited-file-modtime' for Tramp files."
2545 (unless (buffer-file-name)
2546 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2547 (buffer-name)))
2548 (if time-list
2549 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2550 (let ((f (buffer-file-name))
2551 coding-system-used)
2552 (with-parsed-tramp-file-name f nil
2553 (let* ((attr (file-attributes f))
2554 ;; '(-1 65535) means file doesn't exists yet.
2555 (modtime (or (nth 5 attr) '(-1 65535))))
2556 (when (boundp 'last-coding-system-used)
2557 (setq coding-system-used (symbol-value 'last-coding-system-used)))
2558 ;; We use '(0 0) as a don't-know value. See also
2559 ;; `tramp-handle-file-attributes-with-ls'.
2560 (if (not (equal modtime '(0 0)))
2561 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2562 (progn
2563 (tramp-send-command
2564 v
2565 (format "%s -ild %s"
2566 (tramp-get-ls-command v)
2567 (tramp-shell-quote-argument localname)))
2568 (setq attr (buffer-substring (point)
2569 (progn (end-of-line) (point)))))
2570 (tramp-set-file-property
2571 v localname "visited-file-modtime-ild" attr))
2572 (when (boundp 'last-coding-system-used)
2573 (set 'last-coding-system-used coding-system-used))
2574 nil)))))
2575
2576 ;; CCC continue here
2577
2578 ;; This function makes the same assumption as
2579 ;; `tramp-handle-set-visited-file-modtime'.
2580 (defun tramp-handle-verify-visited-file-modtime (buf)
2581 "Like `verify-visited-file-modtime' for Tramp files.
2582 At the time `verify-visited-file-modtime' calls this function, we
2583 already know that the buffer is visiting a file and that
2584 `visited-file-modtime' does not return 0. Do not call this
2585 function directly, unless those two cases are already taken care
2586 of."
2587 (with-current-buffer buf
2588 ;; There is no file visiting the buffer, or the buffer has no
2589 ;; recorded last modification time.
2590 (if (or (not (buffer-file-name))
2591 (eq (visited-file-modtime) 0))
2592 t
2593 (let ((f (buffer-file-name)))
2594 (with-parsed-tramp-file-name f nil
2595 (tramp-flush-file-property v localname)
2596 (let* ((attr (file-attributes f))
2597 (modtime (nth 5 attr))
2598 (mt (visited-file-modtime)))
2599
2600 (cond
2601 ;; file exists, and has a known modtime.
2602 ((and attr (not (equal modtime '(0 0))))
2603 (< (abs (tramp-time-diff
2604 modtime
2605 ;; For compatibility, deal with both the old
2606 ;; (HIGH . LOW) and the new (HIGH LOW)
2607 ;; return values of `visited-file-modtime'.
2608 (if (atom (cdr mt))
2609 (list (car mt) (cdr mt))
2610 mt)))
2611 2))
2612 ;; modtime has the don't know value.
2613 (attr
2614 (tramp-send-command
2615 v
2616 (format "%s -ild %s"
2617 (tramp-get-ls-command v)
2618 (tramp-shell-quote-argument localname)))
2619 (with-current-buffer (tramp-get-buffer v)
2620 (setq attr (buffer-substring
2621 (point) (progn (end-of-line) (point)))))
2622 (equal
2623 attr
2624 (tramp-get-file-property
2625 v localname "visited-file-modtime-ild" "")))
2626 ;; If file does not exist, say it is not modified
2627 ;; if and only if that agrees with the buffer's record.
2628 (t (equal mt '(-1 65535))))))))))
2629
2630 (defun tramp-handle-set-file-modes (filename mode)
2631 "Like `set-file-modes' for Tramp files."
2632 (with-parsed-tramp-file-name filename nil
2633 (tramp-flush-file-property v localname)
2634 (unless (zerop (tramp-send-command-and-check
2635 v
2636 (format "chmod %s %s"
2637 (tramp-decimal-to-octal mode)
2638 (tramp-shell-quote-argument localname))))
2639 ;; FIXME: extract the proper text from chmod's stderr.
2640 (tramp-error
2641 v 'file-error "Error while changing file's mode %s" filename))))
2642
2643 (defun tramp-handle-set-file-times (filename &optional time)
2644 "Like `set-file-times' for Tramp files."
2645 (zerop
2646 (if (file-remote-p filename)
2647 (with-parsed-tramp-file-name filename nil
2648 (tramp-flush-file-property v localname)
2649 (let ((time (if (or (null time) (equal time '(0 0)))
2650 (current-time)
2651 time))
2652 (utc
2653 ;; With GNU Emacs, `format-time-string' has an
2654 ;; optional parameter UNIVERSAL. This is preferred,
2655 ;; because we could handle the case when the remote
2656 ;; host is located in a different time zone as the
2657 ;; local host.
2658 (and (functionp 'subr-arity)
2659 (subrp (symbol-function 'format-time-string))
2660 (= 3 (cdr (funcall (symbol-function 'subr-arity)
2661 (symbol-function
2662 'format-time-string)))))))
2663 (tramp-send-command-and-check
2664 v (format "%s touch -t %s %s"
2665 (if utc "TZ=UTC; export TZ;" "")
2666 (if utc
2667 (format-time-string "%Y%m%d%H%M.%S" time t)
2668 (format-time-string "%Y%m%d%H%M.%S" time))
2669 (tramp-shell-quote-argument localname)))))
2670
2671 ;; We handle also the local part, because in older Emacsen,
2672 ;; without `set-file-times', this function is an alias for this.
2673 ;; We are local, so we don't need the UTC settings.
2674 (tramp-local-call-process
2675 "touch" nil nil nil "-t"
2676 (format-time-string "%Y%m%d%H%M.%S" time)
2677 (tramp-shell-quote-argument filename)))))
2678
2679 (defun tramp-set-file-uid-gid (filename &optional uid gid)
2680 "Set the ownership for FILENAME.
2681 If UID and GID are provided, these values are used; otherwise uid
2682 and gid of the corresponding user is taken. Both parameters must be integers."
2683 ;; CCC: Modern Unices allow chown only for root. So we might need
2684 ;; another implementation, see `dired-do-chown'. OTOH, it is
2685 ;; mostly working with su(do)? when it is needed, so it shall
2686 ;; succeed in the majority of cases.
2687 (if (file-remote-p filename)
2688 (with-parsed-tramp-file-name filename nil
2689 (let ((uid (or (and (integerp uid) uid)
2690 (tramp-get-remote-uid v 'integer)))
2691 (gid (or (and (integerp gid) gid)
2692 (tramp-get-remote-gid v 'integer))))
2693 (tramp-send-command
2694 v (format
2695 "chown %d:%d %s" uid gid
2696 (tramp-shell-quote-argument localname)))))
2697
2698 ;; We handle also the local part, because there doesn't exist
2699 ;; `set-file-uid-gid'. On Win32 "chown" might not work.
2700 (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
2701 (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
2702 (tramp-local-call-process
2703 "chown" nil nil nil
2704 (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))
2705
2706 ;; Simple functions using the `test' command.
2707
2708 (defun tramp-handle-file-executable-p (filename)
2709 "Like `file-executable-p' for Tramp files."
2710 (with-parsed-tramp-file-name filename nil
2711 (with-file-property v localname "file-executable-p"
2712 (zerop (tramp-run-test "-x" filename)))))
2713
2714 (defun tramp-handle-file-readable-p (filename)
2715 "Like `file-readable-p' for Tramp files."
2716 (with-parsed-tramp-file-name filename nil
2717 (with-file-property v localname "file-readable-p"
2718 (zerop (tramp-run-test "-r" filename)))))
2719
2720 ;; When the remote shell is started, it looks for a shell which groks
2721 ;; tilde expansion. Here, we assume that all shells which grok tilde
2722 ;; expansion will also provide a `test' command which groks `-nt' (for
2723 ;; newer than). If this breaks, tell me about it and I'll try to do
2724 ;; something smarter about it.
2725 (defun tramp-handle-file-newer-than-file-p (file1 file2)
2726 "Like `file-newer-than-file-p' for Tramp files."
2727 (cond ((not (file-exists-p file1))
2728 nil)
2729 ((not (file-exists-p file2))
2730 t)
2731 ;; We are sure both files exist at this point.
2732 (t
2733 (save-excursion
2734 ;; We try to get the mtime of both files. If they are not
2735 ;; equal to the "dont-know" value, then we subtract the times
2736 ;; and obtain the result.
2737 (let ((fa1 (file-attributes file1))
2738 (fa2 (file-attributes file2)))
2739 (if (and (not (equal (nth 5 fa1) '(0 0)))
2740 (not (equal (nth 5 fa2) '(0 0))))
2741 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
2742 ;; If one of them is the dont-know value, then we can
2743 ;; still try to run a shell command on the remote host.
2744 ;; However, this only works if both files are Tramp
2745 ;; files and both have the same method, same user, same
2746 ;; host.
2747 (unless (tramp-equal-remote file1 file2)
2748 (with-parsed-tramp-file-name
2749 (if (tramp-tramp-file-p file1) file1 file2) nil
2750 (tramp-error
2751 v 'file-error
2752 "Files %s and %s must have same method, user, host"
2753 file1 file2)))
2754 (with-parsed-tramp-file-name file1 nil
2755 (zerop (tramp-run-test2
2756 (tramp-get-test-nt-command v) file1 file2)))))))))
2757
2758 ;; Functions implemented using the basic functions above.
2759
2760 (defun tramp-handle-file-modes (filename)
2761 "Like `file-modes' for Tramp files."
2762 (let ((truename (or (file-truename filename) filename)))
2763 (when (file-exists-p truename)
2764 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
2765
2766 (defun tramp-default-file-modes (filename)
2767 "Return file modes of FILENAME as integer.
2768 If the file modes of FILENAME cannot be determined, return the
2769 value of `default-file-modes'."
2770 (or (file-modes filename) (default-file-modes)))
2771
2772 (defun tramp-handle-file-directory-p (filename)
2773 "Like `file-directory-p' for Tramp files."
2774 ;; Care must be taken that this function returns `t' for symlinks
2775 ;; pointing to directories. Surely the most obvious implementation
2776 ;; would be `test -d', but that returns false for such symlinks.
2777 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
2778 ;; I now think he's right. So we could be using `test -d', couldn't
2779 ;; we?
2780 ;;
2781 ;; Alternatives: `cd %s', `test -d %s'
2782 (with-parsed-tramp-file-name filename nil
2783 (with-file-property v localname "file-directory-p"
2784 (zerop (tramp-run-test "-d" filename)))))
2785
2786 (defun tramp-handle-file-regular-p (filename)
2787 "Like `file-regular-p' for Tramp files."
2788 (and (file-exists-p filename)
2789 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
2790
2791 (defun tramp-handle-file-symlink-p (filename)
2792 "Like `file-symlink-p' for Tramp files."
2793 (with-parsed-tramp-file-name filename nil
2794 (let ((x (car (file-attributes filename))))
2795 (when (stringp x)
2796 ;; When Tramp is running on VMS, then `file-name-absolute-p'
2797 ;; might do weird things.
2798 (if (file-name-absolute-p x)
2799 (tramp-make-tramp-file-name method user host x)
2800 x)))))
2801
2802 (defun tramp-handle-file-writable-p (filename)
2803 "Like `file-writable-p' for Tramp files."
2804 (with-parsed-tramp-file-name filename nil
2805 (with-file-property v localname "file-writable-p"
2806 (if (file-exists-p filename)
2807 ;; Existing files must be writable.
2808 (zerop (tramp-run-test "-w" filename))
2809 ;; If file doesn't exist, check if directory is writable.
2810 (and (zerop (tramp-run-test
2811 "-d" (file-name-directory filename)))
2812 (zerop (tramp-run-test
2813 "-w" (file-name-directory filename))))))))
2814
2815 (defun tramp-handle-file-ownership-preserved-p (filename)
2816 "Like `file-ownership-preserved-p' for Tramp files."
2817 (with-parsed-tramp-file-name filename nil
2818 (with-file-property v localname "file-ownership-preserved-p"
2819 (let ((attributes (file-attributes filename)))
2820 ;; Return t if the file doesn't exist, since it's true that no
2821 ;; information would be lost by an (attempted) delete and create.
2822 (or (null attributes)
2823 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
2824
2825 ;; Other file name ops.
2826
2827 (defun tramp-handle-directory-file-name (directory)
2828 "Like `directory-file-name' for Tramp files."
2829 ;; If localname component of filename is "/", leave it unchanged.
2830 ;; Otherwise, remove any trailing slash from localname component.
2831 ;; Method, host, etc, are unchanged. Does it make sense to try
2832 ;; to avoid parsing the filename?
2833 (with-parsed-tramp-file-name directory nil
2834 (if (and (not (zerop (length localname)))
2835 (eq (aref localname (1- (length localname))) ?/)
2836 (not (string= localname "/")))
2837 (substring directory 0 -1)
2838 directory)))
2839
2840 ;; Directory listings.
2841
2842 (defun tramp-handle-directory-files
2843 (directory &optional full match nosort files-only)
2844 "Like `directory-files' for Tramp files."
2845 ;; FILES-ONLY is valid for XEmacs only.
2846 (when (file-directory-p directory)
2847 (setq directory (expand-file-name directory))
2848 (let ((temp (nreverse (file-name-all-completions "" directory)))
2849 result item)
2850
2851 (while temp
2852 (setq item (directory-file-name (pop temp)))
2853 (when (and (or (null match) (string-match match item))
2854 (or (null files-only)
2855 ;; files only
2856 (and (equal files-only t) (file-regular-p item))
2857 ;; directories only
2858 (file-directory-p item)))
2859 (push (if full (expand-file-name item directory) item)
2860 result)))
2861 result)))
2862
2863 (defun tramp-handle-directory-files-and-attributes
2864 (directory &optional full match nosort id-format)
2865 "Like `directory-files-and-attributes' for Tramp files."
2866 (unless id-format (setq id-format 'integer))
2867 (when (file-directory-p directory)
2868 (setq directory (expand-file-name directory))
2869 (let* ((temp
2870 (tramp-compat-copy-tree
2871 (with-parsed-tramp-file-name directory nil
2872 (with-file-property
2873 v localname
2874 (format "directory-files-and-attributes-%s" id-format)
2875 (save-excursion
2876 (mapcar
2877 '(lambda (x)
2878 (cons (car x)
2879 (tramp-convert-file-attributes v (cdr x))))
2880 (if (tramp-get-remote-stat v)
2881 (tramp-handle-directory-files-and-attributes-with-stat
2882 v localname id-format)
2883 (if (tramp-get-remote-perl v)
2884 (tramp-handle-directory-files-and-attributes-with-perl
2885 v localname id-format)))))))))
2886 result item)
2887
2888 (while temp
2889 (setq item (pop temp))
2890 (when (or (null match) (string-match match (car item)))
2891 (when full
2892 (setcar item (expand-file-name (car item) directory)))
2893 (push item result)))
2894
2895 (if nosort
2896 result
2897 (sort result (lambda (x y) (string< (car x) (car y))))))))
2898
2899 (defun tramp-handle-directory-files-and-attributes-with-perl
2900 (vec localname &optional id-format)
2901 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
2902 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
2903 (tramp-maybe-send-script
2904 vec tramp-perl-directory-files-and-attributes
2905 "tramp_perl_directory_files_and_attributes")
2906 (let ((object
2907 (tramp-send-command-and-read
2908 vec
2909 (format "tramp_perl_directory_files_and_attributes %s %s"
2910 (tramp-shell-quote-argument localname) id-format))))
2911 (when (stringp object) (tramp-error vec 'file-error object))
2912 object))
2913
2914 (defun tramp-handle-directory-files-and-attributes-with-stat
2915 (vec localname &optional id-format)
2916 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
2917 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
2918 (tramp-send-command-and-read
2919 vec
2920 (format
2921 (concat
2922 "cd %s; echo \"(\"; (%s -ab | xargs "
2923 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); "
2924 "echo \")\"")
2925 (tramp-shell-quote-argument localname)
2926 (tramp-get-ls-command vec)
2927 (tramp-get-remote-stat vec)
2928 (if (eq id-format 'integer) "%u" "\"%U\"")
2929 (if (eq id-format 'integer) "%g" "\"%G\""))))
2930
2931 ;; This function should return "foo/" for directories and "bar" for
2932 ;; files.
2933 (defun tramp-handle-file-name-all-completions (filename directory)
2934 "Like `file-name-all-completions' for Tramp files."
2935 (unless (save-match-data (string-match "/" filename))
2936 (with-parsed-tramp-file-name (expand-file-name directory) nil
2937 ;; Flush the directory cache. There could be changed directory
2938 ;; contents.
2939 (when (and (integerp tramp-completion-reread-directory-timeout)
2940 (> (tramp-time-diff
2941 (current-time)
2942 (tramp-get-file-property
2943 v localname "last-completion" '(0 0 0)))
2944 tramp-completion-reread-directory-timeout))
2945 (tramp-flush-file-property v localname))
2946
2947 (all-completions
2948 filename
2949 (mapcar
2950 'list
2951 (with-file-property v localname "file-name-all-completions"
2952 (let (result)
2953 (tramp-barf-unless-okay
2954 v
2955 (format "cd %s" (tramp-shell-quote-argument localname))
2956 "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
2957 (tramp-shell-quote-argument localname))
2958
2959 ;; Get a list of directories and files, including reliably
2960 ;; tagging the directories with a trailing '/'. Because I
2961 ;; rock. --daniel@danann.net
2962 (tramp-send-command
2963 v
2964 (format (concat "%s -ab 2>/dev/null | while read f; do "
2965 "if %s -d \"$f\" 2>/dev/null; "
2966 "then echo \"$f/\"; else echo \"$f\"; fi; done")
2967 (tramp-get-ls-command v)
2968 (tramp-get-test-command v)))
2969
2970 ;; Now grab the output.
2971 (with-current-buffer (tramp-get-buffer v)
2972 (goto-char (point-max))
2973 (while (zerop (forward-line -1))
2974 (push (buffer-substring
2975 (point) (tramp-compat-line-end-position))
2976 result)))
2977
2978 (tramp-set-file-property
2979 v localname "last-completion" (current-time))
2980 result)))))))
2981
2982 ;; The following isn't needed for Emacs 20 but for 19.34?
2983 (defun tramp-handle-file-name-completion
2984 (filename directory &optional predicate)
2985 "Like `file-name-completion' for Tramp files."
2986 (unless (tramp-tramp-file-p directory)
2987 (error
2988 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2989 directory))
2990 (try-completion
2991 filename
2992 (mapcar 'list (file-name-all-completions filename directory))
2993 (when predicate
2994 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
2995
2996 ;; cp, mv and ln
2997
2998 (defun tramp-handle-add-name-to-file
2999 (filename newname &optional ok-if-already-exists)
3000 "Like `add-name-to-file' for Tramp files."
3001 (unless (tramp-equal-remote filename newname)
3002 (with-parsed-tramp-file-name
3003 (if (tramp-tramp-file-p filename) filename newname) nil
3004 (tramp-error
3005 v 'file-error
3006 "add-name-to-file: %s"
3007 "only implemented for same method, same user, same host")))
3008 (with-parsed-tramp-file-name filename v1
3009 (with-parsed-tramp-file-name newname v2
3010 (let ((ln (when v1 (tramp-get-remote-ln v1))))
3011 (when (and (not ok-if-already-exists)
3012 (file-exists-p newname)
3013 (not (numberp ok-if-already-exists))
3014 (y-or-n-p
3015 (format
3016 "File %s already exists; make it a new name anyway? "
3017 newname)))
3018 (tramp-error
3019 v2 'file-error
3020 "add-name-to-file: file %s already exists" newname))
3021 (tramp-flush-file-property v2 v2-localname)
3022 (tramp-barf-unless-okay
3023 v1
3024 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
3025 (tramp-shell-quote-argument v2-localname))
3026 "error with add-name-to-file, see buffer `%s' for details"
3027 (buffer-name))))))
3028
3029 (defun tramp-handle-copy-file
3030 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
3031 "Like `copy-file' for Tramp files."
3032 ;; Check if both files are local -- invoke normal copy-file.
3033 ;; Otherwise, use Tramp from local system.
3034 (setq filename (expand-file-name filename))
3035 (setq newname (expand-file-name newname))
3036 (cond
3037 ;; At least one file a Tramp file?
3038 ((or (tramp-tramp-file-p filename)
3039 (tramp-tramp-file-p newname))
3040 (tramp-do-copy-or-rename-file
3041 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
3042 ;; Compat section.
3043 (preserve-uid-gid
3044 (tramp-run-real-handler
3045 'copy-file
3046 (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
3047 (t
3048 (tramp-run-real-handler
3049 'copy-file (list filename newname ok-if-already-exists keep-date)))))
3050
3051 (defun tramp-handle-rename-file
3052 (filename newname &optional ok-if-already-exists)
3053 "Like `rename-file' for Tramp files."
3054 ;; Check if both files are local -- invoke normal rename-file.
3055 ;; Otherwise, use Tramp from local system.
3056 (setq filename (expand-file-name filename))
3057 (setq newname (expand-file-name newname))
3058 ;; At least one file a Tramp file?
3059 (if (or (tramp-tramp-file-p filename)
3060 (tramp-tramp-file-p newname))
3061 (tramp-do-copy-or-rename-file
3062 'rename filename newname ok-if-already-exists t t)
3063 (tramp-run-real-handler
3064 'rename-file (list filename newname ok-if-already-exists))))
3065
3066 (defun tramp-do-copy-or-rename-file
3067 (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
3068 "Copy or rename a remote file.
3069 OP must be `copy' or `rename' and indicates the operation to perform.
3070 FILENAME specifies the file to copy or rename, NEWNAME is the name of
3071 the new file (for copy) or the new name of the file (for rename).
3072 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
3073 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3074 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3075 the uid and gid if both files are on the same host.
3076
3077 This function is invoked by `tramp-handle-copy-file' and
3078 `tramp-handle-rename-file'. It is an error if OP is neither of `copy'
3079 and `rename'. FILENAME and NEWNAME must be absolute file names."
3080 (unless (memq op '(copy rename))
3081 (error "Unknown operation `%s', must be `copy' or `rename'" op))
3082 (let ((t1 (tramp-tramp-file-p filename))
3083 (t2 (tramp-tramp-file-p newname)))
3084
3085 (when (and (not ok-if-already-exists) (file-exists-p newname))
3086 (with-parsed-tramp-file-name (if t1 filename newname) nil
3087 (tramp-error
3088 v 'file-already-exists "File %s already exists" newname)))
3089
3090 (prog1
3091 (cond
3092 ;; Both are Tramp files.
3093 ((and t1 t2)
3094 (with-parsed-tramp-file-name filename v1
3095 (with-parsed-tramp-file-name newname v2
3096 (cond
3097 ;; Shortcut: if method, host, user are the same for both
3098 ;; files, we invoke `cp' or `mv' on the remote host
3099 ;; directly.
3100 ((tramp-equal-remote filename newname)
3101 (tramp-do-copy-or-rename-file-directly
3102 op filename newname
3103 ok-if-already-exists keep-date preserve-uid-gid))
3104
3105 ;; If both source and target are Tramp files,
3106 ;; both are using the same copy-program, then we
3107 ;; can invoke rcp directly. Note that
3108 ;; default-directory should point to a local
3109 ;; directory if we want to invoke rcp.
3110 ((and (equal v1-method v2-method)
3111 (tramp-method-out-of-band-p v1)
3112 (> (nth 7 (file-attributes filename))
3113 tramp-copy-size-limit))
3114 (tramp-do-copy-or-rename-file-out-of-band
3115 op filename newname keep-date))
3116
3117 ;; No shortcut was possible. So we copy the
3118 ;; file first. If the operation was `rename', we go
3119 ;; back and delete the original file (if the copy was
3120 ;; successful). The approach is simple-minded: we
3121 ;; create a new buffer, insert the contents of the
3122 ;; source file into it, then write out the buffer to
3123 ;; the target file. The advantage is that it doesn't
3124 ;; matter which filename handlers are used for the
3125 ;; source and target file.
3126 (t
3127 (tramp-do-copy-or-rename-file-via-buffer
3128 op filename newname keep-date))))))
3129
3130 ;; One file is a Tramp file, the other one is local.
3131 ((or t1 t2)
3132 (with-parsed-tramp-file-name (if t1 filename newname) nil
3133 (cond
3134 ;; Fast track on local machine.
3135 ((tramp-local-host-p v)
3136 (tramp-do-copy-or-rename-file-directly
3137 op filename newname
3138 ok-if-already-exists keep-date preserve-uid-gid))
3139
3140 ;; If the Tramp file has an out-of-band method, the corresponding
3141 ;; copy-program can be invoked.
3142 ((and (tramp-method-out-of-band-p v)
3143 (> (nth 7 (file-attributes filename))
3144 tramp-copy-size-limit))
3145 (tramp-do-copy-or-rename-file-out-of-band
3146 op filename newname keep-date))
3147
3148 ;; Use the inline method via a Tramp buffer.
3149 (t (tramp-do-copy-or-rename-file-via-buffer
3150 op filename newname keep-date)))))
3151
3152 (t
3153 ;; One of them must be a Tramp file.
3154 (error "Tramp implementation says this cannot happen")))
3155
3156 ;; In case of `rename', we must flush the cache of the source file.
3157 (when (and t1 (eq op 'rename))
3158 (with-parsed-tramp-file-name filename nil
3159 (tramp-flush-file-property v localname)))
3160
3161 ;; When newname did exist, we have wrong cached values.
3162 (when t2
3163 (with-parsed-tramp-file-name newname nil
3164 (tramp-flush-file-property v localname))))))
3165
3166 (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
3167 "Use an Emacs buffer to copy or rename a file.
3168 First arg OP is either `copy' or `rename' and indicates the operation.
3169 FILENAME is the source file, NEWNAME the target file.
3170 KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
3171 (with-temp-buffer
3172 ;; We must disable multibyte, because binary data shall not be
3173 ;; converted.
3174 (set-buffer-multibyte nil)
3175 (let ((coding-system-for-read 'binary)
3176 (jka-compr-inhibit t))
3177 (insert-file-contents-literally filename))
3178 ;; We don't want the target file to be compressed, so we let-bind
3179 ;; `jka-compr-inhibit' to t.
3180 (let ((coding-system-for-write 'binary)
3181 (jka-compr-inhibit t))
3182 (write-region (point-min) (point-max) newname)))
3183 ;; KEEP-DATE handling.
3184 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
3185 ;; Set the mode.
3186 (set-file-modes newname (tramp-default-file-modes filename))
3187 ;; If the operation was `rename', delete the original file.
3188 (unless (eq op 'copy) (delete-file filename)))
3189
3190 (defun tramp-do-copy-or-rename-file-directly
3191 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
3192 "Invokes `cp' or `mv' on the remote system.
3193 OP must be one of `copy' or `rename', indicating `cp' or `mv',
3194 respectively. FILENAME specifies the file to copy or rename,
3195 NEWNAME is the name of the new file (for copy) or the new name of
3196 the file (for rename). Both files must reside on the same host.
3197 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3198 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3199 the uid and gid from FILENAME."
3200 (let ((t1 (tramp-tramp-file-p filename))
3201 (t2 (tramp-tramp-file-p newname)))
3202 (with-parsed-tramp-file-name (if t1 filename newname) nil
3203 (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
3204 ((eq op 'copy) "cp -f")
3205 ((eq op 'rename) "mv -f")
3206 (t (tramp-error
3207 v 'file-error
3208 "Unknown operation `%s', must be `copy' or `rename'"
3209 op))))
3210 (localname1
3211 (if t1 (tramp-handle-file-remote-p filename 'localname) filename))
3212 (localname2
3213 (if t2 (tramp-handle-file-remote-p newname 'localname) newname))
3214 (prefix (file-remote-p (if t1 filename newname))))
3215
3216 (cond
3217 ;; Both files are on a remote host, with same user.
3218 ((and t1 t2)
3219 (tramp-send-command
3220 v
3221 (format "%s %s %s" cmd
3222 (tramp-shell-quote-argument localname1)
3223 (tramp-shell-quote-argument localname2)))
3224 (with-current-buffer (tramp-get-buffer v)
3225 (goto-char (point-min))
3226 (unless
3227 (or
3228 (and keep-date
3229 ;; Mask cp -f error.
3230 (re-search-forward
3231 tramp-operation-not-permitted-regexp nil t))
3232 (zerop (tramp-send-command-and-check v nil)))
3233 (tramp-error-with-buffer
3234 nil v 'file-error
3235 "Copying directly failed, see buffer `%s' for details."
3236 (buffer-name)))))
3237
3238 ;; We are on the local host.
3239 ((or t1 t2)
3240 (cond
3241 ;; We can do it directly.
3242 ((let (file-name-handler-alist)
3243 (and (file-readable-p localname1)
3244 (file-writable-p (file-name-directory localname2))
3245 (or (file-directory-p localname2)
3246 (file-writable-p localname2))))
3247 (if (eq op 'copy)
3248 (tramp-compat-copy-file
3249 localname1 localname2 ok-if-already-exists
3250 keep-date preserve-uid-gid)
3251 (tramp-run-real-handler
3252 'rename-file (list localname1 localname2 ok-if-already-exists))))
3253
3254 ;; We can do it directly with `tramp-send-command'
3255 ((let (file-name-handler-alist)
3256 (and (file-readable-p (concat prefix localname1))
3257 (file-writable-p
3258 (file-name-directory (concat prefix localname2)))))
3259 (tramp-do-copy-or-rename-file-directly
3260 op (concat prefix localname1) (concat prefix localname2)
3261 ok-if-already-exists keep-date t)
3262 ;; We must change the ownership to the local user.
3263 (tramp-set-file-uid-gid
3264 (concat prefix localname2)
3265 (tramp-get-local-uid 'integer)
3266 (tramp-get-local-gid 'integer)))
3267
3268 ;; We need a temporary file in between.
3269 (t
3270 ;; Create the temporary file.
3271 (let ((tmpfile (tramp-compat-make-temp-file localname1)))
3272 (condition-case err
3273 (progn
3274 (cond
3275 (t1
3276 (tramp-send-command
3277 v (format
3278 "%s %s %s" cmd
3279 (tramp-shell-quote-argument localname1)
3280 (tramp-shell-quote-argument tmpfile)))
3281 ;; We must change the ownership as remote user.
3282 (tramp-set-file-uid-gid
3283 (concat prefix tmpfile)
3284 (tramp-get-local-uid 'integer)
3285 (tramp-get-local-gid 'integer)))
3286 (t2
3287 (if (eq op 'copy)
3288 (tramp-compat-copy-file
3289 localname1 tmpfile ok-if-already-exists
3290 keep-date preserve-uid-gid)
3291 (tramp-run-real-handler
3292 'rename-file
3293 (list localname1 tmpfile ok-if-already-exists)))
3294 ;; We must change the ownership as local user.
3295 (tramp-set-file-uid-gid
3296 tmpfile
3297 (tramp-get-remote-uid v 'integer)
3298 (tramp-get-remote-gid v 'integer))))
3299
3300 ;; Move the temporary file to its destination.
3301 (cond
3302 (t2
3303 (tramp-send-command
3304 v (format
3305 "mv -f %s %s"
3306 (tramp-shell-quote-argument tmpfile)
3307 (tramp-shell-quote-argument localname2))))
3308 (t1
3309 (tramp-run-real-handler
3310 'rename-file
3311 (list tmpfile localname2 ok-if-already-exists)))))
3312
3313 ;; Error handling.
3314 ((error quit)
3315 (delete-file tmpfile)
3316 (signal (car err) (cdr err))))))))))
3317
3318 ;; Set the time and mode. Mask possible errors.
3319 ;; Won't be applied for 'rename.
3320 (condition-case nil
3321 (when (and keep-date (not preserve-uid-gid))
3322 (set-file-times newname (nth 5 (file-attributes filename)))
3323 (set-file-modes newname (tramp-default-file-modes filename)))
3324 (error)))))
3325
3326 (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
3327 "Invoke rcp program to copy.
3328 One of FILENAME and NEWNAME must be a Tramp name, the other must
3329 be a local filename. The method used must be an out-of-band method."
3330 (let ((t1 (tramp-tramp-file-p filename))
3331 (t2 (tramp-tramp-file-p newname))
3332 copy-program copy-args copy-keep-date port spec
3333 source target)
3334
3335 (with-parsed-tramp-file-name (if t1 filename newname) nil
3336
3337 ;; Expand hops. Might be necessary for gateway methods.
3338 (setq v (car (tramp-compute-multi-hops v)))
3339 (aset v 3 localname)
3340
3341 ;; Check which ones of source and target are Tramp files.
3342 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
3343 target (if t2 (tramp-make-copy-program-file-name v) newname))
3344
3345 ;; Check for port number. Until now, there's no need for handling
3346 ;; like method, user, host.
3347 (setq host (tramp-file-name-real-host v)
3348 port (tramp-file-name-port v)
3349 port (or (and port (number-to-string port)) ""))
3350
3351 ;; Compose copy command.
3352 (setq spec `((?h . ,host) (?u . ,user) (?p . ,port)
3353 (?t . ,(tramp-get-connection-property
3354 (tramp-get-connection-process v) "temp-file" ""))
3355 (?k . ,(if keep-date " " "")))
3356 copy-program (tramp-get-method-parameter
3357 method 'tramp-copy-program)
3358 copy-keep-date (tramp-get-method-parameter
3359 method 'tramp-copy-keep-date)
3360 copy-args
3361 (delq
3362 nil
3363 (mapcar
3364 '(lambda (x)
3365 (setq
3366 ;; " " is indication for keep-date argument.
3367 x (delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
3368 (unless (member "" x) (mapconcat 'identity x " ")))
3369 (tramp-get-method-parameter method 'tramp-copy-args))))
3370
3371 ;; Check for program.
3372 (when (and (fboundp 'executable-find)
3373 (not (let ((default-directory
3374 (tramp-compat-temporary-file-directory)))
3375 (executable-find copy-program))))
3376 (tramp-error
3377 v 'file-error "Cannot find copy program: %s" copy-program))
3378
3379 (tramp-message v 0 "Transferring %s to %s..." filename newname)
3380
3381 (unwind-protect
3382 (with-temp-buffer
3383 ;; The default directory must be remote.
3384 (let ((default-directory
3385 (file-name-directory (if t1 filename newname))))
3386 ;; Set the transfer process properties.
3387 (tramp-set-connection-property
3388 v "process-name" (buffer-name (current-buffer)))
3389 (tramp-set-connection-property
3390 v "process-buffer" (current-buffer))
3391
3392 ;; Use an asynchronous process. By this, password can
3393 ;; be handled. The default directory must be local, in
3394 ;; order to apply the correct `copy-program'. We don't
3395 ;; set a timeout, because the copying of large files can
3396 ;; last longer than 60 secs.
3397 (let ((p (let ((default-directory
3398 (tramp-compat-temporary-file-directory)))
3399 (apply 'start-process
3400 (tramp-get-connection-property
3401 v "process-name" nil)
3402 (tramp-get-connection-property
3403 v "process-buffer" nil)
3404 copy-program
3405 (append copy-args (list source target))))))
3406 (tramp-message
3407 v 6 "%s" (mapconcat 'identity (process-command p) " "))
3408 (tramp-set-process-query-on-exit-flag p nil)
3409 (tramp-process-actions p v tramp-actions-copy-out-of-band))))
3410
3411 ;; Reset the transfer process properties.
3412 (tramp-set-connection-property v "process-name" nil)
3413 (tramp-set-connection-property v "process-buffer" nil))
3414
3415 (tramp-message v 0 "Transferring %s to %s...done" filename newname)
3416
3417 ;; Handle KEEP-DATE argument.
3418 (when (and keep-date (not copy-keep-date))
3419 (set-file-times newname (nth 5 (file-attributes filename))))
3420
3421 ;; Set the mode.
3422 (unless (and keep-date copy-keep-date)
3423 (set-file-modes newname (tramp-default-file-modes filename))))
3424
3425 ;; If the operation was `rename', delete the original file.
3426 (unless (eq op 'copy)
3427 (delete-file filename))))
3428
3429 (defun tramp-handle-make-directory (dir &optional parents)
3430 "Like `make-directory' for Tramp files."
3431 (setq dir (expand-file-name dir))
3432 (with-parsed-tramp-file-name dir nil
3433 (save-excursion
3434 (tramp-barf-unless-okay
3435 v
3436 (format "%s %s"
3437 (if parents "mkdir -p" "mkdir")
3438 (tramp-shell-quote-argument localname))
3439 "Couldn't make directory %s" dir))))
3440
3441 (defun tramp-handle-delete-directory (directory)
3442 "Like `delete-directory' for Tramp files."
3443 (setq directory (expand-file-name directory))
3444 (with-parsed-tramp-file-name directory nil
3445 (tramp-flush-directory-property v localname)
3446 (unless (zerop (tramp-send-command-and-check
3447 v
3448 (format "rmdir %s" (tramp-shell-quote-argument localname))))
3449 (tramp-error v 'file-error "Couldn't delete %s" directory))))
3450
3451 (defun tramp-handle-delete-file (filename)
3452 "Like `delete-file' for Tramp files."
3453 (setq filename (expand-file-name filename))
3454 (with-parsed-tramp-file-name filename nil
3455 (tramp-flush-file-property v localname)
3456 (unless (zerop (tramp-send-command-and-check
3457 v
3458 (format "rm -f %s"
3459 (tramp-shell-quote-argument localname))))
3460 (tramp-error v 'file-error "Couldn't delete %s" filename))))
3461
3462 ;; Dired.
3463
3464 ;; CCC: This does not seem to be enough. Something dies when
3465 ;; we try and delete two directories under Tramp :/
3466 (defun tramp-handle-dired-recursive-delete-directory (filename)
3467 "Recursively delete the directory given.
3468 This is like `dired-recursive-delete-directory' for Tramp files."
3469 (with-parsed-tramp-file-name filename nil
3470 (tramp-flush-directory-property v filename)
3471 ;; Run a shell command 'rm -r <localname>'
3472 ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
3473 (unless (file-exists-p filename)
3474 (tramp-error v 'file-error "No such directory: %s" filename))
3475 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
3476 (tramp-send-command
3477 v
3478 (format "rm -rf %s" (tramp-shell-quote-argument localname))
3479 ;; Don't read the output, do it explicitely.
3480 nil t)
3481 ;; Wait for the remote system to return to us...
3482 ;; This might take a while, allow it plenty of time.
3483 (tramp-wait-for-output (tramp-get-connection-process v) 120)
3484 ;; Make sure that it worked...
3485 (and (file-exists-p filename)
3486 (tramp-error
3487 v 'file-error "Failed to recursively delete %s" filename))))
3488
3489 (defun tramp-handle-dired-compress-file (file &rest ok-flag)
3490 "Like `dired-compress-file' for Tramp files."
3491 ;; OK-FLAG is valid for XEmacs only, but not implemented.
3492 ;; Code stolen mainly from dired-aux.el.
3493 (with-parsed-tramp-file-name file nil
3494 (tramp-flush-file-property v localname)
3495 (save-excursion
3496 (let ((suffixes
3497 (if (not (featurep 'xemacs))
3498 ;; Emacs case
3499 (symbol-value 'dired-compress-file-suffixes)
3500 ;; XEmacs has `dired-compression-method-alist', which is
3501 ;; transformed into `dired-compress-file-suffixes' structure.
3502 (mapcar
3503 '(lambda (x)
3504 (list (concat (regexp-quote (nth 1 x)) "\\'")
3505 nil
3506 (mapconcat 'identity (nth 3 x) " ")))
3507 (symbol-value 'dired-compression-method-alist))))
3508 suffix)
3509 ;; See if any suffix rule matches this file name.
3510 (while suffixes
3511 (let (case-fold-search)
3512 (if (string-match (car (car suffixes)) localname)
3513 (setq suffix (car suffixes) suffixes nil))
3514 (setq suffixes (cdr suffixes))))
3515
3516 (cond ((file-symlink-p file)
3517 nil)
3518 ((and suffix (nth 2 suffix))
3519 ;; We found an uncompression rule.
3520 (tramp-message v 0 "Uncompressing %s..." file)
3521 (when (zerop (tramp-send-command-and-check
3522 v (concat (nth 2 suffix) " " localname)))
3523 (tramp-message v 0 "Uncompressing %s...done" file)
3524 ;; `dired-remove-file' is not defined in XEmacs
3525 (funcall (symbol-function 'dired-remove-file) file)
3526 (string-match (car suffix) file)
3527 (concat (substring file 0 (match-beginning 0)))))
3528 (t
3529 ;; We don't recognize the file as compressed, so compress it.
3530 ;; Try gzip.
3531 (tramp-message v 0 "Compressing %s..." file)
3532 (when (zerop (tramp-send-command-and-check
3533 v (concat "gzip -f " localname)))
3534 (tramp-message v 0 "Compressing %s...done" file)
3535 ;; `dired-remove-file' is not defined in XEmacs
3536 (funcall (symbol-function 'dired-remove-file) file)
3537 (cond ((file-exists-p (concat file ".gz"))
3538 (concat file ".gz"))
3539 ((file-exists-p (concat file ".z"))
3540 (concat file ".z"))
3541 (t nil)))))))))
3542
3543 ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
3544 ;; not sure at all that this is the right way to do it, but let's hope
3545 ;; it works for now, and wait for a guru to point out the Right Way to
3546 ;; achieve this.
3547 ;;(eval-when-compile
3548 ;; (unless (fboundp 'dired-insert-set-properties)
3549 ;; (fset 'dired-insert-set-properties 'ignore)))
3550 ;; Gerd suggests this:
3551 (eval-when-compile (require 'dired))
3552 ;; Note that dired is required at run-time, too, when it is needed.
3553 ;; It is only needed on XEmacs for the function
3554 ;; `dired-insert-set-properties'.
3555
3556 (defun tramp-handle-insert-directory
3557 (filename switches &optional wildcard full-directory-p)
3558 "Like `insert-directory' for Tramp files."
3559 (setq filename (expand-file-name filename))
3560 (with-parsed-tramp-file-name filename nil
3561 (tramp-flush-file-property v localname)
3562 (if (and (featurep 'ls-lisp)
3563 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
3564 (tramp-run-real-handler
3565 'insert-directory (list filename switches wildcard full-directory-p))
3566 ;; For the moment, we assume that the remote "ls" program does not
3567 ;; grok "--dired". In the future, we should detect this on
3568 ;; connection setup.
3569 (when (string-match "^--dired\\s-+" switches)
3570 (setq switches (replace-match "" nil t switches)))
3571 (tramp-message
3572 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
3573 switches filename (if wildcard "yes" "no")
3574 (if full-directory-p "yes" "no"))
3575 (when wildcard
3576 (setq wildcard (tramp-run-real-handler
3577 'file-name-nondirectory (list localname)))
3578 (setq localname (tramp-run-real-handler
3579 'file-name-directory (list localname))))
3580 (when (listp switches)
3581 (setq switches (mapconcat 'identity switches " ")))
3582 (unless full-directory-p
3583 (setq switches (concat "-d " switches)))
3584 (when wildcard
3585 (setq switches (concat switches " " wildcard)))
3586 ;; If `full-directory-p', we just say `ls -l FILENAME'.
3587 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
3588 (if full-directory-p
3589 (tramp-send-command
3590 v
3591 (format "%s %s %s"
3592 (tramp-get-ls-command v)
3593 switches
3594 (if wildcard
3595 localname
3596 (tramp-shell-quote-argument (concat localname ".")))))
3597 (tramp-barf-unless-okay
3598 v
3599 (format "cd %s" (tramp-shell-quote-argument
3600 (tramp-run-real-handler
3601 'file-name-directory (list localname))))
3602 "Couldn't `cd %s'"
3603 (tramp-shell-quote-argument
3604 (tramp-run-real-handler 'file-name-directory (list localname))))
3605 (tramp-send-command
3606 v
3607 (format "%s %s %s"
3608 (tramp-get-ls-command v)
3609 switches
3610 (if (or wildcard
3611 (zerop (length
3612 (tramp-run-real-handler
3613 'file-name-nondirectory (list localname)))))
3614 ""
3615 (tramp-shell-quote-argument
3616 (tramp-run-real-handler
3617 'file-name-nondirectory (list localname)))))))
3618 ;; We cannot use `insert-buffer-substring' because the Tramp buffer
3619 ;; changes its contents before insertion due to calling
3620 ;; `expand-file' and alike.
3621 (insert
3622 (with-current-buffer (tramp-get-buffer v)
3623 (buffer-string))))))
3624
3625 (defun tramp-handle-unhandled-file-name-directory (filename)
3626 "Like `unhandled-file-name-directory' for Tramp files."
3627 ;; With Emacs 23, we could simply return `nil'. But we must keep it
3628 ;; for backward compatibility.
3629 (expand-file-name "~/"))
3630
3631 ;; Canonicalization of file names.
3632
3633 (defun tramp-handle-expand-file-name (name &optional dir)
3634 "Like `expand-file-name' for Tramp files.
3635 If the localname part of the given filename starts with \"/../\" then
3636 the result will be a local, non-Tramp, filename."
3637 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
3638 (setq dir (or dir default-directory "/"))
3639 ;; Unless NAME is absolute, concat DIR and NAME.
3640 (unless (file-name-absolute-p name)
3641 (setq name (concat (file-name-as-directory dir) name)))
3642 ;; If NAME is not a Tramp file, run the real handler.
3643 (if (not (tramp-tramp-file-p name))
3644 (tramp-run-real-handler 'expand-file-name (list name nil))
3645 ;; Dissect NAME.
3646 (with-parsed-tramp-file-name name nil
3647 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
3648 (setq localname (concat "~/" localname)))
3649 ;; Tilde expansion if necessary. This needs a shell which
3650 ;; groks tilde expansion! The function `tramp-find-shell' is
3651 ;; supposed to find such a shell on the remote host. Please
3652 ;; tell me about it when this doesn't work on your system.
3653 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
3654 (let ((uname (match-string 1 localname))
3655 (fname (match-string 2 localname)))
3656 ;; We cannot simply apply "~/", because under sudo "~/" is
3657 ;; expanded to the local user home directory but to the
3658 ;; root home directory. On the other hand, using always
3659 ;; the default user name for tilde expansion is not
3660 ;; appropriate either, because ssh and companions might
3661 ;; use a user name from the config file.
3662 (when (and (string-equal uname "~")
3663 (string-match "\\`su\\(do\\)?\\'" method))
3664 (setq uname (concat uname user)))
3665 (setq uname
3666 (with-connection-property v uname
3667 (tramp-send-command v (format "cd %s; pwd" uname))
3668 (with-current-buffer (tramp-get-buffer v)
3669 (goto-char (point-min))
3670 (buffer-substring (point) (tramp-compat-line-end-position)))))
3671 (setq localname (concat uname fname))))
3672 ;; There might be a double slash, for example when "~/"
3673 ;; expands to "/". Remove this.
3674 (while (string-match "//" localname)
3675 (setq localname (replace-match "/" t t localname)))
3676 ;; No tilde characters in file name, do normal
3677 ;; expand-file-name (this does "/./" and "/../"). We bind
3678 ;; `directory-sep-char' here for XEmacs on Windows, which
3679 ;; would otherwise use backslash. `default-directory' is
3680 ;; bound, because on Windows there would be problems with UNC
3681 ;; shares or Cygwin mounts.
3682 (let ((directory-sep-char ?/)
3683 (default-directory (tramp-compat-temporary-file-directory)))
3684 (tramp-make-tramp-file-name
3685 method user host
3686 (tramp-drop-volume-letter
3687 (tramp-run-real-handler
3688 'expand-file-name (list localname))))))))
3689
3690 (defun tramp-replace-environment-variables (filename)
3691 "Replace environment variables in FILENAME.
3692 Return the string with the replaced variables."
3693 (save-match-data
3694 (let ((idx (string-match "$\\w+" filename)))
3695 ;; `$' is coded as `$$'.
3696 (when (and idx (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))))
3697 (setq filename
3698 (replace-match
3699 (substitute-in-file-name (match-string 0 filename))
3700 t nil filename)))
3701 filename)))
3702
3703 (defun tramp-handle-substitute-in-file-name (filename)
3704 "Like `substitute-in-file-name' for Tramp files.
3705 \"//\" and \"/~\" substitute only in the local filename part.
3706 If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
3707 beginning of local filename are not substituted."
3708 ;; First, we must replace environment variables.
3709 (setq filename (tramp-replace-environment-variables filename))
3710 (with-parsed-tramp-file-name filename nil
3711 (if (equal tramp-syntax 'url)
3712 ;; We need to check localname only. The other parts cannot contain
3713 ;; "//" or "/~".
3714 (if (and (> (length localname) 1)
3715 (or (string-match "//" localname)
3716 (string-match "/~" localname 1)))
3717 (tramp-run-real-handler 'substitute-in-file-name (list filename))
3718 (tramp-make-tramp-file-name
3719 (when method (substitute-in-file-name method))
3720 (when user (substitute-in-file-name user))
3721 (when host (substitute-in-file-name host))
3722 (when localname
3723 (tramp-run-real-handler
3724 'substitute-in-file-name (list localname)))))
3725 ;; Ignore in LOCALNAME everything before "//" or "/~".
3726 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
3727 (setq filename
3728 (concat (file-remote-p filename)
3729 (replace-match "\\1" nil nil localname)))
3730 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
3731 (when (string-match "~$" filename)
3732 (setq filename (concat filename "/"))))
3733 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
3734
3735 ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
3736 ;; which calls corresponding functions (see minibuf.el).
3737 (when (fboundp 'minibuffer-electric-separator)
3738 (mapc
3739 '(lambda (x)
3740 (eval
3741 `(defadvice ,x
3742 (around ,(intern (format "tramp-advice-%s" x)) activate)
3743 "Invoke `substitute-in-file-name' for Tramp files."
3744 (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
3745 (tramp-tramp-file-p (buffer-substring)))
3746 ;; We don't need to handle `last-input-event', because
3747 ;; due to the key map we know it must be ?/ or ?~.
3748 (let ((s (concat (buffer-substring (point-min) (point))
3749 (string last-command-char))))
3750 (delete-region (point-min) (point))
3751 (insert (substitute-in-file-name s))
3752 (setq ad-return-value last-command-char))
3753 ad-do-it))))
3754
3755 '(minibuffer-electric-separator
3756 minibuffer-electric-tilde)))
3757
3758
3759 ;;; Remote commands:
3760
3761 (defun tramp-handle-executable-find (command)
3762 "Like `executable-find' for Tramp files."
3763 (with-parsed-tramp-file-name default-directory nil
3764 (tramp-find-executable v command (tramp-get-remote-path v) t)))
3765
3766 ;; We use BUFFER also as connection buffer during setup. Because of
3767 ;; this, its original contents must be saved, and restored once
3768 ;; connection has been setup.
3769 (defun tramp-handle-start-file-process (name buffer program &rest args)
3770 "Like `start-file-process' for Tramp files."
3771 (with-parsed-tramp-file-name default-directory nil
3772 (unwind-protect
3773 (let ((name1 name)
3774 (i 0))
3775 (unless buffer
3776 ;; BUFFER can be nil. We use a temporary buffer.
3777 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
3778 (while (get-process name1)
3779 ;; NAME must be unique as process name.
3780 (setq i (1+ i)
3781 name1 (format "%s<%d>" name i)))
3782 (setq name name1)
3783 ;; Set the new process properties.
3784 (tramp-set-connection-property v "process-name" name)
3785 (tramp-set-connection-property v "process-buffer" buffer)
3786 ;; Activate narrowing in order to save BUFFER contents.
3787 ;; Clear also the modification time; otherwise we might be
3788 ;; interrupted by `verify-visited-file-modtime'.
3789 (with-current-buffer (tramp-get-connection-buffer v)
3790 (clear-visited-file-modtime)
3791 (narrow-to-region (point-max) (point-max)))
3792 ;; Goto working directory. `tramp-send-command' opens a new
3793 ;; connection.
3794 (tramp-send-command
3795 v (format "cd %s" (tramp-shell-quote-argument localname)))
3796 ;; Send the command.
3797 (tramp-send-command
3798 v
3799 (format "exec %s"
3800 (mapconcat 'tramp-shell-quote-argument
3801 (cons program args) " "))
3802 nil t) ; nooutput
3803 ;; Set query flag for this process.
3804 (tramp-set-process-query-on-exit-flag
3805 (tramp-get-connection-process v) t)
3806 ;; Return process.
3807 (tramp-get-connection-process v))
3808 ;; Save exit.
3809 (with-current-buffer (tramp-get-connection-buffer v)
3810 (if (string-match tramp-temp-buffer-name (buffer-name))
3811 (progn
3812 (set-process-buffer (tramp-get-connection-process v) nil)
3813 (kill-buffer (current-buffer)))
3814 (widen)
3815 (goto-char (point-max))))
3816 (tramp-set-connection-property v "process-name" nil)
3817 (tramp-set-connection-property v "process-buffer" nil))))
3818
3819 (defun tramp-handle-process-file
3820 (program &optional infile destination display &rest args)
3821 "Like `process-file' for Tramp files."
3822 ;; The implementation is not complete yet.
3823 (when (and (numberp destination) (zerop destination))
3824 (error "Implementation does not handle immediate return"))
3825
3826 (with-parsed-tramp-file-name default-directory nil
3827 (let (command input tmpinput stderr tmpstderr outbuf ret)
3828 ;; Compute command.
3829 (setq command (mapconcat 'tramp-shell-quote-argument
3830 (cons program args) " "))
3831 ;; Determine input.
3832 (if (null infile)
3833 (setq input "/dev/null")
3834 (setq infile (expand-file-name infile))
3835 (if (tramp-equal-remote default-directory infile)
3836 ;; INFILE is on the same remote host.
3837 (setq input (with-parsed-tramp-file-name infile nil localname))
3838 ;; INFILE must be copied to remote host.
3839 (setq input (tramp-make-tramp-temp-file v)
3840 tmpinput (tramp-make-tramp-file-name method user host input))
3841 (copy-file infile tmpinput t)))
3842 (when input (setq command (format "%s <%s" command input)))
3843
3844 ;; Determine output.
3845 (cond
3846 ;; Just a buffer
3847 ((bufferp destination)
3848 (setq outbuf destination))
3849 ;; A buffer name
3850 ((stringp destination)
3851 (setq outbuf (get-buffer-create destination)))
3852 ;; (REAL-DESTINATION ERROR-DESTINATION)
3853 ((consp destination)
3854 ;; output
3855 (cond
3856 ((bufferp (car destination))
3857 (setq outbuf (car destination)))
3858 ((stringp (car destination))
3859 (setq outbuf (get-buffer-create (car destination))))
3860 ((car destination)
3861 (setq outbuf (current-buffer))))
3862 ;; stderr
3863 (cond
3864 ((stringp (cadr destination))
3865 (setcar (cdr destination) (expand-file-name (cadr destination)))
3866 (if (tramp-equal-remote default-directory (cadr destination))
3867 ;; stderr is on the same remote host.
3868 (setq stderr (with-parsed-tramp-file-name
3869 (cadr destination) nil localname))
3870 ;; stderr must be copied to remote host. The temporary
3871 ;; file must be deleted after execution.
3872 (setq stderr (tramp-make-tramp-temp-file v)
3873 tmpstderr (tramp-make-tramp-file-name
3874 method user host stderr))))
3875 ;; stderr to be discarded
3876 ((null (cadr destination))
3877 (setq stderr "/dev/null"))))
3878 ;; 't
3879 (destination
3880 (setq outbuf (current-buffer))))
3881 (when stderr (setq command (format "%s 2>%s" command stderr)))
3882
3883 ;; Goto working directory.
3884 (tramp-send-command
3885 v (format "cd %s" (tramp-shell-quote-argument localname)))
3886 ;; Send the command. It might not return in time, so we protect it.
3887 (condition-case nil
3888 (unwind-protect
3889 (tramp-send-command v command)
3890 ;; We should show the output anyway.
3891 (when outbuf
3892 (let ((output-string
3893 (with-current-buffer (tramp-get-connection-buffer v)
3894 (buffer-substring (point-min) (point-max)))))
3895 (with-current-buffer outbuf
3896 (insert output-string)))
3897 (when display (display-buffer outbuf))))
3898 ;; When the user did interrupt, we should do it also.
3899 (error
3900 (kill-buffer (tramp-get-connection-buffer v))
3901 (setq ret 1)))
3902
3903 ;; Check return code.
3904 (unless ret (setq ret (tramp-send-command-and-check v nil)))
3905 ;; Provide error file.
3906 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
3907 ;; Cleanup.
3908 (when tmpinput (delete-file tmpinput))
3909 ;; Return exit status.
3910 ret)))
3911
3912 (defun tramp-local-call-process
3913 (program &optional infile destination display &rest args)
3914 "Calls `call-process' on the local host.
3915 This is needed because for some Emacs flavors Tramp has
3916 defadviced `call-process' to behave like `process-file'. The
3917 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
3918 (let ((default-directory
3919 (if (file-remote-p default-directory)
3920 (tramp-compat-temporary-file-directory)
3921 default-directory)))
3922 (if (executable-find program)
3923 (apply 'call-process program infile destination display args)
3924 1)))
3925
3926 (defun tramp-handle-call-process-region
3927 (start end program &optional delete buffer display &rest args)
3928 "Like `call-process-region' for Tramp files."
3929 (let ((tmpfile (tramp-compat-make-temp-file "")))
3930 (write-region start end tmpfile)
3931 (when delete (delete-region start end))
3932 (unwind-protect
3933 (apply 'call-process program tmpfile buffer display args)
3934 (delete-file tmpfile))))
3935
3936 (defun tramp-handle-shell-command
3937 (command &optional output-buffer error-buffer)
3938 "Like `shell-command' for Tramp files."
3939 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
3940 ;; We cannot use `shell-file-name' and `shell-command-switch',
3941 ;; they are variables of the local host.
3942 (args (list "/bin/sh" "-c" (substring command 0 asynchronous)))
3943 current-buffer-p
3944 (output-buffer
3945 (cond
3946 ((bufferp output-buffer) output-buffer)
3947 ((stringp output-buffer) (get-buffer-create output-buffer))
3948 (output-buffer
3949 (setq current-buffer-p t)
3950 (current-buffer))
3951 (t (get-buffer-create
3952 (if asynchronous
3953 "*Async Shell Command*"
3954 "*Shell Command Output*")))))
3955 (error-buffer
3956 (cond
3957 ((bufferp error-buffer) error-buffer)
3958 ((stringp error-buffer) (get-buffer-create error-buffer))))
3959 (buffer
3960 (if (and (not asynchronous) error-buffer)
3961 (with-parsed-tramp-file-name default-directory nil
3962 (list output-buffer (tramp-make-tramp-temp-file v)))
3963 output-buffer))
3964 (p (get-buffer-process output-buffer)))
3965
3966 ;; Check whether there is another process running. Tramp does not
3967 ;; support 2 (asynchronous) processes in parallel.
3968 (when p
3969 (if (yes-or-no-p "A command is running. Kill it? ")
3970 (condition-case nil
3971 (kill-process p)
3972 (error nil))
3973 (error "Shell command in progress")))
3974
3975 (if current-buffer-p
3976 (progn
3977 (barf-if-buffer-read-only)
3978 (push-mark nil t))
3979 (with-current-buffer output-buffer
3980 (setq buffer-read-only nil)
3981 (erase-buffer)))
3982
3983 (if (and (not current-buffer-p) (integerp asynchronous))
3984 (prog1
3985 ;; Run the process.
3986 (apply 'start-file-process "*Async Shell*" buffer args)
3987 ;; Display output.
3988 (pop-to-buffer output-buffer)
3989 (setq mode-line-process '(":%s"))
3990 (require 'shell) (shell-mode))
3991
3992 (prog1
3993 ;; Run the process.
3994 (apply 'process-file (car args) nil buffer nil (cdr args))
3995 ;; Insert error messages if they were separated.
3996 (when (listp buffer)
3997 (with-current-buffer error-buffer
3998 (insert-file-contents (cadr buffer)))
3999 (delete-file (cadr buffer)))
4000 (if current-buffer-p
4001 ;; This is like exchange-point-and-mark, but doesn't
4002 ;; activate the mark. It is cleaner to avoid activation,
4003 ;; even though the command loop would deactivate the mark
4004 ;; because we inserted text.
4005 (goto-char (prog1 (mark t)
4006 (set-marker (mark-marker) (point)
4007 (current-buffer))))
4008 ;; There's some output, display it.
4009 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
4010 (if (functionp 'display-message-or-buffer)
4011 (funcall (symbol-function 'display-message-or-buffer)
4012 output-buffer)
4013 (pop-to-buffer output-buffer))))))))
4014
4015 ;; File Editing.
4016
4017 (defvar tramp-handle-file-local-copy-hook nil
4018 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.")
4019
4020 (defun tramp-handle-file-local-copy (filename)
4021 "Like `file-local-copy' for Tramp files."
4022
4023 (with-parsed-tramp-file-name filename nil
4024 (unless (file-exists-p filename)
4025 (tramp-error
4026 v 'file-error
4027 "Cannot make local copy of non-existing file `%s'" filename))
4028
4029 (let ((rem-enc (tramp-get-remote-coding v "remote-encoding"))
4030 (loc-dec (tramp-get-local-coding v "local-decoding"))
4031 (tmpfile (tramp-compat-make-temp-file filename)))
4032
4033 (condition-case err
4034 (cond
4035 ;; `copy-file' handles direct copy and out-of-band methods.
4036 ((or (tramp-local-host-p v)
4037 (and (tramp-method-out-of-band-p v)
4038 (> (nth 7 (file-attributes filename))
4039 tramp-copy-size-limit)))
4040 (copy-file filename tmpfile t t))
4041
4042 ;; Use inline encoding for file transfer.
4043 (rem-enc
4044 (save-excursion
4045 (tramp-message v 5 "Encoding remote file %s..." filename)
4046 (tramp-barf-unless-okay
4047 v
4048 (format "%s < %s" rem-enc (tramp-shell-quote-argument localname))
4049 "Encoding remote file failed")
4050 (tramp-message v 5 "Encoding remote file %s...done" filename)
4051
4052 (if (and (symbolp loc-dec) (fboundp loc-dec))
4053 ;; If local decoding is a function, we call it. We
4054 ;; must disable multibyte, because
4055 ;; `uudecode-decode-region' doesn't handle it
4056 ;; correctly.
4057 (with-temp-buffer
4058 (set-buffer-multibyte nil)
4059 (insert-buffer-substring (tramp-get-buffer v))
4060 (tramp-message
4061 v 5 "Decoding remote file %s with function %s..."
4062 filename loc-dec)
4063 (funcall loc-dec (point-min) (point-max))
4064 (let ((coding-system-for-write 'binary))
4065 (write-region (point-min) (point-max) tmpfile)))
4066
4067 ;; If tramp-decoding-function is not defined for this
4068 ;; method, we invoke tramp-decoding-command instead.
4069 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
4070 (let ((coding-system-for-write 'binary))
4071 (write-region (point-min) (point-max) tmpfile2))
4072 (tramp-message
4073 v 5 "Decoding remote file %s with command %s..."
4074 filename loc-dec)
4075 (unwind-protect
4076 (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile)
4077 (delete-file tmpfile2))))
4078
4079 (tramp-message v 5 "Decoding remote file %s...done" filename)
4080 ;; Set proper permissions.
4081 (set-file-modes tmpfile (tramp-default-file-modes filename))
4082 ;; Set local user ownership.
4083 (tramp-set-file-uid-gid tmpfile)))
4084
4085 ;; Oops, I don't know what to do.
4086 (t (tramp-error
4087 v 'file-error "Wrong method specification for `%s'" method)))
4088
4089 ;; Error handling.
4090 ((error quit)
4091 (delete-file tmpfile)
4092 (signal (car err) (cdr err))))
4093
4094 (run-hooks 'tramp-handle-file-local-copy-hook)
4095 tmpfile)))
4096
4097 (defun tramp-handle-file-remote-p (filename &optional identification connected)
4098 "Like `file-remote-p' for Tramp files."
4099 (when (tramp-tramp-file-p filename)
4100 (with-parsed-tramp-file-name filename nil
4101 (and (or (not connected)
4102 (let ((p (tramp-get-connection-process v)))
4103 (and p (processp p) (memq (process-status p) '(run open)))))
4104 (cond
4105 ((eq identification 'method) method)
4106 ((eq identification 'user) user)
4107 ((eq identification 'host) host)
4108 ((eq identification 'localname) localname)
4109 (t (tramp-make-tramp-file-name method user host "")))))))
4110
4111 (defun tramp-find-file-name-coding-system-alist (filename tmpname)
4112 "Like `find-operation-coding-system' for Tramp filenames.
4113 Tramp's `insert-file-contents' and `write-region' work over
4114 temporary file names. If `file-coding-system-alist' contains an
4115 expression, which matches more than the file name suffix, the
4116 coding system might not be determined. This function repairs it."
4117 (let (result)
4118 (dolist (elt file-coding-system-alist result)
4119 (when (and (consp elt) (string-match (car elt) filename))
4120 ;; We found a matching entry in `file-coding-system-alist'.
4121 ;; So we add a similar entry, but with the temporary file name
4122 ;; as regexp.
4123 (add-to-list
4124 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
4125
4126 (defun tramp-handle-insert-file-contents
4127 (filename &optional visit beg end replace)
4128 "Like `insert-file-contents' for Tramp files."
4129 (barf-if-buffer-read-only)
4130 (setq filename (expand-file-name filename))
4131 (let (coding-system-used result)
4132 (with-parsed-tramp-file-name filename nil
4133
4134 (if (not (file-exists-p filename))
4135 (progn
4136 (when visit
4137 (setq buffer-file-name filename)
4138 (set-visited-file-modtime)
4139 (set-buffer-modified-p nil))
4140 ;; We don't raise a Tramp error, because it might be
4141 ;; suppressed, like in `find-file-noselect-1'.
4142 (signal 'file-error (list "File not found on remote host" filename))
4143 (list (expand-file-name filename) 0))
4144
4145 (if (and (tramp-local-host-p v)
4146 (let (file-name-handler-alist) (file-readable-p localname)))
4147 ;; Short track: if we are on the local host, we can run directly.
4148 (setq result
4149 (tramp-run-real-handler
4150 'insert-file-contents
4151 (list localname visit beg end replace)))
4152
4153 ;; `insert-file-contents-literally' takes care to avoid calling
4154 ;; jka-compr. By let-binding inhibit-file-name-operation, we
4155 ;; propagate that care to the file-local-copy operation.
4156 (let ((local-copy
4157 (let ((inhibit-file-name-operation
4158 (when (eq inhibit-file-name-operation
4159 'insert-file-contents)
4160 'file-local-copy)))
4161 (file-local-copy filename))))
4162 (tramp-message v 4 "Inserting local temp file `%s'..." local-copy)
4163 ;; We must ensure that `file-coding-system-alist' matches
4164 ;; `local-copy'.
4165 (unwind-protect
4166 (let ((file-coding-system-alist
4167 (tramp-find-file-name-coding-system-alist
4168 filename local-copy)))
4169 (setq result
4170 (insert-file-contents local-copy nil beg end replace))
4171 ;; Now `last-coding-system-used' has right value. Remember it.
4172 (when (boundp 'last-coding-system-used)
4173 (setq coding-system-used
4174 (symbol-value 'last-coding-system-used))))
4175 (delete-file local-copy))
4176 (tramp-message
4177 v 4 "Inserting local temp file `%s'...done" local-copy)
4178 (when (boundp 'last-coding-system-used)
4179 (set 'last-coding-system-used coding-system-used))))
4180
4181 (when visit
4182 (setq buffer-read-only (not (file-writable-p filename)))
4183 (setq buffer-file-name filename)
4184 (set-visited-file-modtime)
4185 (set-buffer-modified-p nil))
4186 (list (expand-file-name filename)
4187 (cadr result))))))
4188
4189 ;; This is needed for XEmacs only. Code stolen from files.el.
4190 (defun tramp-handle-insert-file-contents-literally
4191 (filename &optional visit beg end replace)
4192 "Like `insert-file-contents-literally' for Tramp files."
4193 (let ((format-alist nil)
4194 (after-insert-file-functions nil)
4195 (coding-system-for-read 'no-conversion)
4196 (coding-system-for-write 'no-conversion)
4197 (find-buffer-file-type-function
4198 (if (fboundp 'find-buffer-file-type)
4199 (symbol-function 'find-buffer-file-type)
4200 nil))
4201 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
4202 (inhibit-file-name-operation 'insert-file-contents))
4203 (unwind-protect
4204 (progn
4205 (fset 'find-buffer-file-type (lambda (filename) t))
4206 (insert-file-contents filename visit beg end replace))
4207 (if find-buffer-file-type-function
4208 (fset 'find-buffer-file-type find-buffer-file-type-function)
4209 (fmakunbound 'find-buffer-file-type)))))
4210
4211 (defun tramp-handle-find-backup-file-name (filename)
4212 "Like `find-backup-file-name' for Tramp files."
4213 (with-parsed-tramp-file-name filename nil
4214 ;; We set both variables. It doesn't matter whether it is
4215 ;; Emacs or XEmacs
4216 (let ((backup-directory-alist
4217 ;; Emacs case
4218 (when (boundp 'backup-directory-alist)
4219 (if (symbol-value 'tramp-backup-directory-alist)
4220 (mapcar
4221 '(lambda (x)
4222 (cons
4223 (car x)
4224 (if (and (stringp (cdr x))
4225 (file-name-absolute-p (cdr x))
4226 (not (tramp-file-name-p (cdr x))))
4227 (tramp-make-tramp-file-name method user host (cdr x))
4228 (cdr x))))
4229 (symbol-value 'tramp-backup-directory-alist))
4230 (symbol-value 'backup-directory-alist))))
4231
4232 (bkup-backup-directory-info
4233 ;; XEmacs case
4234 (when (boundp 'bkup-backup-directory-info)
4235 (if (symbol-value 'tramp-bkup-backup-directory-info)
4236 (mapcar
4237 '(lambda (x)
4238 (nconc
4239 (list (car x))
4240 (list
4241 (if (and (stringp (car (cdr x)))
4242 (file-name-absolute-p (car (cdr x)))
4243 (not (tramp-file-name-p (car (cdr x)))))
4244 (tramp-make-tramp-file-name
4245 method user host (car (cdr x)))
4246 (car (cdr x))))
4247 (cdr (cdr x))))
4248 (symbol-value 'tramp-bkup-backup-directory-info))
4249 (symbol-value 'bkup-backup-directory-info)))))
4250
4251 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
4252
4253 (defun tramp-handle-make-auto-save-file-name ()
4254 "Like `make-auto-save-file-name' for Tramp files.
4255 Returns a file name in `tramp-auto-save-directory' for autosaving this file."
4256 (let ((tramp-auto-save-directory tramp-auto-save-directory)
4257 (buffer-file-name
4258 (tramp-subst-strs-in-string
4259 '(("_" . "|")
4260 ("/" . "_a")
4261 (":" . "_b")
4262 ("|" . "__")
4263 ("[" . "_l")
4264 ("]" . "_r"))
4265 (buffer-file-name))))
4266 ;; File name must be unique. This is ensured with Emacs 22 (see
4267 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
4268 ;; all other cases we must do it ourselves.
4269 (when (boundp 'auto-save-file-name-transforms)
4270 (mapc
4271 '(lambda (x)
4272 (when (and (string-match (car x) buffer-file-name)
4273 (not (car (cddr x))))
4274 (setq tramp-auto-save-directory
4275 (or tramp-auto-save-directory
4276 (tramp-compat-temporary-file-directory)))))
4277 (symbol-value 'auto-save-file-name-transforms)))
4278 ;; Create directory.
4279 (when tramp-auto-save-directory
4280 (setq buffer-file-name
4281 (expand-file-name buffer-file-name tramp-auto-save-directory))
4282 (unless (file-exists-p tramp-auto-save-directory)
4283 (make-directory tramp-auto-save-directory t)))
4284 ;; Run plain `make-auto-save-file-name'. There might be an advice when
4285 ;; it is not a magic file name operation (since Emacs 22).
4286 ;; We must deactivate it temporarily.
4287 (if (not (ad-is-active 'make-auto-save-file-name))
4288 (tramp-run-real-handler 'make-auto-save-file-name nil)
4289 ;; else
4290 (ad-deactivate 'make-auto-save-file-name)
4291 (prog1
4292 (tramp-run-real-handler 'make-auto-save-file-name nil)
4293 (ad-activate 'make-auto-save-file-name)))))
4294
4295 (defvar tramp-handle-write-region-hook nil
4296 "Normal hook to be run at the end of `tramp-handle-write-region'.")
4297
4298 ;; CCC grok APPEND, LOCKNAME
4299 (defun tramp-handle-write-region
4300 (start end filename &optional append visit lockname confirm)
4301 "Like `write-region' for Tramp files."
4302 (setq filename (expand-file-name filename))
4303 (with-parsed-tramp-file-name filename nil
4304 (unless (null append)
4305 (tramp-error
4306 v 'file-error "Cannot append to file using Tramp (`%s')" filename))
4307 ;; Following part commented out because we don't know what to do about
4308 ;; file locking, and it does not appear to be a problem to ignore it.
4309 ;; Ange-ftp ignores it, too.
4310 ;; (when (and lockname (stringp lockname))
4311 ;; (setq lockname (expand-file-name lockname)))
4312 ;; (unless (or (eq lockname nil)
4313 ;; (string= lockname filename))
4314 ;; (error
4315 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
4316
4317 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
4318 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
4319 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
4320 (tramp-error v 'file-error "File not overwritten")))
4321
4322 (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
4323 (tramp-get-remote-uid v 'integer)))
4324 (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
4325 (tramp-get-remote-gid v 'integer))))
4326
4327 (if (and (tramp-local-host-p v)
4328 ;; `file-writable-p' calls 'file-expand-file-name'. We
4329 ;; cannot use `tramp-run-real-handler' therefore.
4330 (let (file-name-handler-alist)
4331 (and
4332 (file-writable-p (file-name-directory localname))
4333 (or (file-directory-p localname)
4334 (file-writable-p localname)))))
4335 ;; Short track: if we are on the local host, we can run directly.
4336 (tramp-run-real-handler
4337 'write-region
4338 (list start end localname append 'no-message lockname confirm))
4339
4340 (let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
4341 (loc-enc (tramp-get-local-coding v "local-encoding"))
4342 (modes (save-excursion (tramp-default-file-modes filename)))
4343 ;; We use this to save the value of
4344 ;; `last-coding-system-used' after writing the tmp file.
4345 ;; At the end of the function, we set
4346 ;; `last-coding-system-used' to this saved value. This
4347 ;; way, any intermediary coding systems used while
4348 ;; talking to the remote shell or suchlike won't hose
4349 ;; this variable. This approach was snarfed from
4350 ;; ange-ftp.el.
4351 coding-system-used
4352 ;; Write region into a tmp file. This isn't really
4353 ;; needed if we use an encoding function, but currently
4354 ;; we use it always because this makes the logic
4355 ;; simpler.
4356 (tmpfile (tramp-compat-make-temp-file filename)))
4357
4358 ;; We say `no-message' here because we don't want the
4359 ;; visited file modtime data to be clobbered from the temp
4360 ;; file. We call `set-visited-file-modtime' ourselves later
4361 ;; on. We must ensure that `file-coding-system-alist'
4362 ;; matches `tmpfile'.
4363 (let ((file-coding-system-alist
4364 (tramp-find-file-name-coding-system-alist filename tmpfile)))
4365 (condition-case err
4366 (tramp-run-real-handler
4367 'write-region
4368 (list start end tmpfile append 'no-message lockname confirm))
4369 ((error quit)
4370 (delete-file tmpfile)
4371 (signal (car err) (cdr err))))
4372
4373 ;; Now, `last-coding-system-used' has the right value. Remember it.
4374 (when (boundp 'last-coding-system-used)
4375 (setq coding-system-used
4376 (symbol-value 'last-coding-system-used))))
4377
4378 ;; The permissions of the temporary file should be set. If
4379 ;; filename does not exist (eq modes nil) it has been
4380 ;; renamed to the backup file. This case `save-buffer'
4381 ;; handles permissions.
4382 (when modes (set-file-modes tmpfile modes))
4383
4384 ;; This is a bit lengthy due to the different methods
4385 ;; possible for file transfer. First, we check whether the
4386 ;; method uses an rcp program. If so, we call it.
4387 ;; Otherwise, both encoding and decoding command must be
4388 ;; specified. However, if the method _also_ specifies an
4389 ;; encoding function, then that is used for encoding the
4390 ;; contents of the tmp file.
4391 (cond
4392 ;; `rename-file' handles direct copy and out-of-band methods.
4393 ((or (tramp-local-host-p v)
4394 (and (tramp-method-out-of-band-p v)
4395 (> (- (or end (point-max)) (or start (point-min)))
4396 tramp-copy-size-limit)))
4397 (condition-case err
4398 (rename-file tmpfile filename t)
4399 ((error quit)
4400 (delete-file tmpfile)
4401 (signal (car err) (cdr err)))))
4402
4403 ;; Use inline file transfer.
4404 (rem-dec
4405 ;; Encode tmpfile.
4406 (tramp-message v 5 "Encoding region...")
4407 (unwind-protect
4408 (with-temp-buffer
4409 ;; Use encoding function or command.
4410 (if (and (symbolp loc-enc) (fboundp loc-enc))
4411 (progn
4412 (tramp-message
4413 v 5 "Encoding region using function `%s'..."
4414 (symbol-name loc-enc))
4415 (let ((coding-system-for-read 'binary))
4416 (insert-file-contents-literally tmpfile))
4417 ;; CCC. The following `let' is a workaround
4418 ;; for the base64.el that comes with
4419 ;; pgnus-0.84. If both of the following
4420 ;; conditions are satisfied, it tries to write
4421 ;; to a local file in default-directory, but
4422 ;; at this point, default-directory is remote.
4423 ;; (`call-process-region' can't write to remote
4424 ;; files, it seems.) The file in question is
4425 ;; a tmp file anyway.
4426 (let ((default-directory
4427 (tramp-compat-temporary-file-directory)))
4428 (funcall loc-enc (point-min) (point-max))))
4429
4430 (tramp-message
4431 v 5 "Encoding region using command `%s'..." loc-enc)
4432 (unless (equal 0 (tramp-call-local-coding-command
4433 loc-enc tmpfile t))
4434 (tramp-error
4435 v 'file-error
4436 "Cannot write to `%s', local encoding command `%s' failed"
4437 filename loc-enc)))
4438
4439 ;; Send buffer into remote decoding command which
4440 ;; writes to remote file. Because this happens on
4441 ;; the remote host, we cannot use the function.
4442 (goto-char (point-max))
4443 (unless (bolp) (newline))
4444 (tramp-message
4445 v 5 "Decoding region into remote file %s..." filename)
4446 (tramp-send-command
4447 v
4448 (format
4449 "%s >%s <<'EOF'\n%sEOF"
4450 rem-dec
4451 (tramp-shell-quote-argument localname)
4452 (buffer-string)))
4453 (tramp-barf-unless-okay
4454 v nil
4455 "Couldn't write region to `%s', decode using `%s' failed"
4456 filename rem-dec)
4457 ;; When `file-precious-flag' is set, the region is
4458 ;; written to a temporary file. Check that the
4459 ;; checksum is equal to that from the local tmpfile.
4460 (when file-precious-flag
4461 (erase-buffer)
4462 (and
4463 ;; cksum runs locally, if possible.
4464 (zerop (tramp-local-call-process "cksum" tmpfile t))
4465 ;; cksum runs remotely.
4466 (zerop
4467 (tramp-send-command-and-check
4468 v
4469 (format
4470 "cksum <%s" (tramp-shell-quote-argument localname))))
4471 ;; ... they are different.
4472 (not
4473 (string-equal
4474 (buffer-string)
4475 (with-current-buffer (tramp-get-buffer v)
4476 (buffer-string))))
4477 (tramp-error
4478 v 'file-error
4479 (concat "Couldn't write region to `%s',"
4480 " decode using `%s' failed")
4481 filename rem-dec)))
4482 (tramp-message
4483 v 5 "Decoding region into remote file %s...done" filename)
4484 (tramp-flush-file-property v localname))
4485
4486 ;; Save exit.
4487 (delete-file tmpfile)))
4488
4489 ;; That's not expected.
4490 (t
4491 (tramp-error
4492 v 'file-error
4493 (concat "Method `%s' should specify both encoding and "
4494 "decoding command or an rcp program")
4495 method)))
4496
4497 ;; Make `last-coding-system-used' have the right value.
4498 (when coding-system-used
4499 (set 'last-coding-system-used coding-system-used))))
4500
4501 ;; We must protect `last-coding-system-used', now we have set it
4502 ;; to its correct value.
4503 (let (last-coding-system-used)
4504 ;; Set file modification time.
4505 (when (or (eq visit t) (stringp visit))
4506 (set-visited-file-modtime
4507 ;; We must pass modtime explicitely, because filename can
4508 ;; be different from (buffer-file-name), f.e. if
4509 ;; `file-precious-flag' is set.
4510 (nth 5 (file-attributes filename))))
4511
4512 ;; Set the ownership.
4513 (tramp-set-file-uid-gid filename uid gid)
4514 (when (or (eq visit t) (null visit) (stringp visit))
4515 (tramp-message v 0 "Wrote %s" filename))
4516 (run-hooks 'tramp-handle-write-region-hook)))))
4517
4518 ;;;###autoload
4519 (progn (defun tramp-run-real-handler (operation args)
4520 "Invoke normal file name handler for OPERATION.
4521 First arg specifies the OPERATION, second arg is a list of arguments to
4522 pass to the OPERATION."
4523 (let* ((inhibit-file-name-handlers
4524 `(tramp-file-name-handler
4525 tramp-completion-file-name-handler
4526 cygwin-mount-name-hook-function
4527 cygwin-mount-map-drive-hook-function
4528 .
4529 ,(and (eq inhibit-file-name-operation operation)
4530 inhibit-file-name-handlers)))
4531 (inhibit-file-name-operation operation))
4532 (apply operation args))))
4533
4534 ;;;###autoload
4535 (progn (defun tramp-completion-run-real-handler (operation args)
4536 "Invoke `tramp-file-name-handler' for OPERATION.
4537 First arg specifies the OPERATION, second arg is a list of arguments to
4538 pass to the OPERATION."
4539 (let* ((inhibit-file-name-handlers
4540 `(tramp-completion-file-name-handler
4541 cygwin-mount-name-hook-function
4542 cygwin-mount-map-drive-hook-function
4543 .
4544 ,(and (eq inhibit-file-name-operation operation)
4545 inhibit-file-name-handlers)))
4546 (inhibit-file-name-operation operation))
4547 (apply operation args))))
4548
4549 ;; We handle here all file primitives. Most of them have the file
4550 ;; name as first parameter; nevertheless we check for them explicitly
4551 ;; in order to be signaled if a new primitive appears. This
4552 ;; scenario is needed because there isn't a way to decide by
4553 ;; syntactical means whether a foreign method must be called. It would
4554 ;; ease the life if `file-name-handler-alist' would support a decision
4555 ;; function as well but regexp only.
4556 (defun tramp-file-name-for-operation (operation &rest args)
4557 "Return file name related to OPERATION file primitive.
4558 ARGS are the arguments OPERATION has been called with."
4559 (cond
4560 ; FILE resp DIRECTORY
4561 ((member operation
4562 (list 'access-file 'byte-compiler-base-file-name 'delete-directory
4563 'delete-file 'diff-latest-backup-file 'directory-file-name
4564 'directory-files 'directory-files-and-attributes
4565 'dired-compress-file 'dired-uncache
4566 'file-accessible-directory-p 'file-attributes
4567 'file-directory-p 'file-executable-p 'file-exists-p
4568 'file-local-copy 'file-remote-p 'file-modes
4569 'file-name-as-directory 'file-name-directory
4570 'file-name-nondirectory 'file-name-sans-versions
4571 'file-ownership-preserved-p 'file-readable-p
4572 'file-regular-p 'file-symlink-p 'file-truename
4573 'file-writable-p 'find-backup-file-name 'find-file-noselect
4574 'get-file-buffer 'insert-directory 'insert-file-contents
4575 'load 'make-directory 'make-directory-internal
4576 'set-file-modes 'substitute-in-file-name
4577 'unhandled-file-name-directory 'vc-registered
4578 ; Emacs 22 only
4579 'set-file-times
4580 ; XEmacs only
4581 'abbreviate-file-name 'create-file-buffer
4582 'dired-file-modtime 'dired-make-compressed-filename
4583 'dired-recursive-delete-directory 'dired-set-file-modtime
4584 'dired-shell-unhandle-file-name 'dired-uucode-file
4585 'insert-file-contents-literally 'make-temp-name 'recover-file
4586 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
4587 (if (file-name-absolute-p (nth 0 args))
4588 (nth 0 args)
4589 (expand-file-name (nth 0 args))))
4590 ; FILE DIRECTORY resp FILE1 FILE2
4591 ((member operation
4592 (list 'add-name-to-file 'copy-file 'expand-file-name
4593 'file-name-all-completions 'file-name-completion
4594 'file-newer-than-file-p 'make-symbolic-link 'rename-file
4595 ; XEmacs only
4596 'dired-make-relative-symlink
4597 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
4598 (save-match-data
4599 (cond
4600 ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
4601 ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
4602 (t (buffer-file-name (current-buffer))))))
4603 ; START END FILE
4604 ((eq operation 'write-region)
4605 (nth 2 args))
4606 ; BUF
4607 ((member operation
4608 (list 'set-visited-file-modtime 'verify-visited-file-modtime
4609 ; since Emacs 22 only
4610 'make-auto-save-file-name
4611 ; XEmacs only
4612 'backup-buffer))
4613 (buffer-file-name
4614 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
4615 ; COMMAND
4616 ((member operation
4617 (list ; not in Emacs 23
4618 'dired-call-process
4619 ; Emacs only
4620 'shell-command
4621 ; since Emacs 22 only
4622 'process-file
4623 ; since Emacs 23 only
4624 'start-file-process
4625 ; XEmacs only
4626 'dired-print-file 'dired-shell-call-process
4627 ; nowhere yet
4628 'executable-find 'start-process 'call-process))
4629 default-directory)
4630 ; unknown file primitive
4631 (t (error "unknown file I/O primitive: %s" operation))))
4632
4633 (defun tramp-find-foreign-file-name-handler (filename)
4634 "Return foreign file name handler if exists."
4635 (when (and (stringp filename) (tramp-tramp-file-p filename))
4636 (let ((v (tramp-dissect-file-name filename t))
4637 (handler tramp-foreign-file-name-handler-alist)
4638 elt res)
4639 ;; When we are not fully sure that filename completion is safe,
4640 ;; we should not return a handler.
4641 (when (or (tramp-file-name-method v) (tramp-file-name-user v)
4642 (and (tramp-file-name-host v)
4643 (not (member (tramp-file-name-host v)
4644 (mapcar 'car tramp-methods))))
4645 (not (tramp-completion-mode-p)))
4646 (while handler
4647 (setq elt (car handler)
4648 handler (cdr handler))
4649 (when (funcall (car elt) filename)
4650 (setq handler nil
4651 res (cdr elt))))
4652 res))))
4653
4654 ;; Main function.
4655 ;;;###autoload
4656 (defun tramp-file-name-handler (operation &rest args)
4657 "Invoke Tramp file name handler.
4658 Falls back to normal file name handler if no Tramp file name handler exists."
4659 (if tramp-mode
4660 (save-match-data
4661 (let* ((filename
4662 (tramp-replace-environment-variables
4663 (apply 'tramp-file-name-for-operation operation args)))
4664 (completion (tramp-completion-mode-p))
4665 (foreign (tramp-find-foreign-file-name-handler filename)))
4666 (with-parsed-tramp-file-name filename nil
4667 (cond
4668 ;; When we are in completion mode, some operations
4669 ;; shouldn't be handled by backend.
4670 ((and completion (zerop (length localname))
4671 (memq operation '(file-exists-p file-directory-p)))
4672 t)
4673 ((and completion (zerop (length localname))
4674 (memq operation '(file-name-as-directory)))
4675 filename)
4676 ;; Call the backend function.
4677 (foreign (apply foreign operation args))
4678 ;; Nothing to do for us.
4679 (t (tramp-run-real-handler operation args))))))
4680 ;; When `tramp-mode' is not enabled, we don't do anything.
4681 (tramp-run-real-handler operation args)))
4682
4683 ;; In Emacs, there is some concurrency due to timers. If a timer
4684 ;; interrupts Tramp and wishes to use the same connection buffer as
4685 ;; the "main" Emacs, then garbage might occur in the connection
4686 ;; buffer. Therefore, we need to make sure that a timer does not use
4687 ;; the same connection buffer as the "main" Emacs. We implement a
4688 ;; cheap global lock, instead of locking each connection buffer
4689 ;; separately. The global lock is based on two variables,
4690 ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
4691 ;; (with setq) to indicate a lock. But Tramp also calls itself during
4692 ;; processing of a single file operation, so we need to allow
4693 ;; recursive calls. That's where the `tramp-locker' variable comes in
4694 ;; -- it is let-bound to t during the execution of the current
4695 ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
4696 ;; then we should just proceed because we have been called
4697 ;; recursively. But if `tramp-locker' is nil, then we are a timer
4698 ;; interrupting the "main" Emacs, and then we signal an error.
4699
4700 (defvar tramp-locked nil
4701 "If non-nil, then Tramp is currently busy.
4702 Together with `tramp-locker', this implements a locking mechanism
4703 preventing reentrant calls of Tramp.")
4704
4705 (defvar tramp-locker nil
4706 "If non-nil, then a caller has locked Tramp.
4707 Together with `tramp-locked', this implements a locking mechanism
4708 preventing reentrant calls of Tramp.")
4709
4710 (defun tramp-sh-file-name-handler (operation &rest args)
4711 "Invoke remote-shell Tramp file name handler.
4712 Fall back to normal file name handler if no Tramp handler exists."
4713 (when (and tramp-locked (not tramp-locker))
4714 (setq tramp-locked nil)
4715 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
4716 (let ((tl tramp-locked))
4717 (unwind-protect
4718 (progn
4719 (setq tramp-locked t)
4720 (let ((tramp-locker t))
4721 (save-match-data
4722 (let ((fn (assoc operation tramp-file-name-handler-alist)))
4723 (if fn
4724 (apply (cdr fn) args)
4725 (tramp-run-real-handler operation args))))))
4726 (setq tramp-locked tl))))
4727
4728 ;;;###autoload
4729 (progn (defun tramp-completion-file-name-handler (operation &rest args)
4730 "Invoke Tramp file name completion handler.
4731 Falls back to normal file name handler if no Tramp file name handler exists."
4732 ;; We bind `directory-sep-char' here for XEmacs on Windows, which
4733 ;; would otherwise use backslash.
4734 (let ((directory-sep-char ?/)
4735 (fn (assoc operation tramp-completion-file-name-handler-alist)))
4736 ;; When `tramp-mode' is not enabled, we don't do anything.
4737 (if (and fn tramp-mode)
4738 (save-match-data (apply (cdr fn) args))
4739 (tramp-completion-run-real-handler operation args)))))
4740
4741 ;;;###autoload
4742 (defsubst tramp-register-file-name-handler ()
4743 "Add Tramp file name handler to `file-name-handler-alist'."
4744 ;; Remove autoloaded handler from file name handler alist. Useful,
4745 ;; if `tramp-syntax' has been changed.
4746 (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
4747 (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
4748 ;; Add the handler.
4749 (add-to-list 'file-name-handler-alist
4750 (cons tramp-file-name-regexp 'tramp-file-name-handler))
4751 ;; If jka-compr is already loaded, move it to the front of
4752 ;; `file-name-handler-alist'.
4753 (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
4754 (when jka
4755 (setq file-name-handler-alist
4756 (cons jka (delete jka file-name-handler-alist))))))
4757
4758 ;; `tramp-file-name-handler' must be registered before evaluation of
4759 ;; site-start and init files, because there might exist remote files
4760 ;; already, f.e. files kept via recentf-mode.
4761 ;;;###autoload(tramp-register-file-name-handler)
4762 (tramp-register-file-name-handler)
4763
4764 ;;;###autoload
4765 (defsubst tramp-register-completion-file-name-handler ()
4766 "Add Tramp completion file name handler to `file-name-handler-alist'."
4767 ;; Remove autoloaded handler from file name handler alist. Useful,
4768 ;; if `tramp-syntax' has been changed.
4769 (let ((a1 (rassq
4770 'tramp-completion-file-name-handler file-name-handler-alist)))
4771 (setq file-name-handler-alist (delete a1 file-name-handler-alist)))
4772 ;; `partial-completion-mode' is unknown in XEmacs. So we should
4773 ;; load it unconditionally there. In the GNU Emacs case, method/
4774 ;; user/host name completion shall be bound to `partial-completion-mode'.
4775 ;; `ido-mode' and `icy-mode' are other packages which extend file
4776 ;; name completion.
4777 (when (or (not (boundp 'partial-completion-mode))
4778 (symbol-value 'partial-completion-mode)
4779 (featurep 'ido)
4780 (featurep 'icicles))
4781 (add-to-list 'file-name-handler-alist
4782 (cons tramp-completion-file-name-regexp
4783 'tramp-completion-file-name-handler))
4784 (put 'tramp-completion-file-name-handler 'safe-magic t))
4785 ;; If jka-compr is already loaded, move it to the front of
4786 ;; `file-name-handler-alist'.
4787 (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
4788 (when jka
4789 (setq file-name-handler-alist
4790 (cons jka (delete jka file-name-handler-alist))))))
4791
4792 ;; During autoload, it shall be checked whether
4793 ;; `partial-completion-mode' is active. Therefore registering of
4794 ;; `tramp-completion-file-name-handler' will be delayed.
4795 ;;;###autoload(add-hook
4796 ;;;###autoload 'after-init-hook
4797 ;;;###autoload 'tramp-register-completion-file-name-handler)
4798 (tramp-register-completion-file-name-handler)
4799
4800 ;;;###autoload
4801 (defun tramp-unload-file-name-handlers ()
4802 (setq file-name-handler-alist
4803 (delete (rassoc 'tramp-file-name-handler
4804 file-name-handler-alist)
4805 (delete (rassoc 'tramp-completion-file-name-handler
4806 file-name-handler-alist)
4807 file-name-handler-alist))))
4808
4809 (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
4810
4811 ;;; File name handler functions for completion mode:
4812
4813 (defvar tramp-completion-mode nil
4814 "If non-nil, external packages signal that they are in file name completion.
4815
4816 This is necessary, because Tramp uses a heuristic depending on last
4817 input event. This fails when external packages use other characters
4818 but <TAB>, <SPACE> or ?\\? for file name completion. This variable
4819 should never be set globally, the intention is to let-bind it.")
4820
4821 ;; Necessary because `tramp-file-name-regexp-unified' and
4822 ;; `tramp-completion-file-name-regexp-unified' aren't different. If
4823 ;; nil, `tramp-completion-run-real-handler' is called (i.e. forwarding
4824 ;; to `tramp-file-name-handler'). Otherwise, it takes
4825 ;; `tramp-run-real-handler'. Using `last-input-event' is a little bit
4826 ;; risky, because completing a file might require loading other files,
4827 ;; like "~/.netrc", and for them it shouldn't be decided based on that
4828 ;; variable. On the other hand, those files shouldn't have partial
4829 ;; Tramp file name syntax. Maybe another variable should be introduced
4830 ;; overwriting this check in such cases. Or we change Tramp file name
4831 ;; syntax in order to avoid ambiguities, like in XEmacs ...
4832 (defun tramp-completion-mode-p ()
4833 "Checks whether method / user name / host name completion is active."
4834 (or
4835 ;; Signal from outside.
4836 tramp-completion-mode
4837 ;; Emacs.
4838 (equal last-input-event 'tab)
4839 (and (natnump last-input-event)
4840 (or
4841 ;; ?\t has event-modifier 'control.
4842 (equal last-input-event ?\t)
4843 (and (not (event-modifiers last-input-event))
4844 (or (equal last-input-event ?\?)
4845 (equal last-input-event ?\ )))))
4846 ;; XEmacs.
4847 (and (featurep 'xemacs)
4848 ;; `last-input-event' might be nil.
4849 (not (null last-input-event))
4850 ;; `last-input-event' may have no character approximation.
4851 (funcall (symbol-function 'event-to-character) last-input-event)
4852 (or
4853 ;; ?\t has event-modifier 'control.
4854 (equal
4855 (funcall (symbol-function 'event-to-character)
4856 last-input-event) ?\t)
4857 (and (not (event-modifiers last-input-event))
4858 (or (equal
4859 (funcall (symbol-function 'event-to-character)
4860 last-input-event) ?\?)
4861 (equal
4862 (funcall (symbol-function 'event-to-character)
4863 last-input-event) ?\ )))))))
4864
4865 ;; Method, host name and user name completion.
4866 ;; `tramp-completion-dissect-file-name' returns a list of
4867 ;; tramp-file-name structures. For all of them we return possible completions.
4868 ;;;###autoload
4869 (defun tramp-completion-handle-file-name-all-completions (filename directory)
4870 "Like `file-name-all-completions' for partial Tramp files."
4871
4872 (let* ((fullname (tramp-drop-volume-letter
4873 (expand-file-name filename directory)))
4874 ;; Possible completion structures.
4875 (v (tramp-completion-dissect-file-name fullname))
4876 result result1)
4877
4878 (while v
4879 (let* ((car (car v))
4880 (method (tramp-file-name-method car))
4881 (user (tramp-file-name-user car))
4882 (host (tramp-file-name-host car))
4883 (localname (tramp-file-name-localname car))
4884 (m (tramp-find-method method user host))
4885 (tramp-current-user user) ; see `tramp-parse-passwd'
4886 all-user-hosts)
4887
4888 (unless localname ;; Nothing to complete.
4889
4890 (if (or user host)
4891
4892 ;; Method dependent user / host combinations.
4893 (progn
4894 (mapc
4895 (lambda (x)
4896 (setq all-user-hosts
4897 (append all-user-hosts
4898 (funcall (nth 0 x) (nth 1 x)))))
4899 (tramp-get-completion-function m))
4900
4901 (setq result
4902 (append result
4903 (mapcar
4904 (lambda (x)
4905 (tramp-get-completion-user-host
4906 method user host (nth 0 x) (nth 1 x)))
4907 (delq nil all-user-hosts)))))
4908
4909 ;; Possible methods.
4910 (setq result
4911 (append result (tramp-get-completion-methods m)))))
4912
4913 (setq v (cdr v))))
4914
4915 ;; Unify list, remove nil elements.
4916 (while result
4917 (let ((car (car result)))
4918 (when car
4919 (add-to-list
4920 'result1
4921 (substring car (length (tramp-drop-volume-letter directory)))))
4922 (setq result (cdr result))))
4923
4924 ;; Complete local parts.
4925 (append
4926 result1
4927 (condition-case nil
4928 (tramp-completion-run-real-handler
4929 'file-name-all-completions (list filename directory))
4930 (error nil)))))
4931
4932 ;; Method, host name and user name completion for a file.
4933 ;;;###autoload
4934 (defun tramp-completion-handle-file-name-completion
4935 (filename directory &optional predicate)
4936 "Like `file-name-completion' for Tramp files."
4937 (try-completion
4938 filename
4939 (mapcar 'list (file-name-all-completions filename directory))
4940 (when predicate
4941 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
4942
4943 ;; I misuse a little bit the tramp-file-name structure in order to handle
4944 ;; completion possibilities for partial methods / user names / host names.
4945 ;; Return value is a list of tramp-file-name structures according to possible
4946 ;; completions. If "localname" is non-nil it means there
4947 ;; shouldn't be a completion anymore.
4948
4949 ;; Expected results:
4950
4951 ;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
4952 ;; [nil nil "x" nil] [nil "x" nil nil] [nil "x" "y" nil]
4953 ;; [nil "x" nil nil]
4954 ;; ["x" nil nil nil]
4955
4956 ;; "/x:" "/x:y" "/x:y:"
4957 ;; [nil nil "x" ""] [nil nil "x" "y"] ["x" nil "y" ""]
4958 ;; "/[x/" "/[x/y"
4959 ;; ["x" nil "" nil] ["x" nil "y" nil]
4960 ;; ["x" "" nil nil] ["x" "y" nil nil]
4961
4962 ;; "/x:y@" "/x:y@z" "/x:y@z:"
4963 ;; [nil nil "x" "y@"] [nil nil "x" "y@z"] ["x" "y" "z" ""]
4964 ;; "/[x/y@" "/[x/y@z"
4965 ;; ["x" nil "y" nil] ["x" "y" "z" nil]
4966 (defun tramp-completion-dissect-file-name (name)
4967 "Returns a list of `tramp-file-name' structures.
4968 They are collected by `tramp-completion-dissect-file-name1'."
4969
4970 (let* ((result)
4971 (x-nil "\\|\\(\\)")
4972 (tramp-completion-ipv6-regexp
4973 (format
4974 "[^%s]*"
4975 (if (zerop (length tramp-postfix-ipv6-format))
4976 tramp-postfix-host-format
4977 tramp-postfix-ipv6-format)))
4978 ;; "/method" "/[method"
4979 (tramp-completion-file-name-structure1
4980 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
4981 1 nil nil nil))
4982 ;; "/user" "/[user"
4983 (tramp-completion-file-name-structure2
4984 (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$")
4985 nil 1 nil nil))
4986 ;; "/host" "/[host"
4987 (tramp-completion-file-name-structure3
4988 (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$")
4989 nil nil 1 nil))
4990 ;; "/[ipv6" "/[ipv6"
4991 (tramp-completion-file-name-structure4
4992 (list (concat tramp-prefix-regexp
4993 tramp-prefix-ipv6-regexp
4994 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
4995 nil nil 1 nil))
4996 ;; "/user@host" "/[user@host"
4997 (tramp-completion-file-name-structure5
4998 (list (concat tramp-prefix-regexp
4999 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5000 "\\(" tramp-host-regexp x-nil "\\)$")
5001 nil 1 2 nil))
5002 ;; "/user@[ipv6" "/[user@ipv6"
5003 (tramp-completion-file-name-structure6
5004 (list (concat tramp-prefix-regexp
5005 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5006 tramp-prefix-ipv6-regexp
5007 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5008 nil 1 2 nil))
5009 ;; "/method:user" "/[method/user" "/method://user"
5010 (tramp-completion-file-name-structure7
5011 (list (concat tramp-prefix-regexp
5012 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5013 "\\(" tramp-user-regexp x-nil "\\)$")
5014 1 2 nil nil))
5015 ;; "/method:host" "/[method/host" "/method://host"
5016 (tramp-completion-file-name-structure8
5017 (list (concat tramp-prefix-regexp
5018 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5019 "\\(" tramp-host-regexp x-nil "\\)$")
5020 1 nil 2 nil))
5021 ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
5022 (tramp-completion-file-name-structure9
5023 (list (concat tramp-prefix-regexp
5024 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5025 tramp-prefix-ipv6-regexp
5026 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5027 1 nil 2 nil))
5028 ;; "/method:user@host" "/[method/user@host" "/method://user@host"
5029 (tramp-completion-file-name-structure10
5030 (list (concat tramp-prefix-regexp
5031 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5032 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5033 "\\(" tramp-host-regexp x-nil "\\)$")
5034 1 2 3 nil))
5035 ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
5036 (tramp-completion-file-name-structure11
5037 (list (concat tramp-prefix-regexp
5038 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
5039 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5040 tramp-prefix-ipv6-regexp
5041 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5042 1 2 3 nil))
5043 ;; "/method: "/method:/"
5044 (tramp-completion-file-name-structure12
5045 (list
5046 (if (equal tramp-syntax 'url)
5047 (concat tramp-prefix-regexp
5048 "\\(" tramp-method-regexp "\\)"
5049 "\\(" (substring tramp-postfix-method-regexp 0 1)
5050 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
5051 "\\(" "\\)$")
5052 ;; Should not match if not URL syntax.
5053 (concat tramp-prefix-regexp "/$"))
5054 1 3 nil nil))
5055 ;; "/method: "/method:/"
5056 (tramp-completion-file-name-structure13
5057 (list
5058 (if (equal tramp-syntax 'url)
5059 (concat tramp-prefix-regexp
5060 "\\(" tramp-method-regexp "\\)"
5061 "\\(" (substring tramp-postfix-method-regexp 0 1)
5062 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
5063 "\\(" "\\)$")
5064 ;; Should not match if not URL syntax.
5065 (concat tramp-prefix-regexp "/$"))
5066 1 nil 3 nil)))
5067
5068 (mapc (lambda (regexp)
5069 (add-to-list 'result
5070 (tramp-completion-dissect-file-name1 regexp name)))
5071 (list
5072 tramp-completion-file-name-structure1
5073 tramp-completion-file-name-structure2
5074 tramp-completion-file-name-structure3
5075 tramp-completion-file-name-structure4
5076 tramp-completion-file-name-structure5
5077 tramp-completion-file-name-structure6
5078 tramp-completion-file-name-structure7
5079 tramp-completion-file-name-structure8
5080 tramp-completion-file-name-structure9
5081 tramp-completion-file-name-structure10
5082 tramp-completion-file-name-structure11
5083 tramp-completion-file-name-structure12
5084 tramp-completion-file-name-structure13
5085 tramp-file-name-structure))
5086
5087 (delq nil result)))
5088
5089 (defun tramp-completion-dissect-file-name1 (structure name)
5090 "Returns a `tramp-file-name' structure matching STRUCTURE.
5091 The structure consists of remote method, remote user,
5092 remote host and localname (filename on remote host)."
5093
5094 (save-match-data
5095 (when (string-match (nth 0 structure) name)
5096 (let ((method (and (nth 1 structure)
5097 (match-string (nth 1 structure) name)))
5098 (user (and (nth 2 structure)
5099 (match-string (nth 2 structure) name)))
5100 (host (and (nth 3 structure)
5101 (match-string (nth 3 structure) name)))
5102 (localname (and (nth 4 structure)
5103 (match-string (nth 4 structure) name))))
5104 (vector method user host localname)))))
5105
5106 ;; This function returns all possible method completions, adding the
5107 ;; trailing method delimeter.
5108 (defun tramp-get-completion-methods (partial-method)
5109 "Returns all method completions for PARTIAL-METHOD."
5110 (mapcar
5111 (lambda (method)
5112 (and method
5113 (string-match (concat "^" (regexp-quote partial-method)) method)
5114 (tramp-completion-make-tramp-file-name method nil nil nil)))
5115 (mapcar 'car tramp-methods)))
5116
5117 ;; Compares partial user and host names with possible completions.
5118 (defun tramp-get-completion-user-host (method partial-user partial-host user host)
5119 "Returns the most expanded string for user and host name completion.
5120 PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
5121 (cond
5122
5123 ((and partial-user partial-host)
5124 (if (and host
5125 (string-match (concat "^" (regexp-quote partial-host)) host)
5126 (string-equal partial-user (or user partial-user)))
5127 (setq user partial-user)
5128 (setq user nil
5129 host nil)))
5130
5131 (partial-user
5132 (setq host nil)
5133 (unless
5134 (and user (string-match (concat "^" (regexp-quote partial-user)) user))
5135 (setq user nil)))
5136
5137 (partial-host
5138 (setq user nil)
5139 (unless
5140 (and host (string-match (concat "^" (regexp-quote partial-host)) host))
5141 (setq host nil)))
5142
5143 (t (setq user nil
5144 host nil)))
5145
5146 (unless (zerop (+ (length user) (length host)))
5147 (tramp-completion-make-tramp-file-name method user host nil)))
5148
5149 (defun tramp-parse-rhosts (filename)
5150 "Return a list of (user host) tuples allowed to access.
5151 Either user or host may be nil."
5152 ;; On Windows, there are problems in completion when
5153 ;; `default-directory' is remote.
5154 (let ((default-directory (tramp-compat-temporary-file-directory))
5155 res)
5156 (when (file-readable-p filename)
5157 (with-temp-buffer
5158 (insert-file-contents filename)
5159 (goto-char (point-min))
5160 (while (not (eobp))
5161 (push (tramp-parse-rhosts-group) res))))
5162 res))
5163
5164 (defun tramp-parse-rhosts-group ()
5165 "Return a (user host) tuple allowed to access.
5166 Either user or host may be nil."
5167 (let ((result)
5168 (regexp
5169 (concat
5170 "^\\(" tramp-host-regexp "\\)"
5171 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
5172 (narrow-to-region (point) (tramp-compat-line-end-position))
5173 (when (re-search-forward regexp nil t)
5174 (setq result (append (list (match-string 3) (match-string 1)))))
5175 (widen)
5176 (forward-line 1)
5177 result))
5178
5179 (defun tramp-parse-shosts (filename)
5180 "Return a list of (user host) tuples allowed to access.
5181 User is always nil."
5182 ;; On Windows, there are problems in completion when
5183 ;; `default-directory' is remote.
5184 (let ((default-directory (tramp-compat-temporary-file-directory))
5185 res)
5186 (when (file-readable-p filename)
5187 (with-temp-buffer
5188 (insert-file-contents filename)
5189 (goto-char (point-min))
5190 (while (not (eobp))
5191 (push (tramp-parse-shosts-group) res))))
5192 res))
5193
5194 (defun tramp-parse-shosts-group ()
5195 "Return a (user host) tuple allowed to access.
5196 User is always nil."
5197 (let ((result)
5198 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
5199 (narrow-to-region (point) (tramp-compat-line-end-position))
5200 (when (re-search-forward regexp nil t)
5201 (setq result (list nil (match-string 1))))
5202 (widen)
5203 (or
5204 (> (skip-chars-forward ",") 0)
5205 (forward-line 1))
5206 result))
5207
5208 (defun tramp-parse-sconfig (filename)
5209 "Return a list of (user host) tuples allowed to access.
5210 User is always nil."
5211 ;; On Windows, there are problems in completion when
5212 ;; `default-directory' is remote.
5213 (let ((default-directory (tramp-compat-temporary-file-directory))
5214 res)
5215 (when (file-readable-p filename)
5216 (with-temp-buffer
5217 (insert-file-contents filename)
5218 (goto-char (point-min))
5219 (while (not (eobp))
5220 (push (tramp-parse-sconfig-group) res))))
5221 res))
5222
5223 (defun tramp-parse-sconfig-group ()
5224 "Return a (user host) tuple allowed to access.
5225 User is always nil."
5226 (let ((result)
5227 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
5228 (narrow-to-region (point) (tramp-compat-line-end-position))
5229 (when (re-search-forward regexp nil t)
5230 (setq result (list nil (match-string 1))))
5231 (widen)
5232 (or
5233 (> (skip-chars-forward ",") 0)
5234 (forward-line 1))
5235 result))
5236
5237 (defun tramp-parse-shostkeys (dirname)
5238 "Return a list of (user host) tuples allowed to access.
5239 User is always nil."
5240 ;; On Windows, there are problems in completion when
5241 ;; `default-directory' is remote.
5242 (let* ((default-directory (tramp-compat-temporary-file-directory))
5243 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
5244 (files (when (file-directory-p dirname) (directory-files dirname)))
5245 result)
5246 (while files
5247 (when (string-match regexp (car files))
5248 (push (list nil (match-string 1 (car files))) result))
5249 (setq files (cdr files)))
5250 result))
5251
5252 (defun tramp-parse-sknownhosts (dirname)
5253 "Return a list of (user host) tuples allowed to access.
5254 User is always nil."
5255 ;; On Windows, there are problems in completion when
5256 ;; `default-directory' is remote.
5257 (let* ((default-directory (tramp-compat-temporary-file-directory))
5258 (regexp (concat "^\\(" tramp-host-regexp
5259 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
5260 (files (when (file-directory-p dirname) (directory-files dirname)))
5261 result)
5262 (while files
5263 (when (string-match regexp (car files))
5264 (push (list nil (match-string 1 (car files))) result))
5265 (setq files (cdr files)))
5266 result))
5267
5268 (defun tramp-parse-hosts (filename)
5269 "Return a list of (user host) tuples allowed to access.
5270 User is always nil."
5271 ;; On Windows, there are problems in completion when
5272 ;; `default-directory' is remote.
5273 (let ((default-directory (tramp-compat-temporary-file-directory))
5274 res)
5275 (when (file-readable-p filename)
5276 (with-temp-buffer
5277 (insert-file-contents filename)
5278 (goto-char (point-min))
5279 (while (not (eobp))
5280 (push (tramp-parse-hosts-group) res))))
5281 res))
5282
5283 (defun tramp-parse-hosts-group ()
5284 "Return a (user host) tuple allowed to access.
5285 User is always nil."
5286 (let ((result)
5287 (regexp
5288 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
5289 (narrow-to-region (point) (tramp-compat-line-end-position))
5290 (when (re-search-forward regexp nil t)
5291 (setq result (list nil (match-string 1))))
5292 (widen)
5293 (or
5294 (> (skip-chars-forward " \t") 0)
5295 (forward-line 1))
5296 result))
5297
5298 ;; For su-alike methods it would be desirable to return "root@localhost"
5299 ;; as default. Unfortunately, we have no information whether any user name
5300 ;; has been typed already. So we use `tramp-current-user' as indication,
5301 ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
5302 (defun tramp-parse-passwd (filename)
5303 "Return a list of (user host) tuples allowed to access.
5304 Host is always \"localhost\"."
5305 ;; On Windows, there are problems in completion when
5306 ;; `default-directory' is remote.
5307 (let ((default-directory (tramp-compat-temporary-file-directory))
5308 res)
5309 (if (zerop (length tramp-current-user))
5310 '(("root" nil))
5311 (when (file-readable-p filename)
5312 (with-temp-buffer
5313 (insert-file-contents filename)
5314 (goto-char (point-min))
5315 (while (not (eobp))
5316 (push (tramp-parse-passwd-group) res))))
5317 res)))
5318
5319 (defun tramp-parse-passwd-group ()
5320 "Return a (user host) tuple allowed to access.
5321 Host is always \"localhost\"."
5322 (let ((result)
5323 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
5324 (narrow-to-region (point) (tramp-compat-line-end-position))
5325 (when (re-search-forward regexp nil t)
5326 (setq result (list (match-string 1) "localhost")))
5327 (widen)
5328 (forward-line 1)
5329 result))
5330
5331 (defun tramp-parse-netrc (filename)
5332 "Return a list of (user host) tuples allowed to access.
5333 User may be nil."
5334 ;; On Windows, there are problems in completion when
5335 ;; `default-directory' is remote.
5336 (let ((default-directory (tramp-compat-temporary-file-directory))
5337 res)
5338 (when (file-readable-p filename)
5339 (with-temp-buffer
5340 (insert-file-contents filename)
5341 (goto-char (point-min))
5342 (while (not (eobp))
5343 (push (tramp-parse-netrc-group) res))))
5344 res))
5345
5346 (defun tramp-parse-netrc-group ()
5347 "Return a (user host) tuple allowed to access.
5348 User may be nil."
5349 (let ((result)
5350 (regexp
5351 (concat
5352 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
5353 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
5354 (narrow-to-region (point) (tramp-compat-line-end-position))
5355 (when (re-search-forward regexp nil t)
5356 (setq result (list (match-string 3) (match-string 1))))
5357 (widen)
5358 (forward-line 1)
5359 result))
5360
5361 (defun tramp-parse-putty (registry)
5362 "Return a list of (user host) tuples allowed to access.
5363 User is always nil."
5364 ;; On Windows, there are problems in completion when
5365 ;; `default-directory' is remote.
5366 (let ((default-directory (tramp-compat-temporary-file-directory))
5367 res)
5368 (with-temp-buffer
5369 (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
5370 (goto-char (point-min))
5371 (while (not (eobp))
5372 (push (tramp-parse-putty-group registry) res))))
5373 res))
5374
5375 (defun tramp-parse-putty-group (registry)
5376 "Return a (user host) tuple allowed to access.
5377 User is always nil."
5378 (let ((result)
5379 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
5380 (narrow-to-region (point) (tramp-compat-line-end-position))
5381 (when (re-search-forward regexp nil t)
5382 (setq result (list nil (match-string 1))))
5383 (widen)
5384 (forward-line 1)
5385 result))
5386
5387 ;;; Internal Functions:
5388
5389 (defun tramp-maybe-send-script (vec script name)
5390 "Define in remote shell function NAME implemented as SCRIPT.
5391 Only send the definition if it has not already been done."
5392 (let* ((p (tramp-get-connection-process vec))
5393 (scripts (tramp-get-connection-property p "scripts" nil)))
5394 (unless (member name scripts)
5395 (tramp-message vec 5 "Sending script `%s'..." name)
5396 ;; The script could contain a call of Perl. This is masked with `%s'.
5397 (tramp-send-command-and-check
5398 vec
5399 (format "%s () {\n%s\n}" name
5400 (format script (tramp-get-remote-perl vec))))
5401 (tramp-set-connection-property p "scripts" (cons name scripts))
5402 (tramp-message vec 5 "Sending script `%s'...done." name))))
5403
5404 (defun tramp-set-auto-save ()
5405 (when (and ;; ange-ftp has its own auto-save mechanism
5406 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
5407 'tramp-sh-file-name-handler)
5408 auto-save-default)
5409 (auto-save-mode 1)))
5410 (add-hook 'find-file-hooks 'tramp-set-auto-save t)
5411 (add-hook 'tramp-unload-hook
5412 '(lambda ()
5413 (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
5414
5415 (defun tramp-run-test (switch filename)
5416 "Run `test' on the remote system, given a SWITCH and a FILENAME.
5417 Returns the exit code of the `test' program."
5418 (with-parsed-tramp-file-name filename nil
5419 (tramp-send-command-and-check
5420 v
5421 (format
5422 "%s %s %s"
5423 (tramp-get-test-command v)
5424 switch
5425 (tramp-shell-quote-argument localname)))))
5426
5427 (defun tramp-run-test2 (format-string file1 file2)
5428 "Run `test'-like program on the remote system, given FILE1, FILE2.
5429 FORMAT-STRING contains the program name, switches, and place holders.
5430 Returns the exit code of the `test' program. Barfs if the methods,
5431 hosts, or files, disagree."
5432 (unless (tramp-equal-remote file1 file2)
5433 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
5434 (tramp-error
5435 v 'file-error
5436 "tramp-run-test2 only implemented for same method, user, host")))
5437 (with-parsed-tramp-file-name file1 v1
5438 (with-parsed-tramp-file-name file1 v2
5439 (tramp-send-command-and-check
5440 v1
5441 (format format-string
5442 (tramp-shell-quote-argument v1-localname)
5443 (tramp-shell-quote-argument v2-localname))))))
5444
5445 (defun tramp-buffer-name (vec)
5446 "A name for the connection buffer VEC."
5447 ;; We must use `tramp-file-name-real-host', because for gateway
5448 ;; methods the default port will be expanded later on, which would
5449 ;; tamper the name.
5450 (let ((method (tramp-file-name-method vec))
5451 (user (tramp-file-name-user vec))
5452 (host (tramp-file-name-real-host vec)))
5453 (if (not (zerop (length user)))
5454 (format "*tramp/%s %s@%s*" method user host)
5455 (format "*tramp/%s %s*" method host))))
5456
5457 (defun tramp-get-buffer (vec)
5458 "Get the connection buffer to be used for VEC."
5459 (or (get-buffer (tramp-buffer-name vec))
5460 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
5461 (setq buffer-undo-list t)
5462 (setq default-directory
5463 (tramp-make-tramp-file-name
5464 (tramp-file-name-method vec)
5465 (tramp-file-name-user vec)
5466 (tramp-file-name-host vec)
5467 "/"))
5468 (current-buffer))))
5469
5470 (defun tramp-get-connection-buffer (vec)
5471 "Get the connection buffer to be used for VEC.
5472 In case a second asynchronous communication has been started, it is different
5473 from `tramp-get-buffer'."
5474 (or (tramp-get-connection-property vec "process-buffer" nil)
5475 (tramp-get-buffer vec)))
5476
5477 (defun tramp-get-connection-process (vec)
5478 "Get the connection process to be used for VEC.
5479 In case a second asynchronous communication has been started, it is different
5480 from the default one."
5481 (get-process
5482 (or (tramp-get-connection-property vec "process-name" nil)
5483 (tramp-buffer-name vec))))
5484
5485 (defun tramp-debug-buffer-name (vec)
5486 "A name for the debug buffer for VEC."
5487 ;; We must use `tramp-file-name-real-host', because for gateway
5488 ;; methods the default port will be expanded later on, which would
5489 ;; tamper the name.
5490 (let ((method (tramp-file-name-method vec))
5491 (user (tramp-file-name-user vec))
5492 (host (tramp-file-name-real-host vec)))
5493 (if (not (zerop (length user)))
5494 (format "*debug tramp/%s %s@%s*" method user host)
5495 (format "*debug tramp/%s %s*" method host))))
5496
5497 (defun tramp-get-debug-buffer (vec)
5498 "Get the debug buffer for VEC."
5499 (with-current-buffer
5500 (get-buffer-create (tramp-debug-buffer-name vec))
5501 (when (bobp)
5502 (setq buffer-undo-list t)
5503 ;; Activate outline-mode. This runs `text-mode-hook' and
5504 ;; `outline-mode-hook'. We must prevent that local processes
5505 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell"
5506 ;; ...
5507 (let ((default-directory (tramp-compat-temporary-file-directory)))
5508 (outline-mode))
5509 (set (make-local-variable 'outline-regexp)
5510 "[0-9]+:[0-9]+:[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
5511 ; (set (make-local-variable 'outline-regexp)
5512 ; "[a-z.-]+:[0-9]+: [a-z0-9-]+ (\\([0-9]+\\)) #")
5513 (set (make-local-variable 'outline-level) 'tramp-outline-level))
5514 (current-buffer)))
5515
5516 (defun tramp-outline-level ()
5517 "Return the depth to which a statement is nested in the outline.
5518 Point must be at the beginning of a header line.
5519
5520 The outline level is equal to the verbosity of the Tramp message."
5521 (1+ (string-to-number (match-string 1))))
5522
5523 (defun tramp-find-executable
5524 (vec progname dirlist &optional ignore-tilde ignore-path)
5525 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
5526 First arg VEC specifies the connection, PROGNAME is the program
5527 to search for, and DIRLIST gives the list of directories to
5528 search. If IGNORE-TILDE is non-nil, directory names starting
5529 with `~' will be ignored. If IGNORE-PATH is non-nil, searches
5530 only in DIRLIST.
5531
5532 Returns the absolute file name of PROGNAME, if found, and nil otherwise.
5533
5534 This function expects to be in the right *tramp* buffer."
5535 (with-current-buffer (tramp-get-buffer vec)
5536 (let (result)
5537 ;; Check whether the executable is in $PATH. "which(1)" does not
5538 ;; report always a correct error code; therefore we check the
5539 ;; number of words it returns.
5540 (unless ignore-path
5541 (tramp-send-command vec (format "which \\%s | wc -w" progname))
5542 (goto-char (point-min))
5543 (if (looking-at "^1$")
5544 (setq result (concat "\\" progname))))
5545 (unless result
5546 (when ignore-tilde
5547 ;; Remove all ~/foo directories from dirlist. In Emacs 20,
5548 ;; `remove' is in CL, and we want to avoid CL dependencies.
5549 (let (newdl d)
5550 (while dirlist
5551 (setq d (car dirlist))
5552 (setq dirlist (cdr dirlist))
5553 (unless (char-equal ?~ (aref d 0))
5554 (setq newdl (cons d newdl))))
5555 (setq dirlist (nreverse newdl))))
5556 (tramp-send-command
5557 vec
5558 (format (concat "while read d; "
5559 "do if test -x $d/%s -a -f $d/%s; "
5560 "then echo tramp_executable $d/%s; "
5561 "break; fi; done <<'EOF'\n"
5562 "%s\nEOF")
5563 progname progname progname (mapconcat 'identity dirlist "\n")))
5564 (goto-char (point-max))
5565 (when (search-backward "tramp_executable " nil t)
5566 (skip-chars-forward "^ ")
5567 (skip-chars-forward " ")
5568 (setq result (buffer-substring
5569 (point) (tramp-compat-line-end-position)))))
5570 result)))
5571
5572 (defun tramp-set-remote-path (vec)
5573 "Sets the remote environment PATH to existing directories.
5574 I.e., for each directory in `tramp-remote-path', it is tested
5575 whether it exists and if so, it is added to the environment
5576 variable PATH."
5577 (tramp-message vec 5 (format "Setting $PATH environment variable"))
5578 (tramp-send-command
5579 vec (format "PATH=%s; export PATH"
5580 (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
5581
5582 ;; ------------------------------------------------------------
5583 ;; -- Communication with external shell --
5584 ;; ------------------------------------------------------------
5585
5586 (defun tramp-find-file-exists-command (vec)
5587 "Find a command on the remote host for checking if a file exists.
5588 Here, we are looking for a command which has zero exit status if the
5589 file exists and nonzero exit status otherwise."
5590 (let ((existing "/")
5591 (nonexisting
5592 (tramp-shell-quote-argument "/ this file does not exist "))
5593 result)
5594 ;; The algorithm is as follows: we try a list of several commands.
5595 ;; For each command, we first run `$cmd /' -- this should return
5596 ;; true, as the root directory always exists. And then we run
5597 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
5598 ;; does not exist. This should return false. We use the first
5599 ;; command we find that seems to work.
5600 ;; The list of commands to try is as follows:
5601 ;; `ls -d' This works on most systems, but NetBSD 1.4
5602 ;; has a bug: `ls' always returns zero exit
5603 ;; status, even for files which don't exist.
5604 ;; `test -e' Some Bourne shells have a `test' builtin
5605 ;; which does not know the `-e' option.
5606 ;; `/bin/test -e' For those, the `test' binary on disk normally
5607 ;; provides the option. Alas, the binary
5608 ;; is sometimes `/bin/test' and sometimes it's
5609 ;; `/usr/bin/test'.
5610 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
5611 (unless (or
5612 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
5613 (zerop (tramp-send-command-and-check
5614 vec (format "%s %s" result existing)))
5615 (not (zerop (tramp-send-command-and-check
5616 vec (format "%s %s" result nonexisting)))))
5617 (and (setq result "/bin/test -e")
5618 (zerop (tramp-send-command-and-check
5619 vec (format "%s %s" result existing)))
5620 (not (zerop (tramp-send-command-and-check
5621 vec (format "%s %s" result nonexisting)))))
5622 (and (setq result "/usr/bin/test -e")
5623 (zerop (tramp-send-command-and-check
5624 vec (format "%s %s" result existing)))
5625 (not (zerop (tramp-send-command-and-check
5626 vec (format "%s %s" result nonexisting)))))
5627 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
5628 (zerop (tramp-send-command-and-check
5629 vec (format "%s %s" result existing)))
5630 (not (zerop (tramp-send-command-and-check
5631 vec (format "%s %s" result nonexisting))))))
5632 (tramp-error
5633 vec 'file-error "Couldn't find command to check if file exists"))
5634 result))
5635
5636 ;; CCC test ksh or bash found for tilde expansion?
5637 (defun tramp-find-shell (vec)
5638 "Opens a shell on the remote host which groks tilde expansion."
5639 (unless (tramp-get-connection-property vec "remote-shell" nil)
5640 (let (shell)
5641 (with-current-buffer (tramp-get-buffer vec)
5642 (tramp-send-command vec "echo ~root" t)
5643 (cond
5644 ((string-match "^~root$" (buffer-string))
5645 (setq shell
5646 (or (tramp-find-executable
5647 vec "bash" (tramp-get-remote-path vec) t)
5648 (tramp-find-executable
5649 vec "ksh" (tramp-get-remote-path vec) t)))
5650 (unless shell
5651 (tramp-error
5652 vec 'file-error
5653 "Couldn't find a shell which groks tilde expansion"))
5654 ;; Find arguments for this shell.
5655 (let ((alist tramp-sh-extra-args)
5656 item extra-args)
5657 (while (and alist (null extra-args))
5658 (setq item (pop alist))
5659 (when (string-match (car item) shell)
5660 (setq extra-args (cdr item))))
5661 (when extra-args (setq shell (concat shell " " extra-args))))
5662 (tramp-message
5663 vec 5 "Starting remote shell `%s' for tilde expansion..." shell)
5664 (let ((tramp-end-of-output "$ "))
5665 (tramp-send-command
5666 vec
5667 (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell)
5668 t))
5669 ;; Setting prompts.
5670 (tramp-message vec 5 "Setting remote shell prompt...")
5671 (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t)
5672 (tramp-send-command vec "PS2=''" t)
5673 (tramp-send-command vec "PS3=''" t)
5674 (tramp-send-command vec "PROMPT_COMMAND=''" t)
5675 (tramp-message vec 5 "Setting remote shell prompt...done"))
5676
5677 (t (tramp-message
5678 vec 5 "Remote `%s' groks tilde expansion, good"
5679 (tramp-get-method-parameter
5680 (tramp-file-name-method vec) 'tramp-remote-sh))
5681 (tramp-set-connection-property
5682 vec "remote-shell"
5683 (tramp-get-method-parameter
5684 (tramp-file-name-method vec) 'tramp-remote-sh))))))))
5685
5686 ;; ------------------------------------------------------------
5687 ;; -- Functions for establishing connection --
5688 ;; ------------------------------------------------------------
5689
5690 ;; The following functions are actions to be taken when seeing certain
5691 ;; prompts from the remote host. See the variable
5692 ;; `tramp-actions-before-shell' for usage of these functions.
5693
5694 (defun tramp-action-login (proc vec)
5695 "Send the login name."
5696 (when (not (stringp tramp-current-user))
5697 (save-window-excursion
5698 (let ((enable-recursive-minibuffers t))
5699 (pop-to-buffer (tramp-get-connection-buffer vec))
5700 (setq tramp-current-user (read-string (match-string 0))))))
5701 (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
5702 (with-current-buffer (tramp-get-connection-buffer vec)
5703 (tramp-message vec 6 "\n%s" (buffer-string)))
5704 (tramp-send-string vec tramp-current-user))
5705
5706 (defun tramp-action-password (proc vec)
5707 "Query the user for a password."
5708 (tramp-message vec 3 "Sending password")
5709 (tramp-enter-password proc))
5710
5711 (defun tramp-action-succeed (proc vec)
5712 "Signal success in finding shell prompt."
5713 (throw 'tramp-action 'ok))
5714
5715 (defun tramp-action-permission-denied (proc vec)
5716 "Signal permission denied."
5717 (kill-process proc)
5718 (throw 'tramp-action 'permission-denied))
5719
5720 (defun tramp-action-yesno (proc vec)
5721 "Ask the user for confirmation using `yes-or-no-p'.
5722 Send \"yes\" to remote process on confirmation, abort otherwise.
5723 See also `tramp-action-yn'."
5724 (save-window-excursion
5725 (let ((enable-recursive-minibuffers t))
5726 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
5727 (unless (yes-or-no-p (match-string 0))
5728 (kill-process proc)
5729 (throw 'tramp-action 'permission-denied))
5730 (with-current-buffer (tramp-get-connection-buffer vec)
5731 (tramp-message vec 6 "\n%s" (buffer-string)))
5732 (tramp-send-string vec "yes"))))
5733
5734 (defun tramp-action-yn (proc vec)
5735 "Ask the user for confirmation using `y-or-n-p'.
5736 Send \"y\" to remote process on confirmation, abort otherwise.
5737 See also `tramp-action-yesno'."
5738 (save-window-excursion
5739 (let ((enable-recursive-minibuffers t))
5740 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
5741 (unless (y-or-n-p (match-string 0))
5742 (kill-process proc)
5743 (throw 'tramp-action 'permission-denied))
5744 (with-current-buffer (tramp-get-connection-buffer vec)
5745 (tramp-message vec 6 "\n%s" (buffer-string)))
5746 (tramp-send-string vec "y"))))
5747
5748 (defun tramp-action-terminal (proc vec)
5749 "Tell the remote host which terminal type to use.
5750 The terminal type can be configured with `tramp-terminal-type'."
5751 (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
5752 (with-current-buffer (tramp-get-connection-buffer vec)
5753 (tramp-message vec 6 "\n%s" (buffer-string)))
5754 (tramp-send-string vec tramp-terminal-type))
5755
5756 (defun tramp-action-process-alive (proc vec)
5757 "Check whether a process has finished."
5758 (unless (memq (process-status proc) '(run open))
5759 (throw 'tramp-action 'process-died)))
5760
5761 (defun tramp-action-out-of-band (proc vec)
5762 "Check whether an out-of-band copy has finished."
5763 (cond ((and (memq (process-status proc) '(stop exit))
5764 (zerop (process-exit-status proc)))
5765 (tramp-message vec 3 "Process has finished.")
5766 (throw 'tramp-action 'ok))
5767 ((or (and (memq (process-status proc) '(stop exit))
5768 (not (zerop (process-exit-status proc))))
5769 (memq (process-status proc) '(signal)))
5770 ;; `scp' could have copied correctly, but set modes could have failed.
5771 ;; This can be ignored.
5772 (with-current-buffer (process-buffer proc)
5773 (goto-char (point-min))
5774 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
5775 (progn
5776 (tramp-message vec 5 "'set mode' error ignored.")
5777 (tramp-message vec 3 "Process has finished.")
5778 (throw 'tramp-action 'ok))
5779 (tramp-message vec 3 "Process has died.")
5780 (throw 'tramp-action 'process-died))))
5781 (t nil)))
5782
5783 ;; Functions for processing the actions.
5784
5785 (defun tramp-process-one-action (proc vec actions)
5786 "Wait for output from the shell and perform one action."
5787 (let (found todo item pattern action)
5788 (while (not found)
5789 ;; Reread output once all actions have been performed.
5790 ;; Obviously, the output was not complete.
5791 (tramp-accept-process-output proc 1)
5792 (setq todo actions)
5793 (while todo
5794 (setq item (pop todo))
5795 (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
5796 (setq action (nth 1 item))
5797 (tramp-message
5798 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
5799 (when (tramp-check-for-regexp proc pattern)
5800 (tramp-message vec 5 "Call `%s'" (symbol-name action))
5801 (setq found (funcall action proc vec)))))
5802 found))
5803
5804 (defun tramp-process-actions (proc vec actions &optional timeout)
5805 "Perform actions until success or TIMEOUT."
5806 ;; Enable auth-sorce and password-cache.
5807 (tramp-set-connection-property proc "first-password-request" t)
5808 (let (exit)
5809 (while (not exit)
5810 (tramp-message proc 3 "Waiting for prompts from remote shell")
5811 (setq exit
5812 (catch 'tramp-action
5813 (if timeout
5814 (with-timeout (timeout)
5815 (tramp-process-one-action proc vec actions))
5816 (tramp-process-one-action proc vec actions)))))
5817 (with-current-buffer (tramp-get-connection-buffer vec)
5818 (tramp-message vec 6 "\n%s" (buffer-string)))
5819 (unless (eq exit 'ok)
5820 (tramp-clear-passwd vec)
5821 (tramp-error-with-buffer
5822 nil vec 'file-error
5823 (cond
5824 ((eq exit 'permission-denied) "Permission denied")
5825 ((eq exit 'process-died) "Process died")
5826 (t "Login failed"))))))
5827
5828 ;; Utility functions.
5829
5830 (defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
5831 "Like `accept-process-output' for Tramp processes.
5832 This is needed in order to hide `last-coding-system-used', which is set
5833 for process communication also."
5834 (with-current-buffer (process-buffer proc)
5835 (tramp-message proc 10 "%s %s" proc (process-status proc))
5836 (let (buffer-read-only last-coding-system-used)
5837 ;; Under Windows XP, accept-process-output doesn't return
5838 ;; sometimes. So we add an additional timeout.
5839 (with-timeout ((or timeout 1))
5840 (accept-process-output proc timeout timeout-msecs)))
5841 (tramp-message proc 10 "\n%s" (buffer-string))))
5842
5843 (defun tramp-check-for-regexp (proc regexp)
5844 "Check whether REGEXP is contained in process buffer of PROC.
5845 Erase echoed commands if exists."
5846 (with-current-buffer (process-buffer proc)
5847 (goto-char (point-min))
5848
5849 ;; Check whether we need to remove echo output.
5850 (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
5851 (re-search-forward tramp-echoed-echo-mark-regexp nil t))
5852 (let ((begin (match-beginning 0)))
5853 (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
5854 ;; Discard echo from remote output.
5855 (tramp-set-connection-property proc "check-remote-echo" nil)
5856 (tramp-message proc 5 "echo-mark found")
5857 (forward-line)
5858 (delete-region begin (point))
5859 (goto-char (point-min)))))
5860
5861 (when (or
5862 ;; No echo to be handled, now we can look for the regexp.
5863 (not (tramp-get-connection-property proc "check-remote-echo" nil))
5864 ;; Sometimes the echo is invisible.
5865 (not (re-search-forward tramp-echo-mark-marker nil t)))
5866 (goto-char (point-min))
5867 (re-search-forward regexp nil t))))
5868
5869 (defun tramp-wait-for-regexp (proc timeout regexp)
5870 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
5871 Expects the output of PROC to be sent to the current buffer. Returns
5872 the string that matched, or nil. Waits indefinitely if TIMEOUT is
5873 nil."
5874 (with-current-buffer (process-buffer proc)
5875 (let ((found (tramp-check-for-regexp proc regexp))
5876 (start-time (current-time)))
5877 (cond (timeout
5878 ;; Work around a bug in XEmacs 21, where the timeout
5879 ;; expires faster than it should. This degenerates
5880 ;; to polling for buggy XEmacsen, but oh, well.
5881 (while (and (not found)
5882 (< (tramp-time-diff (current-time) start-time)
5883 timeout))
5884 (with-timeout (timeout)
5885 (while (not found)
5886 (tramp-accept-process-output proc 1)
5887 (unless (memq (process-status proc) '(run open))
5888 (tramp-error-with-buffer
5889 nil proc 'file-error "Process has died"))
5890 (setq found (tramp-check-for-regexp proc regexp))))))
5891 (t
5892 (while (not found)
5893 (tramp-accept-process-output proc 1)
5894 (unless (memq (process-status proc) '(run open))
5895 (tramp-error-with-buffer
5896 nil proc 'file-error "Process has died"))
5897 (setq found (tramp-check-for-regexp proc regexp)))))
5898 (tramp-message proc 6 "\n%s" (buffer-string))
5899 (when (not found)
5900 (if timeout
5901 (tramp-error
5902 proc 'file-error "[[Regexp `%s' not found in %d secs]]"
5903 regexp timeout)
5904 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
5905 found)))
5906
5907 (defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
5908 "Wait for shell prompt and barf if none appears.
5909 Looks at process PROC to see if a shell prompt appears in TIMEOUT
5910 seconds. If not, it produces an error message with the given ERROR-ARGS."
5911 (unless
5912 (tramp-wait-for-regexp
5913 proc timeout
5914 (format
5915 "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
5916 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
5917
5918 ;; We don't call `tramp-send-string' in order to hide the password
5919 ;; from the debug buffer, and because end-of-line handling of the
5920 ;; string.
5921 (defun tramp-enter-password (proc)
5922 "Prompt for a password and send it to the remote end."
5923 (process-send-string
5924 proc (concat (tramp-read-passwd proc)
5925 (or (tramp-get-method-parameter
5926 tramp-current-method
5927 'tramp-password-end-of-line)
5928 tramp-default-password-end-of-line))))
5929
5930 (defun tramp-open-connection-setup-interactive-shell (proc vec)
5931 "Set up an interactive shell.
5932 Mainly sets the prompt and the echo correctly. PROC is the shell
5933 process to set up. VEC specifies the connection."
5934 (let ((tramp-end-of-output "$ "))
5935 ;; It is useful to set the prompt in the following command because
5936 ;; some people have a setting for $PS1 which /bin/sh doesn't know
5937 ;; about and thus /bin/sh will display a strange prompt. For
5938 ;; example, if $PS1 has "${CWD}" in the value, then ksh will
5939 ;; display the current working directory but /bin/sh will display
5940 ;; a dollar sign. The following command line sets $PS1 to a sane
5941 ;; value, and works under Bourne-ish shells as well as csh-like
5942 ;; shells. Daniel Pittman reports that the unusual positioning of
5943 ;; the single quotes makes it work under `rc', too. We also unset
5944 ;; the variable $ENV because that is read by some sh
5945 ;; implementations (eg, bash when called as sh) on startup; this
5946 ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
5947 ;; is another way to set the prompt in /bin/bash, it must be
5948 ;; discarded as well.
5949 (tramp-send-command
5950 vec
5951 (format
5952 "exec env ENV='' PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' %s"
5953 (tramp-get-method-parameter
5954 (tramp-file-name-method vec) 'tramp-remote-sh))
5955 t)
5956
5957 ;; Disable echo.
5958 (tramp-message vec 5 "Setting up remote shell environment")
5959 (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
5960 ;; Check whether the echo has really been disabled. Some
5961 ;; implementations, like busybox of embedded GNU/Linux, don't
5962 ;; support disabling.
5963 (tramp-send-command vec "echo foo" t)
5964 (with-current-buffer (process-buffer proc)
5965 (goto-char (point-min))
5966 (when (looking-at "echo foo")
5967 (tramp-set-connection-property proc "remote-echo" t)
5968 (tramp-message vec 5 "Remote echo still on. Ok.")
5969 ;; Make sure backspaces and their echo are enabled and no line
5970 ;; width magic interferes with them.
5971 (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
5972
5973 (tramp-message vec 5 "Setting shell prompt")
5974 ;; We can set $PS1 to `tramp-end-of-output' only when the echo has
5975 ;; been disabled. Otherwise, the echo of the command would be
5976 ;; regarded as prompt already.
5977 (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t)
5978 (tramp-send-command vec "PS2=''" t)
5979 (tramp-send-command vec "PS3=''" t)
5980 (tramp-send-command vec "PROMPT_COMMAND=''" t)
5981
5982 ;; Try to set up the coding system correctly.
5983 ;; CCC this can't be the right way to do it. Hm.
5984 (tramp-message vec 5 "Determining coding system")
5985 (tramp-send-command vec "echo foo ; echo bar" t)
5986 (with-current-buffer (process-buffer proc)
5987 (goto-char (point-min))
5988 (if (featurep 'mule)
5989 ;; Use MULE to select the right EOL convention for communicating
5990 ;; with the process.
5991 (let* ((cs (or (funcall (symbol-function 'process-coding-system) proc)
5992 (cons 'undecided 'undecided)))
5993 cs-decode cs-encode)
5994 (when (symbolp cs) (setq cs (cons cs cs)))
5995 (setq cs-decode (car cs))
5996 (setq cs-encode (cdr cs))
5997 (unless cs-decode (setq cs-decode 'undecided))
5998 (unless cs-encode (setq cs-encode 'undecided))
5999 (setq cs-encode (tramp-coding-system-change-eol-conversion
6000 cs-encode 'unix))
6001 (when (search-forward "\r" nil t)
6002 (setq cs-decode (tramp-coding-system-change-eol-conversion
6003 cs-decode 'dos)))
6004 (funcall (symbol-function 'set-buffer-process-coding-system)
6005 cs-decode cs-encode))
6006 ;; Look for ^M and do something useful if found.
6007 (when (search-forward "\r" nil t)
6008 ;; We have found a ^M but cannot frob the process coding system
6009 ;; because we're running on a non-MULE Emacs. Let's try
6010 ;; stty, instead.
6011 (tramp-send-command vec "stty -onlcr" t))))
6012 (tramp-send-command vec "set +o vi +o emacs" t)
6013
6014 ;; Check whether the output of "uname -sr" has been changed. If
6015 ;; yes, this is a strong indication that we must expire all
6016 ;; connection properties. We start again with
6017 ;; `tramp-maybe-open-connection', it will be catched there.
6018 (tramp-message vec 5 "Checking system information")
6019 (let ((old-uname (tramp-get-connection-property vec "uname" nil))
6020 (new-uname
6021 (tramp-set-connection-property
6022 vec "uname"
6023 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
6024 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
6025 (with-current-buffer (tramp-get-debug-buffer vec)
6026 ;; Keep the debug buffer
6027 (rename-buffer
6028 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
6029 (funcall (symbol-function 'tramp-cleanup-connection) vec)
6030 (if (= (point-min) (point-max))
6031 (kill-buffer nil)
6032 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
6033 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
6034 (tramp-get-buffer vec)
6035 (tramp-message
6036 vec 3
6037 "Connection reset, because remote host changed from `%s' to `%s'"
6038 old-uname new-uname)
6039 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
6040
6041 ;; Check whether the remote host suffers from buggy
6042 ;; `send-process-string'. This is known for FreeBSD (see comment in
6043 ;; `send_process', file process.c). I've tested sending 624 bytes
6044 ;; successfully, sending 625 bytes failed. Emacs makes a hack when
6045 ;; this host type is detected locally. It cannot handle remote
6046 ;; hosts, though.
6047 (with-connection-property proc "chunksize"
6048 (cond
6049 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
6050 tramp-chunksize)
6051 (t
6052 (tramp-message
6053 vec 5 "Checking remote host type for `send-process-string' bug")
6054 (if (string-match
6055 "^FreeBSD" (tramp-get-connection-property vec "uname" ""))
6056 500 0))))
6057
6058 ;; Set remote PATH variable.
6059 (tramp-set-remote-path vec)
6060
6061 ;; Search for a good shell before searching for a command which
6062 ;; checks if a file exists. This is done because Tramp wants to use
6063 ;; "test foo; echo $?" to check if various conditions hold, and
6064 ;; there are buggy /bin/sh implementations which don't execute the
6065 ;; "echo $?" part if the "test" part has an error. In particular,
6066 ;; the Solaris /bin/sh is a problem. I'm betting that all systems
6067 ;; with buggy /bin/sh implementations will have a working bash or
6068 ;; ksh. Whee...
6069 (tramp-find-shell vec)
6070
6071 ;; Disable unexpected output.
6072 (tramp-send-command vec "mesg n; biff n" t)
6073
6074 ;; Set the environment.
6075 (tramp-message vec 5 "Setting default environment")
6076 (let ((env (copy-sequence tramp-remote-process-environment))
6077 unset item)
6078 (while env
6079 (setq item (split-string (car env) "="))
6080 (if (and (stringp (cadr item)) (not (string-equal (cadr item) "")))
6081 (tramp-send-command
6082 vec (format "%s=%s; export %s" (car item) (cadr item) (car item)) t)
6083 (push (car item) unset))
6084 (setq env (cdr env)))
6085 (when unset
6086 (tramp-send-command
6087 vec (format "unset %s" (mapconcat 'identity unset " "))))) t)
6088
6089 ;; CCC: We should either implement a Perl version of base64 encoding
6090 ;; and decoding. Then we just use that in the last item. The other
6091 ;; alternative is to use the Perl version of UU encoding. But then
6092 ;; we need a Lisp version of uuencode.
6093 ;;
6094 ;; Old text from documentation of tramp-methods:
6095 ;; Using a uuencode/uudecode inline method is discouraged, please use one
6096 ;; of the base64 methods instead since base64 encoding is much more
6097 ;; reliable and the commands are more standardized between the different
6098 ;; Unix versions. But if you can't use base64 for some reason, please
6099 ;; note that the default uudecode command does not work well for some
6100 ;; Unices, in particular AIX and Irix. For AIX, you might want to use
6101 ;; the following command for uudecode:
6102 ;;
6103 ;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
6104 ;;
6105 ;; For Irix, no solution is known yet.
6106
6107 (defconst tramp-local-coding-commands
6108 '((b64 base64-encode-region base64-decode-region)
6109 (uu tramp-uuencode-region uudecode-decode-region)
6110 (pack
6111 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
6112 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
6113 "List of local coding commands for inline transfer.
6114 Each item is a list that looks like this:
6115
6116 \(FORMAT ENCODING DECODING)
6117
6118 FORMAT is symbol describing the encoding/decoding format. It can be
6119 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
6120
6121 ENCODING and DECODING can be strings, giving commands, or symbols,
6122 giving functions. If they are strings, then they can contain
6123 the \"%s\" format specifier. If that specifier is present, the input
6124 filename will be put into the command line at that spot. If the
6125 specifier is not present, the input should be read from standard
6126 input.
6127
6128 If they are functions, they will be called with two arguments, start
6129 and end of region, and are expected to replace the region contents
6130 with the encoded or decoded results, respectively.")
6131
6132 (defconst tramp-remote-coding-commands
6133 '((b64 "base64" "base64 -d")
6134 (b64 "mimencode -b" "mimencode -u -b")
6135 (b64 "mmencode -b" "mmencode -u -b")
6136 (b64 "recode data..base64" "recode base64..data")
6137 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
6138 (b64 tramp-perl-encode tramp-perl-decode)
6139 (uu "uuencode xxx" "uudecode -o /dev/stdout")
6140 (uu "uuencode xxx" "uudecode -o -")
6141 (uu "uuencode xxx" "uudecode -p")
6142 (uu "uuencode xxx" tramp-uudecode)
6143 (pack
6144 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
6145 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
6146 "List of remote coding commands for inline transfer.
6147 Each item is a list that looks like this:
6148
6149 \(FORMAT ENCODING DECODING)
6150
6151 FORMAT is symbol describing the encoding/decoding format. It can be
6152 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
6153
6154 ENCODING and DECODING can be strings, giving commands, or symbols,
6155 giving variables. If they are strings, then they can contain
6156 the \"%s\" format specifier. If that specifier is present, the input
6157 filename will be put into the command line at that spot. If the
6158 specifier is not present, the input should be read from standard
6159 input.
6160
6161 If they are variables, this variable is a string containing a Perl
6162 implementation for this functionality. This Perl program will be transferred
6163 to the remote host, and it is avalible as shell function with the same name.")
6164
6165 (defun tramp-find-inline-encoding (vec)
6166 "Find an inline transfer encoding that works.
6167 Goes through the list `tramp-local-coding-commands' and
6168 `tramp-remote-coding-commands'."
6169 (save-excursion
6170 (let ((local-commands tramp-local-coding-commands)
6171 (magic "xyzzy")
6172 loc-enc loc-dec rem-enc rem-dec litem ritem found)
6173 (while (and local-commands (not found))
6174 (setq litem (pop local-commands))
6175 (catch 'wont-work-local
6176 (let ((format (nth 0 litem))
6177 (remote-commands tramp-remote-coding-commands))
6178 (setq loc-enc (nth 1 litem))
6179 (setq loc-dec (nth 2 litem))
6180 ;; If the local encoder or decoder is a string, the
6181 ;; corresponding command has to work locally.
6182 (if (not (stringp loc-enc))
6183 (tramp-message
6184 vec 5 "Checking local encoding function `%s'" loc-enc)
6185 (tramp-message
6186 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
6187 (unless (zerop (tramp-call-local-coding-command
6188 loc-enc nil nil))
6189 (throw 'wont-work-local nil)))
6190 (if (not (stringp loc-dec))
6191 (tramp-message
6192 vec 5 "Checking local decoding function `%s'" loc-dec)
6193 (tramp-message
6194 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
6195 (unless (zerop (tramp-call-local-coding-command
6196 loc-dec nil nil))
6197 (throw 'wont-work-local nil)))
6198 ;; Search for remote coding commands with the same format
6199 (while (and remote-commands (not found))
6200 (setq ritem (pop remote-commands))
6201 (catch 'wont-work-remote
6202 (when (equal format (nth 0 ritem))
6203 (setq rem-enc (nth 1 ritem))
6204 (setq rem-dec (nth 2 ritem))
6205 ;; Check if remote encoding and decoding commands can be
6206 ;; called remotely with null input and output. This makes
6207 ;; sure there are no syntax errors and the command is really
6208 ;; found. Note that we do not redirect stdout to /dev/null,
6209 ;; for two reasons: when checking the decoding command, we
6210 ;; actually check the output it gives. And also, when
6211 ;; redirecting "mimencode" output to /dev/null, then as root
6212 ;; it might change the permissions of /dev/null!
6213 (when (not (stringp rem-enc))
6214 (let ((name (symbol-name rem-enc)))
6215 (while (string-match (regexp-quote "-") name)
6216 (setq name (replace-match "_" nil t name)))
6217 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
6218 (setq rem-enc name)))
6219 (tramp-message
6220 vec 5
6221 "Checking remote encoding command `%s' for sanity" rem-enc)
6222 (unless (zerop (tramp-send-command-and-check
6223 vec (format "%s </dev/null" rem-enc) t))
6224 (throw 'wont-work-remote nil))
6225
6226 (when (not (stringp rem-dec))
6227 (let ((name (symbol-name rem-dec)))
6228 (while (string-match (regexp-quote "-") name)
6229 (setq name (replace-match "_" nil t name)))
6230 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
6231 (setq rem-dec name)))
6232 (tramp-message
6233 vec 5
6234 "Checking remote decoding command `%s' for sanity" rem-dec)
6235 (unless (zerop (tramp-send-command-and-check
6236 vec
6237 (format "echo %s | %s | %s"
6238 magic rem-enc rem-dec) t))
6239 (throw 'wont-work-remote nil))
6240
6241 (with-current-buffer (tramp-get-buffer vec)
6242 (goto-char (point-min))
6243 (unless (looking-at (regexp-quote magic))
6244 (throw 'wont-work-remote nil)))
6245
6246 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
6247 (setq rem-enc (nth 1 ritem))
6248 (setq rem-dec (nth 2 ritem))
6249 (setq found t)))))))
6250
6251 ;; Did we find something?
6252 (unless found
6253 (tramp-message vec 2 "Couldn't find an inline transfer encoding"))
6254
6255 ;; Set connection properties.
6256 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
6257 (tramp-set-connection-property vec "local-encoding" loc-enc)
6258 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
6259 (tramp-set-connection-property vec "local-decoding" loc-dec)
6260 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
6261 (tramp-set-connection-property vec "remote-encoding" rem-enc)
6262 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
6263 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
6264
6265 (defun tramp-call-local-coding-command (cmd input output)
6266 "Call the local encoding or decoding command.
6267 If CMD contains \"%s\", provide input file INPUT there in command.
6268 Otherwise, INPUT is passed via standard input.
6269 INPUT can also be nil which means `/dev/null'.
6270 OUTPUT can be a string (which specifies a filename), or t (which
6271 means standard output and thus the current buffer), or nil (which
6272 means discard it)."
6273 (tramp-local-call-process
6274 tramp-encoding-shell
6275 (when (and input (not (string-match "%s" cmd))) input)
6276 (if (eq output t) t nil)
6277 nil
6278 tramp-encoding-command-switch
6279 (concat
6280 (if (string-match "%s" cmd) (format cmd input) cmd)
6281 (if (stringp output) (concat "> " output) ""))))
6282
6283 (defun tramp-compute-multi-hops (vec)
6284 "Expands VEC according to `tramp-default-proxies-alist'.
6285 Gateway hops are already opened."
6286 (let ((target-alist `(,vec))
6287 (choices tramp-default-proxies-alist)
6288 item proxy)
6289
6290 ;; Look for proxy hosts to be passed.
6291 (while choices
6292 (setq item (pop choices)
6293 proxy (nth 2 item))
6294 (when (and
6295 ;; host
6296 (string-match (or (nth 0 item) "")
6297 (or (tramp-file-name-host (car target-alist)) ""))
6298 ;; user
6299 (string-match (or (nth 1 item) "")
6300 (or (tramp-file-name-user (car target-alist)) "")))
6301 (if (null proxy)
6302 ;; No more hops needed.
6303 (setq choices nil)
6304 ;; Replace placeholders.
6305 (setq proxy
6306 (format-spec
6307 proxy
6308 `((?u . ,(or (tramp-file-name-user (car target-alist)) ""))
6309 (?h . ,(or (tramp-file-name-host (car target-alist)) "")))))
6310 (with-parsed-tramp-file-name proxy l
6311 ;; Add the hop.
6312 (add-to-list 'target-alist l)
6313 ;; Start next search.
6314 (setq choices tramp-default-proxies-alist)))))
6315
6316 ;; Handle gateways.
6317 (when (and (boundp 'tramp-gw-tunnel-method)
6318 (string-match (format
6319 "^\\(%s\\|%s\\)$"
6320 (symbol-value 'tramp-gw-tunnel-method)
6321 (symbol-value 'tramp-gw-socks-method))
6322 (tramp-file-name-method (car target-alist))))
6323 (let ((gw (pop target-alist))
6324 (hop (pop target-alist)))
6325 ;; Is the method prepared for gateways?
6326 (unless (tramp-get-method-parameter
6327 (tramp-file-name-method hop) 'tramp-default-port)
6328 (tramp-error
6329 vec 'file-error
6330 "Method `%s' is not supported for gateway access."
6331 (tramp-file-name-method hop)))
6332 ;; Add default port if needed.
6333 (unless
6334 (string-match
6335 tramp-host-with-port-regexp (tramp-file-name-host hop))
6336 (aset hop 2
6337 (concat
6338 (tramp-file-name-host hop) tramp-prefix-port-format
6339 (number-to-string
6340 (tramp-get-method-parameter
6341 (tramp-file-name-method hop) 'tramp-default-port)))))
6342 ;; Open the gateway connection.
6343 (add-to-list
6344 'target-alist
6345 (vector
6346 (tramp-file-name-method hop) (tramp-file-name-user hop)
6347 (funcall (symbol-function 'tramp-gw-open-connection) vec gw hop) nil))
6348 ;; For the password prompt, we need the correct values.
6349 ;; Therefore, we must remember the gateway vector. But we
6350 ;; cannot do it as connection property, because it shouldn't
6351 ;; be persistent. And we have no started process yet either.
6352 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
6353
6354 ;; Foreign and out-of-band methods are not supported for multi-hops.
6355 (when (cdr target-alist)
6356 (setq choices target-alist)
6357 (while choices
6358 (setq item (pop choices))
6359 (when
6360 (or
6361 (not
6362 (tramp-get-method-parameter
6363 (tramp-file-name-method item) 'tramp-login-program))
6364 (tramp-get-method-parameter
6365 (tramp-file-name-method item) 'tramp-copy-program))
6366 (tramp-error
6367 vec 'file-error
6368 "Method `%s' is not supported for multi-hops."
6369 (tramp-file-name-method item)))))
6370
6371 ;; In case the host name is not used for the remote shell
6372 ;; command, the user could be misguided by applying a random
6373 ;; hostname.
6374 (let* ((v (car target-alist))
6375 (method (tramp-file-name-method v))
6376 (host (tramp-file-name-host v)))
6377 (unless
6378 (or
6379 ;; There are multi-hops.
6380 (cdr target-alist)
6381 ;; The host name is used for the remote shell command.
6382 (member
6383 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
6384 ;; The host is local. We cannot use `tramp-local-host-p'
6385 ;; here, because it opens a connection as well.
6386 (string-match tramp-local-host-regexp host))
6387 (tramp-error
6388 v 'file-error
6389 "Host `%s' looks like a remote host, `%s' can only use the local host"
6390 host method)))
6391
6392 ;; Result.
6393 target-alist))
6394
6395 (defun tramp-maybe-open-connection (vec)
6396 "Maybe open a connection VEC.
6397 Does not do anything if a connection is already open, but re-opens the
6398 connection if a previous connection has died for some reason."
6399 (catch 'uname-changed
6400 (let ((p (tramp-get-connection-process vec))
6401 (process-environment (copy-sequence process-environment)))
6402
6403 ;; If too much time has passed since last command was sent, look
6404 ;; whether process is still alive. If it isn't, kill it. When
6405 ;; using ssh, it can sometimes happen that the remote end has
6406 ;; hung up but the local ssh client doesn't recognize this until
6407 ;; it tries to send some data to the remote end. So that's why
6408 ;; we try to send a command from time to time, then look again
6409 ;; whether the process is really alive.
6410 (condition-case nil
6411 (when (and (> (tramp-time-diff
6412 (current-time)
6413 (tramp-get-connection-property
6414 p "last-cmd-time" '(0 0 0)))
6415 60)
6416 p (processp p) (memq (process-status p) '(run open)))
6417 (tramp-send-command vec "echo are you awake" t t)
6418 (unless (and (memq (process-status p) '(run open))
6419 (tramp-wait-for-output p 10))
6420 ;; The error will be catched locally.
6421 (tramp-error vec 'file-error "Awake did fail")))
6422 (file-error
6423 (tramp-flush-connection-property vec)
6424 (tramp-flush-connection-property p)
6425 (delete-process p)
6426 (setq p nil)))
6427
6428 ;; New connection must be opened.
6429 (unless (and p (processp p) (memq (process-status p) '(run open)))
6430
6431 ;; We call `tramp-get-buffer' in order to get a debug buffer for
6432 ;; messages from the beginning.
6433 (tramp-get-buffer vec)
6434 (if (zerop (length (tramp-file-name-user vec)))
6435 (tramp-message
6436 vec 3 "Opening connection for %s using %s..."
6437 (tramp-file-name-host vec)
6438 (tramp-file-name-method vec))
6439 (tramp-message
6440 vec 3 "Opening connection for %s@%s using %s..."
6441 (tramp-file-name-user vec)
6442 (tramp-file-name-host vec)
6443 (tramp-file-name-method vec)))
6444
6445 ;; Start new process.
6446 (when (and p (processp p))
6447 (delete-process p))
6448 (setenv "TERM" tramp-terminal-type)
6449 (setenv "LC_ALL" "C")
6450 (setenv "PROMPT_COMMAND")
6451 (setenv "PS1" "$ ")
6452 (let* ((target-alist (tramp-compute-multi-hops vec))
6453 (process-connection-type tramp-process-connection-type)
6454 (process-adaptive-read-buffering nil)
6455 (coding-system-for-read nil)
6456 ;; This must be done in order to avoid our file name handler.
6457 (p (let ((default-directory
6458 (tramp-compat-temporary-file-directory)))
6459 (start-process
6460 (or (tramp-get-connection-property vec "process-name" nil)
6461 (tramp-buffer-name vec))
6462 (tramp-get-connection-buffer vec)
6463 tramp-encoding-shell)))
6464 (first-hop t))
6465
6466 (tramp-message
6467 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
6468
6469 ;; Check whether process is alive.
6470 (tramp-set-process-query-on-exit-flag p nil)
6471 (tramp-message vec 3 "Waiting 60s for local shell to come up...")
6472 (tramp-barf-if-no-shell-prompt
6473 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
6474
6475 ;; Now do all the connections as specified.
6476 (while target-alist
6477 (let* ((hop (car target-alist))
6478 (l-method (tramp-file-name-method hop))
6479 (l-user (tramp-file-name-user hop))
6480 (l-host (tramp-file-name-host hop))
6481 (l-port nil)
6482 (login-program
6483 (tramp-get-method-parameter l-method 'tramp-login-program))
6484 (login-args
6485 (tramp-get-method-parameter l-method 'tramp-login-args))
6486 (gw-args
6487 (tramp-get-method-parameter l-method 'tramp-gw-args))
6488 (gw (tramp-get-file-property hop "" "gateway" nil))
6489 (g-method (and gw (tramp-file-name-method gw)))
6490 (g-user (and gw (tramp-file-name-user gw)))
6491 (g-host (and gw (tramp-file-name-host gw)))
6492 (command login-program)
6493 ;; We don't create the temporary file. In fact, it
6494 ;; is just a prefix for the ControlPath option of
6495 ;; ssh; the real temporary file has another name, and
6496 ;; it is created and protected by ssh. It is also
6497 ;; removed by ssh, when the connection is closed.
6498 (tmpfile
6499 (tramp-set-connection-property
6500 p "temp-file"
6501 (make-temp-name
6502 (expand-file-name
6503 tramp-temp-name-prefix
6504 (tramp-compat-temporary-file-directory)))))
6505 spec)
6506
6507 ;; Add gateway arguments if necessary.
6508 (when (and gw gw-args)
6509 (setq login-args (append login-args gw-args)))
6510
6511 ;; Check for port number. Until now, there's no need
6512 ;; for handling like method, user, host.
6513 (when (string-match tramp-host-with-port-regexp l-host)
6514 (setq l-port (match-string 2 l-host)
6515 l-host (match-string 1 l-host)))
6516
6517 ;; Set variables for computing the prompt for reading
6518 ;; password. They can also be derived from a gateway.
6519 (setq tramp-current-method (or g-method l-method)
6520 tramp-current-user (or g-user l-user)
6521 tramp-current-host (or g-host l-host))
6522
6523 ;; Replace login-args place holders.
6524 (setq
6525 l-host (or l-host "")
6526 l-user (or l-user "")
6527 l-port (or l-port "")
6528 spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port)
6529 (?t . ,tmpfile))
6530 command
6531 (concat
6532 command " "
6533 (mapconcat
6534 '(lambda (x)
6535 (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
6536 (unless (member "" x) (mapconcat 'identity x " ")))
6537 login-args " ")
6538 ;; String to detect failed connection. Every single
6539 ;; word must be enclosed with '\"'; otherwise it is
6540 ;; detected during connection setup.
6541 ;; Local shell could be a Windows COMSPEC. It doesn't
6542 ;; know the ";" syntax, but we must exit always for
6543 ;; `start-process'. "exec" does not work either.
6544 (if first-hop
6545 " && exit || exit"
6546 "; echo \"Tramp\" \"connection\" \"closed\"; sleep 1"))
6547 ;; We don't reach a Windows shell. Could be initial only.
6548 first-hop nil)
6549
6550 ;; Send the command.
6551 (tramp-message vec 3 "Sending command `%s'" command)
6552 (tramp-send-command vec command t t)
6553 (tramp-process-actions p vec tramp-actions-before-shell 60)
6554 (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
6555 ;; Next hop.
6556 (setq target-alist (cdr target-alist)))
6557
6558 ;; Make initial shell settings.
6559 (tramp-open-connection-setup-interactive-shell p vec))))))
6560
6561 (defun tramp-send-command (vec command &optional neveropen nooutput)
6562 "Send the COMMAND to connection VEC.
6563 Erases temporary buffer before sending the command. If optional
6564 arg NEVEROPEN is non-nil, never try to open the connection. This
6565 is meant to be used from `tramp-maybe-open-connection' only. The
6566 function waits for output unless NOOUTPUT is set."
6567 (unless neveropen (tramp-maybe-open-connection vec))
6568 (let ((p (tramp-get-connection-process vec)))
6569 (when (tramp-get-connection-property p "remote-echo" nil)
6570 ;; We mark the command string that it can be erased in the output buffer.
6571 (tramp-set-connection-property p "check-remote-echo" t)
6572 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
6573 (tramp-message vec 6 "%s" command)
6574 (tramp-send-string vec command)
6575 (unless nooutput (tramp-wait-for-output p))))
6576
6577 (defun tramp-wait-for-output (proc &optional timeout)
6578 "Wait for output from remote rsh command."
6579 (with-current-buffer (process-buffer proc)
6580 ;; Initially, `tramp-end-of-output' is "$ ". There might be
6581 ;; leading escape sequences, which must be ignored.
6582 (let* ((regexp
6583 (if (string-match (regexp-quote "\n") tramp-end-of-output)
6584 (mapconcat
6585 'identity (split-string tramp-end-of-output "\n") "\r?\n")
6586 (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output))))
6587 (found (tramp-wait-for-regexp proc timeout regexp)))
6588 (if found
6589 (let (buffer-read-only)
6590 (goto-char (point-max))
6591 (re-search-backward regexp nil t)
6592 (delete-region (point) (point-max)))
6593 (if timeout
6594 (tramp-error
6595 proc 'file-error
6596 "[[Remote prompt `%s' not found in %d secs]]"
6597 tramp-end-of-output timeout)
6598 (tramp-error
6599 proc 'file-error
6600 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
6601 ;; Return value is whether end-of-output sentinel was found.
6602 found)))
6603
6604 (defun tramp-send-command-and-check (vec command &optional subshell)
6605 "Run COMMAND and check its exit status.
6606 Sends `echo $?' along with the COMMAND for checking the exit status. If
6607 COMMAND is nil, just sends `echo $?'. Returns the exit status found.
6608
6609 If the optional argument SUBSHELL is non-nil, the command is executed in
6610 a subshell, ie surrounded by parentheses."
6611 (tramp-send-command
6612 vec
6613 (concat (if subshell "( " "")
6614 command
6615 (if command " 2>/dev/null; " "")
6616 "echo tramp_exit_status $?"
6617 (if subshell " )" " ")))
6618 (with-current-buffer (tramp-get-connection-buffer vec)
6619 (goto-char (point-max))
6620 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
6621 (tramp-error
6622 vec 'file-error "Couldn't find exit status of `%s'" command))
6623 (skip-chars-forward "^ ")
6624 (prog1
6625 (read (current-buffer))
6626 (let (buffer-read-only) (delete-region (match-beginning 0) (point-max))))))
6627
6628 (defun tramp-barf-unless-okay (vec command fmt &rest args)
6629 "Run COMMAND, check exit status, throw error if exit status not okay.
6630 Similar to `tramp-send-command-and-check' but accepts two more arguments
6631 FMT and ARGS which are passed to `error'."
6632 (unless (zerop (tramp-send-command-and-check vec command))
6633 (apply 'tramp-error vec 'file-error fmt args)))
6634
6635 (defun tramp-send-command-and-read (vec command)
6636 "Run COMMAND and return the output, which must be a Lisp expression.
6637 In case there is no valid Lisp expression, it raises an error"
6638 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
6639 (with-current-buffer (tramp-get-connection-buffer vec)
6640 ;; Read the expression.
6641 (goto-char (point-min))
6642 (condition-case nil
6643 (prog1 (read (current-buffer))
6644 ;; Error handling.
6645 (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t)
6646 (error nil)))
6647 (error (tramp-error
6648 vec 'file-error
6649 "`%s' does not return a valid Lisp expression: `%s'"
6650 command (buffer-string))))))
6651
6652 ;; It seems that Tru64 Unix does not like it if long strings are sent
6653 ;; to it in one go. (This happens when sending the Perl
6654 ;; `file-attributes' implementation, for instance.) Therefore, we
6655 ;; have this function which sends the string in chunks.
6656 (defun tramp-send-string (vec string)
6657 "Send the STRING via connection VEC.
6658
6659 The STRING is expected to use Unix line-endings, but the lines sent to
6660 the remote host use line-endings as defined in the variable
6661 `tramp-rsh-end-of-line'. The communication buffer is erased before sending."
6662 (let* ((p (tramp-get-connection-process vec))
6663 (chunksize (tramp-get-connection-property p "chunksize" nil)))
6664 (unless p
6665 (tramp-error
6666 vec 'file-error "Can't send string to remote host -- not logged in"))
6667 (tramp-set-connection-property p "last-cmd-time" (current-time))
6668 (tramp-message vec 10 "%s" string)
6669 (with-current-buffer (tramp-get-connection-buffer vec)
6670 ;; Clean up the buffer. We cannot call `erase-buffer' because
6671 ;; narrowing might be in effect.
6672 (let (buffer-read-only) (delete-region (point-min) (point-max)))
6673 ;; Replace "\n" by `tramp-rsh-end-of-line'.
6674 (setq string
6675 (mapconcat 'identity
6676 (split-string string "\n")
6677 tramp-rsh-end-of-line))
6678 (unless (or (string= string "")
6679 (string-equal (substring string -1) tramp-rsh-end-of-line))
6680 (setq string (concat string tramp-rsh-end-of-line)))
6681 ;; Send the string.
6682 (if (and chunksize (not (zerop chunksize)))
6683 (let ((pos 0)
6684 (end (length string)))
6685 (while (< pos end)
6686 (tramp-message
6687 vec 10 "Sending chunk from %s to %s"
6688 pos (min (+ pos chunksize) end))
6689 (process-send-string
6690 p (substring string pos (min (+ pos chunksize) end)))
6691 (setq pos (+ pos chunksize))))
6692 (process-send-string p string)))))
6693
6694 (defun tramp-mode-string-to-int (mode-string)
6695 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
6696 (let* (case-fold-search
6697 (mode-chars (string-to-vector mode-string))
6698 (owner-read (aref mode-chars 1))
6699 (owner-write (aref mode-chars 2))
6700 (owner-execute-or-setid (aref mode-chars 3))
6701 (group-read (aref mode-chars 4))
6702 (group-write (aref mode-chars 5))
6703 (group-execute-or-setid (aref mode-chars 6))
6704 (other-read (aref mode-chars 7))
6705 (other-write (aref mode-chars 8))
6706 (other-execute-or-sticky (aref mode-chars 9)))
6707 (save-match-data
6708 (logior
6709 (cond
6710 ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
6711 ((char-equal owner-read ?-) 0)
6712 (t (error "Second char `%c' must be one of `r-'" owner-read)))
6713 (cond
6714 ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
6715 ((char-equal owner-write ?-) 0)
6716 (t (error "Third char `%c' must be one of `w-'" owner-write)))
6717 (cond
6718 ((char-equal owner-execute-or-setid ?x)
6719 (tramp-octal-to-decimal "00100"))
6720 ((char-equal owner-execute-or-setid ?S)
6721 (tramp-octal-to-decimal "04000"))
6722 ((char-equal owner-execute-or-setid ?s)
6723 (tramp-octal-to-decimal "04100"))
6724 ((char-equal owner-execute-or-setid ?-) 0)
6725 (t (error "Fourth char `%c' must be one of `xsS-'"
6726 owner-execute-or-setid)))
6727 (cond
6728 ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
6729 ((char-equal group-read ?-) 0)
6730 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
6731 (cond
6732 ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
6733 ((char-equal group-write ?-) 0)
6734 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
6735 (cond
6736 ((char-equal group-execute-or-setid ?x)
6737 (tramp-octal-to-decimal "00010"))
6738 ((char-equal group-execute-or-setid ?S)
6739 (tramp-octal-to-decimal "02000"))
6740 ((char-equal group-execute-or-setid ?s)
6741 (tramp-octal-to-decimal "02010"))
6742 ((char-equal group-execute-or-setid ?-) 0)
6743 (t (error "Seventh char `%c' must be one of `xsS-'"
6744 group-execute-or-setid)))
6745 (cond
6746 ((char-equal other-read ?r)
6747 (tramp-octal-to-decimal "00004"))
6748 ((char-equal other-read ?-) 0)
6749 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
6750 (cond
6751 ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
6752 ((char-equal other-write ?-) 0)
6753 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
6754 (cond
6755 ((char-equal other-execute-or-sticky ?x)
6756 (tramp-octal-to-decimal "00001"))
6757 ((char-equal other-execute-or-sticky ?T)
6758 (tramp-octal-to-decimal "01000"))
6759 ((char-equal other-execute-or-sticky ?t)
6760 (tramp-octal-to-decimal "01001"))
6761 ((char-equal other-execute-or-sticky ?-) 0)
6762 (t (error "Tenth char `%c' must be one of `xtT-'"
6763 other-execute-or-sticky)))))))
6764
6765 (defun tramp-convert-file-attributes (vec attr)
6766 "Convert file-attributes ATTR generated by perl script, stat or ls.
6767 Convert file mode bits to string and set virtual device number.
6768 Return ATTR."
6769 ;; Convert last access time.
6770 (unless (listp (nth 4 attr))
6771 (setcar (nthcdr 4 attr)
6772 (list (floor (nth 4 attr) 65536)
6773 (floor (mod (nth 4 attr) 65536)))))
6774 ;; Convert last modification time.
6775 (unless (listp (nth 5 attr))
6776 (setcar (nthcdr 5 attr)
6777 (list (floor (nth 5 attr) 65536)
6778 (floor (mod (nth 5 attr) 65536)))))
6779 ;; Convert last status change time.
6780 (unless (listp (nth 6 attr))
6781 (setcar (nthcdr 6 attr)
6782 (list (floor (nth 6 attr) 65536)
6783 (floor (mod (nth 6 attr) 65536)))))
6784 ;; Convert file size.
6785 (when (< (nth 7 attr) 0)
6786 (setcar (nthcdr 7 attr) -1))
6787 (when (and (floatp (nth 7 attr))
6788 (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
6789 (setcar (nthcdr 7 attr) (round (nth 7 attr))))
6790 ;; Convert file mode bits to string.
6791 (unless (stringp (nth 8 attr))
6792 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
6793 (when (stringp (car attr))
6794 (aset (nth 8 attr) 0 ?l)))
6795 ;; Convert directory indication bit.
6796 (when (string-match "^d" (nth 8 attr))
6797 (setcar attr t))
6798 ;; Convert symlink from `tramp-handle-file-attributes-with-stat'.
6799 (when (consp (car attr))
6800 (if (and (stringp (caar attr))
6801 (string-match ".+ -> .\\(.+\\)." (caar attr)))
6802 (setcar attr (match-string 1 (caar attr)))
6803 (setcar attr nil)))
6804 ;; Set file's gid change bit.
6805 (setcar (nthcdr 9 attr)
6806 (if (numberp (nth 3 attr))
6807 (not (= (nth 3 attr)
6808 (tramp-get-remote-gid vec 'integer)))
6809 (not (string-equal
6810 (nth 3 attr)
6811 (tramp-get-remote-gid vec 'string)))))
6812 ;; Convert inode.
6813 (unless (listp (nth 10 attr))
6814 (setcar (nthcdr 10 attr)
6815 (condition-case nil
6816 (cons (floor (nth 10 attr) 65536)
6817 (floor (mod (nth 10 attr) 65536)))
6818 ;; Inodes can be incredible huge. We must hide this.
6819 (error (tramp-get-inode vec)))))
6820 ;; Set virtual device number.
6821 (setcar (nthcdr 11 attr)
6822 (tramp-get-device vec))
6823 attr)
6824
6825 (defun tramp-get-inode (vec)
6826 "Returns the virtual inode number.
6827 If it doesn't exist, generate a new one."
6828 (let ((string (tramp-make-tramp-file-name
6829 (tramp-file-name-method vec)
6830 (tramp-file-name-user vec)
6831 (tramp-file-name-host vec)
6832 "")))
6833 (unless (assoc string tramp-inodes)
6834 (add-to-list 'tramp-inodes
6835 (list string (length tramp-inodes))))
6836 (nth 1 (assoc string tramp-inodes))))
6837
6838 (defun tramp-get-device (vec)
6839 "Returns the virtual device number.
6840 If it doesn't exist, generate a new one."
6841 (let ((string (tramp-make-tramp-file-name
6842 (tramp-file-name-method vec)
6843 (tramp-file-name-user vec)
6844 (tramp-file-name-host vec)
6845 "")))
6846 (unless (assoc string tramp-devices)
6847 (add-to-list 'tramp-devices
6848 (list string (length tramp-devices))))
6849 (cons -1 (nth 1 (assoc string tramp-devices)))))
6850
6851 (defun tramp-file-mode-from-int (mode)
6852 "Turn an integer representing a file mode into an ls(1)-like string."
6853 (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
6854 (user (logand (lsh mode -6) 7))
6855 (group (logand (lsh mode -3) 7))
6856 (other (logand (lsh mode -0) 7))
6857 (suid (> (logand (lsh mode -9) 4) 0))
6858 (sgid (> (logand (lsh mode -9) 2) 0))
6859 (sticky (> (logand (lsh mode -9) 1) 0)))
6860 (setq user (tramp-file-mode-permissions user suid "s"))
6861 (setq group (tramp-file-mode-permissions group sgid "s"))
6862 (setq other (tramp-file-mode-permissions other sticky "t"))
6863 (concat type user group other)))
6864
6865 (defun tramp-file-mode-permissions (perm suid suid-text)
6866 "Convert a permission bitset into a string.
6867 This is used internally by `tramp-file-mode-from-int'."
6868 (let ((r (> (logand perm 4) 0))
6869 (w (> (logand perm 2) 0))
6870 (x (> (logand perm 1) 0)))
6871 (concat (or (and r "r") "-")
6872 (or (and w "w") "-")
6873 (or (and suid x suid-text) ; suid, execute
6874 (and suid (upcase suid-text)) ; suid, !execute
6875 (and x "x") "-")))) ; !suid
6876
6877 (defun tramp-decimal-to-octal (i)
6878 "Return a string consisting of the octal digits of I.
6879 Not actually used. Use `(format \"%o\" i)' instead?"
6880 (cond ((< i 0) (error "Cannot convert negative number to octal"))
6881 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
6882 ((zerop i) "0")
6883 (t (concat (tramp-decimal-to-octal (/ i 8))
6884 (number-to-string (% i 8))))))
6885
6886 ;; Kudos to Gerd Moellmann for this suggestion.
6887 (defun tramp-octal-to-decimal (ostr)
6888 "Given a string of octal digits, return a decimal number."
6889 (let ((x (or ostr "")))
6890 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
6891 (unless (string-match "\\`[0-7]*\\'" x)
6892 (error "Non-octal junk in string `%s'" x))
6893 (string-to-number ostr 8)))
6894
6895 (defun tramp-shell-case-fold (string)
6896 "Converts STRING to shell glob pattern which ignores case."
6897 (mapconcat
6898 (lambda (c)
6899 (if (equal (downcase c) (upcase c))
6900 (vector c)
6901 (format "[%c%c]" (downcase c) (upcase c))))
6902 string
6903 ""))
6904
6905
6906 ;; ------------------------------------------------------------
6907 ;; -- Tramp file names --
6908 ;; ------------------------------------------------------------
6909 ;; Conversion functions between external representation and
6910 ;; internal data structure. Convenience functions for internal
6911 ;; data structure.
6912
6913 (defun tramp-file-name-p (vec)
6914 "Check whether VEC is a Tramp object."
6915 (and (vectorp vec) (= 4 (length vec))))
6916
6917 (defun tramp-file-name-method (vec)
6918 "Return method component of VEC."
6919 (and (tramp-file-name-p vec) (aref vec 0)))
6920
6921 (defun tramp-file-name-user (vec)
6922 "Return user component of VEC."
6923 (and (tramp-file-name-p vec) (aref vec 1)))
6924
6925 (defun tramp-file-name-host (vec)
6926 "Return host component of VEC."
6927 (and (tramp-file-name-p vec) (aref vec 2)))
6928
6929 (defun tramp-file-name-localname (vec)
6930 "Return localname component of VEC."
6931 (and (tramp-file-name-p vec) (aref vec 3)))
6932
6933 ;; The user part of a Tramp file name vector can be of kind
6934 ;; "user%domain". Sometimes, we must extract these parts.
6935 (defun tramp-file-name-real-user (vec)
6936 "Return the user name of VEC without domain."
6937 (let ((user (tramp-file-name-user vec)))
6938 (if (and (stringp user)
6939 (string-match tramp-user-with-domain-regexp user))
6940 (match-string 1 user)
6941 user)))
6942
6943 (defun tramp-file-name-domain (vec)
6944 "Return the domain name of VEC."
6945 (let ((user (tramp-file-name-user vec)))
6946 (and (stringp user)
6947 (string-match tramp-user-with-domain-regexp user)
6948 (match-string 2 user))))
6949
6950 ;; The host part of a Tramp file name vector can be of kind
6951 ;; "host#port". Sometimes, we must extract these parts.
6952 (defun tramp-file-name-real-host (vec)
6953 "Return the host name of VEC without port."
6954 (let ((host (tramp-file-name-host vec)))
6955 (if (and (stringp host)
6956 (string-match tramp-host-with-port-regexp host))
6957 (match-string 1 host)
6958 host)))
6959
6960 (defun tramp-file-name-port (vec)
6961 "Return the port number of VEC."
6962 (let ((host (tramp-file-name-host vec)))
6963 (and (stringp host)
6964 (string-match tramp-host-with-port-regexp host)
6965 (string-to-number (match-string 2 host)))))
6966
6967 (defun tramp-tramp-file-p (name)
6968 "Return t if NAME is a Tramp file."
6969 (save-match-data
6970 (string-match tramp-file-name-regexp name)))
6971
6972 (defun tramp-find-method (method user host)
6973 "Return the right method string to use.
6974 This is METHOD, if non-nil. Otherwise, do a lookup in
6975 `tramp-default-method-alist'."
6976 (or method
6977 (let ((choices tramp-default-method-alist)
6978 lmethod item)
6979 (while choices
6980 (setq item (pop choices))
6981 (when (and (string-match (or (nth 0 item) "") (or host ""))
6982 (string-match (or (nth 1 item) "") (or user "")))
6983 (setq lmethod (nth 2 item))
6984 (setq choices nil)))
6985 lmethod)
6986 tramp-default-method))
6987
6988 (defun tramp-find-user (method user host)
6989 "Return the right user string to use.
6990 This is USER, if non-nil. Otherwise, do a lookup in
6991 `tramp-default-user-alist'."
6992 (or user
6993 (let ((choices tramp-default-user-alist)
6994 luser item)
6995 (while choices
6996 (setq item (pop choices))
6997 (when (and (string-match (or (nth 0 item) "") (or method ""))
6998 (string-match (or (nth 1 item) "") (or host "")))
6999 (setq luser (nth 2 item))
7000 (setq choices nil)))
7001 luser)
7002 tramp-default-user))
7003
7004 (defun tramp-find-host (method user host)
7005 "Return the right host string to use.
7006 This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
7007 (or (and (> (length host) 0) host)
7008 tramp-default-host))
7009
7010 (defun tramp-dissect-file-name (name &optional nodefault)
7011 "Return a `tramp-file-name' structure.
7012 The structure consists of remote method, remote user, remote host
7013 and localname (file name on remote host). If NODEFAULT is
7014 non-nil, the file name parts are not expanded to their default
7015 values."
7016 (save-match-data
7017 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
7018 (unless match (error "Not a Tramp file name: %s" name))
7019 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
7020 (user (match-string (nth 2 tramp-file-name-structure) name))
7021 (host (match-string (nth 3 tramp-file-name-structure) name))
7022 (localname (match-string (nth 4 tramp-file-name-structure) name)))
7023 (when (member method '("multi" "multiu"))
7024 (error
7025 "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
7026 method))
7027 (when host
7028 (when (string-match tramp-prefix-ipv6-regexp host)
7029 (setq host (replace-match "" nil t host)))
7030 (when (string-match tramp-postfix-ipv6-regexp host)
7031 (setq host (replace-match "" nil t host))))
7032 (if nodefault
7033 (vector method user host localname)
7034 (vector
7035 (tramp-find-method method user host)
7036 (tramp-find-user method user host)
7037 (tramp-find-host method user host)
7038 localname))))))
7039
7040 (defun tramp-equal-remote (file1 file2)
7041 "Checks, whether the remote parts of FILE1 and FILE2 are identical.
7042 The check depends on method, user and host name of the files. If
7043 one of the components is missing, the default values are used.
7044 The local file name parts of FILE1 and FILE2 are not taken into
7045 account.
7046
7047 Example:
7048
7049 (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
7050
7051 would yield `t'. On the other hand, the following check results in nil:
7052
7053 (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
7054 (and (stringp (file-remote-p file1))
7055 (stringp (file-remote-p file2))
7056 (string-equal (file-remote-p file1) (file-remote-p file2))))
7057
7058 (defun tramp-make-tramp-file-name (method user host localname)
7059 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
7060 (concat tramp-prefix-format
7061 (when (not (zerop (length method)))
7062 (concat method tramp-postfix-method-format))
7063 (when (not (zerop (length user)))
7064 (concat user tramp-postfix-user-format))
7065 (when host
7066 (if (string-match tramp-ipv6-regexp host)
7067 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
7068 host))
7069 tramp-postfix-host-format
7070 (when localname localname)))
7071
7072 (defun tramp-completion-make-tramp-file-name (method user host localname)
7073 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
7074 It must not be a complete Tramp file name, but as long as there are
7075 necessary only. This function will be used in file name completion."
7076 (concat tramp-prefix-format
7077 (when (not (zerop (length method)))
7078 (concat method tramp-postfix-method-format))
7079 (when (not (zerop (length user)))
7080 (concat user tramp-postfix-user-format))
7081 (when (not (zerop (length host)))
7082 (concat
7083 (if (string-match tramp-ipv6-regexp host)
7084 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
7085 host)
7086 tramp-postfix-host-format))
7087 (when localname localname)))
7088
7089 (defun tramp-make-copy-program-file-name (vec)
7090 "Create a file name suitable to be passed to `rcp' and workalikes."
7091 (let ((user (tramp-file-name-user vec))
7092 (host (tramp-file-name-real-host vec))
7093 (localname (tramp-shell-quote-argument
7094 (tramp-file-name-localname vec))))
7095 (if (not (zerop (length user)))
7096 (format "%s@%s:%s" user host localname)
7097 (format "%s:%s" host localname))))
7098
7099 (defun tramp-method-out-of-band-p (vec)
7100 "Return t if this is an out-of-band method, nil otherwise."
7101 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program))
7102
7103 (defun tramp-local-host-p (vec)
7104 "Return t if this points to the local host, nil otherwise."
7105 ;; We cannot use `tramp-file-name-real-host'. A port is an
7106 ;; indication for an ssh tunnel or alike.
7107 (let ((host (tramp-file-name-host vec)))
7108 (and
7109 (stringp host)
7110 (string-match tramp-local-host-regexp host)
7111 ;; The local temp directory must be writable for the other user.
7112 (file-writable-p
7113 (tramp-make-tramp-file-name
7114 (tramp-file-name-method vec)
7115 (tramp-file-name-user vec)
7116 host
7117 (tramp-compat-temporary-file-directory))))))
7118
7119 ;; Variables local to connection.
7120
7121 (defun tramp-get-remote-path (vec)
7122 (with-connection-property vec "remote-path"
7123 (let* ((remote-path (tramp-compat-copy-tree tramp-remote-path))
7124 (elt (memq 'tramp-default-remote-path remote-path))
7125 (default-remote-path
7126 (when elt
7127 (condition-case nil
7128 (symbol-name
7129 (tramp-send-command-and-read vec "getconf PATH"))
7130 ;; Default if "getconf" is not available.
7131 (error
7132 (tramp-message
7133 vec 3
7134 "`getconf PATH' not successful, using default value \"%s\"."
7135 "/bin:/usr/bin")
7136 "/bin:/usr/bin")))))
7137 (when elt
7138 ;; Replace place holder `tramp-default-remote-path'.
7139 (setcdr elt
7140 (append
7141 (tramp-split-string default-remote-path ":")
7142 (cdr elt)))
7143 (setq remote-path (delq 'tramp-default-remote-path remote-path)))
7144
7145 ;; Remove non-existing directories.
7146 (delq
7147 nil
7148 (mapcar
7149 (lambda (x)
7150 (and
7151 (with-connection-property vec x
7152 (file-directory-p
7153 (tramp-make-tramp-file-name
7154 (tramp-file-name-method vec)
7155 (tramp-file-name-user vec)
7156 (tramp-file-name-host vec)
7157 x)))
7158 x))
7159 remote-path)))))
7160
7161 (defun tramp-get-remote-tmpdir (vec)
7162 (with-connection-property vec "tmp-directory"
7163 (let ((dir (tramp-shell-quote-argument "/tmp")))
7164 (if (and (zerop
7165 (tramp-send-command-and-check
7166 vec (format "%s -d %s" (tramp-get-test-command vec) dir)))
7167 (zerop
7168 (tramp-send-command-and-check
7169 vec (format "%s -w %s" (tramp-get-test-command vec) dir))))
7170 dir
7171 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
7172
7173 (defun tramp-get-ls-command (vec)
7174 (with-connection-property vec "ls"
7175 (with-current-buffer (tramp-get-buffer vec)
7176 (tramp-message vec 5 "Finding a suitable `ls' command")
7177 (or
7178 (catch 'ls-found
7179 (dolist (cmd '("ls" "gnuls" "gls"))
7180 (let ((dl (tramp-get-remote-path vec))
7181 result)
7182 (while
7183 (and
7184 dl
7185 (setq result
7186 (tramp-find-executable vec cmd dl t t)))
7187 ;; Check parameter.
7188 (when (zerop (tramp-send-command-and-check
7189 vec (format "%s -lnd /" result)))
7190 (throw 'ls-found result))
7191 (setq dl (cdr dl))))))
7192 (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
7193
7194 (defun tramp-get-test-command (vec)
7195 (with-connection-property vec "test"
7196 (with-current-buffer (tramp-get-buffer vec)
7197 (tramp-message vec 5 "Finding a suitable `test' command")
7198 (if (zerop (tramp-send-command-and-check vec "test 0"))
7199 "test"
7200 (tramp-find-executable vec "test" (tramp-get-remote-path vec))))))
7201
7202 (defun tramp-get-test-nt-command (vec)
7203 ;; Does `test A -nt B' work? Use abominable `find' construct if it
7204 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
7205 ;; for otherwise the shell crashes.
7206 (with-connection-property vec "test-nt"
7207 (or
7208 (progn
7209 (tramp-send-command
7210 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
7211 (with-current-buffer (tramp-get-buffer vec)
7212 (goto-char (point-min))
7213 (when (looking-at (regexp-quote tramp-end-of-output))
7214 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
7215 (progn
7216 (tramp-send-command
7217 vec
7218 (format
7219 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
7220 (tramp-get-test-command vec)))
7221 "tramp_test_nt %s %s"))))
7222
7223 (defun tramp-get-file-exists-command (vec)
7224 (with-connection-property vec "file-exists"
7225 (with-current-buffer (tramp-get-buffer vec)
7226 (tramp-message vec 5 "Finding command to check if file exists")
7227 (tramp-find-file-exists-command vec))))
7228
7229 (defun tramp-get-remote-ln (vec)
7230 (with-connection-property vec "ln"
7231 (with-current-buffer (tramp-get-buffer vec)
7232 (tramp-message vec 5 "Finding a suitable `ln' command")
7233 (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))))
7234
7235 (defun tramp-get-remote-perl (vec)
7236 (with-connection-property vec "perl"
7237 (with-current-buffer (tramp-get-buffer vec)
7238 (tramp-message vec 5 "Finding a suitable `perl' command")
7239 (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
7240 (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))))
7241
7242 (defun tramp-get-remote-stat (vec)
7243 (with-connection-property vec "stat"
7244 (with-current-buffer (tramp-get-buffer vec)
7245 (tramp-message vec 5 "Finding a suitable `stat' command")
7246 (let ((result (tramp-find-executable
7247 vec "stat" (tramp-get-remote-path vec)))
7248 tmp)
7249 ;; Check whether stat(1) returns usable syntax. %s does not
7250 ;; work on older AIX systems.
7251 (when result
7252 (setq tmp
7253 ;; We don't want to display an error message.
7254 (with-temp-message (or (current-message) "")
7255 (condition-case nil
7256 (tramp-send-command-and-read
7257 vec (format "%s -c '(\"%%N\" %%s)' /" result))
7258 (error nil))))
7259 (unless (and (listp tmp) (stringp (car tmp))
7260 (string-match "^./.$" (car tmp))
7261 (integerp (cadr tmp)))
7262 (setq result nil)))
7263 result))))
7264
7265 (defun tramp-get-remote-id (vec)
7266 (with-connection-property vec "id"
7267 (with-current-buffer (tramp-get-buffer vec)
7268 (tramp-message vec 5 "Finding POSIX `id' command")
7269 (or
7270 (catch 'id-found
7271 (let ((dl (tramp-get-remote-path vec))
7272 result)
7273 (while
7274 (and
7275 dl
7276 (setq result
7277 (tramp-find-executable vec "id" dl t t)))
7278 ;; Check POSIX parameter.
7279 (when (zerop (tramp-send-command-and-check
7280 vec (format "%s -u" result)))
7281 (throw 'id-found result))
7282 (setq dl (cdr dl)))))
7283 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
7284
7285 (defun tramp-get-remote-uid (vec id-format)
7286 (with-connection-property vec (format "uid-%s" id-format)
7287 (let ((res (tramp-send-command-and-read
7288 vec
7289 (format "%s -u%s %s"
7290 (tramp-get-remote-id vec)
7291 (if (equal id-format 'integer) "" "n")
7292 (if (equal id-format 'integer)
7293 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
7294 ;; The command might not always return a number.
7295 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
7296
7297 (defun tramp-get-remote-gid (vec id-format)
7298 (with-connection-property vec (format "gid-%s" id-format)
7299 (let ((res (tramp-send-command-and-read
7300 vec
7301 (format "%s -g%s %s"
7302 (tramp-get-remote-id vec)
7303 (if (equal id-format 'integer) "" "n")
7304 (if (equal id-format 'integer)
7305 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
7306 ;; The command might not always return a number.
7307 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
7308
7309 (defun tramp-get-local-uid (id-format)
7310 (if (equal id-format 'integer) (user-uid) (user-login-name)))
7311
7312 (defun tramp-get-local-gid (id-format)
7313 (nth 3 (tramp-compat-file-attributes "~/" id-format)))
7314
7315 ;; Some predefined connection properties.
7316 (defun tramp-get-remote-coding (vec prop)
7317 ;; Local coding handles properties like remote coding. So we could
7318 ;; call it without pain.
7319 (let ((ret (tramp-get-local-coding vec prop)))
7320 ;; The connection property might have been cached. So we must send
7321 ;; the script - maybe.
7322 (when (and ret (symbolp ret))
7323 (let ((name (symbol-name ret)))
7324 (while (string-match (regexp-quote "-") name)
7325 (setq name (replace-match "_" nil t name)))
7326 (tramp-maybe-send-script vec (symbol-value ret) name)
7327 (setq ret name)))
7328 ;; Return the value.
7329 ret))
7330
7331 (defun tramp-get-local-coding (vec prop)
7332 (or
7333 (tramp-get-connection-property vec prop nil)
7334 (progn
7335 (tramp-find-inline-encoding vec)
7336 (tramp-get-connection-property vec prop nil))))
7337
7338 (defun tramp-get-method-parameter (method param)
7339 "Return the method parameter PARAM.
7340 If the `tramp-methods' entry does not exist, return NIL."
7341 (let ((entry (assoc param (assoc method tramp-methods))))
7342 (when entry (cadr entry))))
7343
7344 ;; Auto saving to a special directory.
7345
7346 (defun tramp-exists-file-name-handler (operation &rest args)
7347 "Checks whether OPERATION runs a file name handler."
7348 ;; The file name handler is determined on base of either an
7349 ;; argument, `buffer-file-name', or `default-directory'.
7350 (condition-case nil
7351 (let* ((buffer-file-name "/")
7352 (default-directory "/")
7353 (fnha file-name-handler-alist)
7354 (check-file-name-operation operation)
7355 (file-name-handler-alist
7356 (list
7357 (cons "/"
7358 '(lambda (operation &rest args)
7359 "Returns OPERATION if it is the one to be checked."
7360 (if (equal check-file-name-operation operation)
7361 operation
7362 (let ((file-name-handler-alist fnha))
7363 (apply operation args))))))))
7364 (equal (apply operation args) operation))
7365 (error nil)))
7366
7367 (unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
7368 (defadvice make-auto-save-file-name
7369 (around tramp-advice-make-auto-save-file-name () activate)
7370 "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files."
7371 (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
7372 (setq ad-return-value (tramp-handle-make-auto-save-file-name))
7373 ad-do-it))
7374 (add-hook 'tramp-unload-hook
7375 '(lambda () (ad-unadvise 'make-auto-save-file-name))))
7376
7377 ;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have
7378 ;; permission 0666 minus umask. This is a security threat.
7379
7380 (defun tramp-set-auto-save-file-modes ()
7381 "Set permissions of autosaved remote files to the original permissions."
7382 (let ((bfn (buffer-file-name)))
7383 (when (and (stringp bfn)
7384 (tramp-tramp-file-p bfn)
7385 (buffer-modified-p)
7386 (stringp buffer-auto-save-file-name)
7387 (not (equal bfn buffer-auto-save-file-name)))
7388 (unless (file-exists-p buffer-auto-save-file-name)
7389 (write-region "" nil buffer-auto-save-file-name))
7390 ;; Permissions should be set always, because there might be an old
7391 ;; auto-saved file belonging to another original file. This could
7392 ;; be a security threat.
7393 (set-file-modes buffer-auto-save-file-name
7394 (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
7395
7396 (unless (or (> emacs-major-version 21)
7397 (and (featurep 'xemacs)
7398 (= emacs-major-version 21)
7399 (> emacs-minor-version 4)))
7400 (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
7401 (add-hook 'tramp-unload-hook
7402 '(lambda ()
7403 (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
7404
7405 (defun tramp-subst-strs-in-string (alist string)
7406 "Replace all occurrences of the string FROM with TO in STRING.
7407 ALIST is of the form ((FROM . TO) ...)."
7408 (save-match-data
7409 (while alist
7410 (let* ((pr (car alist))
7411 (from (car pr))
7412 (to (cdr pr)))
7413 (while (string-match (regexp-quote from) string)
7414 (setq string (replace-match to t t string)))
7415 (setq alist (cdr alist))))
7416 string))
7417
7418 ;; ------------------------------------------------------------
7419 ;; -- Compatibility functions section --
7420 ;; ------------------------------------------------------------
7421
7422 (defun tramp-read-passwd (proc &optional prompt)
7423 "Read a password from user (compat function).
7424 Consults the auth-source package.
7425 Invokes `password-read' if available, `read-passwd' else."
7426 (let* ((key (tramp-make-tramp-file-name
7427 tramp-current-method tramp-current-user
7428 tramp-current-host ""))
7429 (pw-prompt
7430 (or prompt
7431 (with-current-buffer (process-buffer proc)
7432 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
7433 (format "%s for %s " (capitalize (match-string 1)) key)))))
7434 (prog1
7435 (or
7436 ;; See if auth-sources contains something useful, if it's bound.
7437 (and (boundp 'auth-sources)
7438 (tramp-get-connection-property proc "first-password-request" nil)
7439 ;; Try with Tramp's current method.
7440 (funcall (symbol-function 'auth-source-user-or-password)
7441 "password" tramp-current-host tramp-current-method))
7442 ;; Try the password cache.
7443 (when (functionp 'password-read)
7444 (unless (tramp-get-connection-property
7445 proc "first-password-request" nil)
7446 (funcall (symbol-function 'password-cache-remove) key))
7447 (let ((password
7448 (funcall (symbol-function 'password-read) pw-prompt key)))
7449 (funcall (symbol-function 'password-cache-add) key password)
7450 password))
7451 ;; Else, get the password interactively.
7452 (read-passwd pw-prompt))
7453 (tramp-set-connection-property proc "first-password-request" nil))))
7454
7455 (defun tramp-clear-passwd (vec)
7456 "Clear password cache for connection related to VEC."
7457 (when (functionp 'password-cache-remove)
7458 (funcall
7459 (symbol-function 'password-cache-remove)
7460 (tramp-make-tramp-file-name
7461 (tramp-file-name-method vec)
7462 (tramp-file-name-user vec)
7463 (tramp-file-name-host vec)
7464 ""))))
7465
7466 ;; Snarfed code from time-date.el and parse-time.el
7467
7468 (defconst tramp-half-a-year '(241 17024)
7469 "Evaluated by \"(days-to-time 183)\".")
7470
7471 (defconst tramp-parse-time-months
7472 '(("jan" . 1) ("feb" . 2) ("mar" . 3)
7473 ("apr" . 4) ("may" . 5) ("jun" . 6)
7474 ("jul" . 7) ("aug" . 8) ("sep" . 9)
7475 ("oct" . 10) ("nov" . 11) ("dec" . 12))
7476 "Alist mapping month names to integers.")
7477
7478 (defun tramp-time-less-p (t1 t2)
7479 "Say whether time value T1 is less than time value T2."
7480 (unless t1 (setq t1 '(0 0)))
7481 (unless t2 (setq t2 '(0 0)))
7482 (or (< (car t1) (car t2))
7483 (and (= (car t1) (car t2))
7484 (< (nth 1 t1) (nth 1 t2)))))
7485
7486 (defun tramp-time-subtract (t1 t2)
7487 "Subtract two time values.
7488 Return the difference in the format of a time value."
7489 (unless t1 (setq t1 '(0 0)))
7490 (unless t2 (setq t2 '(0 0)))
7491 (let ((borrow (< (cadr t1) (cadr t2))))
7492 (list (- (car t1) (car t2) (if borrow 1 0))
7493 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
7494
7495 (defun tramp-time-diff (t1 t2)
7496 "Return the difference between the two times, in seconds.
7497 T1 and T2 are time values (as returned by `current-time' for example)."
7498 ;; Pacify byte-compiler with `symbol-function'.
7499 (cond ((and (fboundp 'subtract-time)
7500 (fboundp 'float-time))
7501 (funcall (symbol-function 'float-time)
7502 (funcall (symbol-function 'subtract-time) t1 t2)))
7503 ((and (fboundp 'subtract-time)
7504 (fboundp 'time-to-seconds))
7505 (funcall (symbol-function 'time-to-seconds)
7506 (funcall (symbol-function 'subtract-time) t1 t2)))
7507 ((fboundp 'itimer-time-difference)
7508 (funcall (symbol-function 'itimer-time-difference)
7509 (if (< (length t1) 3) (append t1 '(0)) t1)
7510 (if (< (length t2) 3) (append t2 '(0)) t2)))
7511 (t
7512 (let ((time (tramp-time-subtract t1 t2)))
7513 (+ (* (car time) 65536.0)
7514 (cadr time)
7515 (/ (or (nth 2 time) 0) 1000000.0))))))
7516
7517 (defun tramp-coding-system-change-eol-conversion (coding-system eol-type)
7518 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
7519 EOL-TYPE can be one of `dos', `unix', or `mac'."
7520 (cond ((fboundp 'coding-system-change-eol-conversion)
7521 (funcall (symbol-function 'coding-system-change-eol-conversion)
7522 coding-system eol-type))
7523 ((fboundp 'subsidiary-coding-system)
7524 (funcall (symbol-function 'subsidiary-coding-system)
7525 coding-system
7526 (cond ((eq eol-type 'dos) 'crlf)
7527 ((eq eol-type 'unix) 'lf)
7528 ((eq eol-type 'mac) 'cr)
7529 (t
7530 (error "Unknown EOL-TYPE `%s', must be %s"
7531 eol-type
7532 "`dos', `unix', or `mac'")))))
7533 (t (error "Can't change EOL conversion -- is MULE missing?"))))
7534
7535 (defun tramp-split-string (string pattern)
7536 "Like `split-string' but omit empty strings.
7537 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
7538 This is, the first, empty, element is omitted. In XEmacs, the first
7539 element is not omitted.
7540
7541 Note: this function has been written for `tramp-handle-file-truename'.
7542 If you want to use it for something else, you'll have to check whether
7543 it does the right thing."
7544 (delete "" (split-string string pattern)))
7545
7546 (defun tramp-set-process-query-on-exit-flag (process flag)
7547 "Specify if query is needed for process when Emacs is exited.
7548 If the second argument flag is non-nil, Emacs will query the user before
7549 exiting if process is running."
7550 (if (fboundp 'set-process-query-on-exit-flag)
7551 (funcall (symbol-function 'set-process-query-on-exit-flag) process flag)
7552 (funcall (symbol-function 'process-kill-without-query) process flag)))
7553
7554
7555 ;; ------------------------------------------------------------
7556 ;; -- Kludges section --
7557 ;; ------------------------------------------------------------
7558
7559 ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
7560 ;; does not deal well with newline characters. Newline is replaced by
7561 ;; backslash newline. But if, say, the string `a backslash newline b'
7562 ;; is passed to a shell, the shell will expand this into "ab",
7563 ;; completely omitting the newline. This is not what was intended.
7564 ;; It does not appear to be possible to make the function
7565 ;; `shell-quote-argument' work with newlines without making it
7566 ;; dependent on the shell used. But within this package, we know that
7567 ;; we will always use a Bourne-like shell, so we use an approach which
7568 ;; groks newlines.
7569 ;;
7570 ;; The approach is simple: we call `shell-quote-argument', then
7571 ;; massage the newline part of the result.
7572 ;;
7573 ;; This function should produce a string which is grokked by a Unix
7574 ;; shell, even if the Emacs is running on Windows. Since this is the
7575 ;; kludges section, we bind `system-type' in such a way that
7576 ;; `shell-quote-arguments' behaves as if on Unix.
7577 ;;
7578 ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
7579 ;; function to work with Bourne-like shells.
7580 ;;
7581 ;; CCC: This function should be rewritten so that
7582 ;; `shell-quote-argument' is not used. This way, we are safe from
7583 ;; changes in `shell-quote-argument'.
7584 (defun tramp-shell-quote-argument (s)
7585 "Similar to `shell-quote-argument', but groks newlines.
7586 Only works for Bourne-like shells."
7587 (let ((system-type 'not-windows))
7588 (save-match-data
7589 (let ((result (shell-quote-argument s))
7590 (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
7591 (when (and (>= (length result) 2)
7592 (string= (substring result 0 2) "\\~"))
7593 (setq result (substring result 1)))
7594 (while (string-match nl result)
7595 (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
7596 t t result)))
7597 result))))
7598
7599 ;; We currently (sometimes) use "[" and "]" in the filename format.
7600 ;; This means that Emacs wants to expand wildcards if
7601 ;; `find-file-wildcards' is non-nil, and then barfs because no
7602 ;; expansion could be found. We detect this situation and do
7603 ;; something really awful: we have `file-expand-wildcards' return the
7604 ;; original filename if it can't expand anything. Let's just hope
7605 ;; that this doesn't break anything else.
7606 ;; CCC: This check is now also really awful; we should search all
7607 ;; of the filename format, not just the prefix.
7608 (when (string-match "\\[" tramp-prefix-format)
7609 (defadvice file-expand-wildcards
7610 (around tramp-advice-file-expand-wildcards activate)
7611 (let ((name (ad-get-arg 0)))
7612 (if (tramp-tramp-file-p name)
7613 ;; If it's a Tramp file, dissect it and look if wildcards
7614 ;; need to be expanded at all.
7615 (if (string-match
7616 "[[*?]"
7617 (tramp-file-name-localname (tramp-dissect-file-name name)))
7618 (setq ad-return-value (or ad-do-it (list name)))
7619 (setq ad-return-value (list name)))
7620 ;; If it is not a Tramp file, just run the original function.
7621 (setq ad-return-value (or ad-do-it (list name))))))
7622 (add-hook 'tramp-unload-hook
7623 '(lambda () (ad-unadvise 'file-expand-wildcards))))
7624
7625 ;; Checklist for `tramp-unload-hook'
7626 ;; - Unload all `tramp-*' packages
7627 ;; - Reset `file-name-handler-alist'
7628 ;; - Cleanup hooks where Tramp functions are in
7629 ;; - Cleanup advised functions
7630 ;; - Cleanup autoloads
7631 ;;;###autoload
7632 (defun tramp-unload-tramp ()
7633 "Discard Tramp from loading remote files."
7634 (interactive)
7635 ;; When Tramp is not loaded yet, its autoloads are still active.
7636 (tramp-unload-file-name-handlers)
7637 ;; ange-ftp settings must be enabled.
7638 (when (functionp 'tramp-ftp-enable-ange-ftp)
7639 (funcall (symbol-function 'tramp-ftp-enable-ange-ftp)))
7640 ;; Maybe its not loaded yet.
7641 (condition-case nil
7642 (unload-feature 'tramp 'force)
7643 (error nil)))
7644
7645 (when (and load-in-progress
7646 (string-match "Loading tramp..." (or (current-message) "")))
7647 (message "Loading tramp...done"))
7648
7649 (provide 'tramp)
7650
7651 ;;; TODO:
7652
7653 ;; * Allow putting passwords in the filename.
7654 ;; This should be implemented via a general mechanism to add
7655 ;; parameters in filenames. There is currently a kludge for
7656 ;; putting the port number into the filename for ssh and ftp
7657 ;; files. This could be subsumed by the new mechanism as well.
7658 ;; Another approach is to read a netrc file like ~/.authinfo
7659 ;; from Gnus.
7660 ;; * Handle nonlocal exits such as C-g.
7661 ;; * But it would probably be better to use with-local-quit at the
7662 ;; place where it's actually needed: around any potentially
7663 ;; indefinitely blocking piece of code. In this case it would be
7664 ;; within Tramp around one of its calls to accept-process-output (or
7665 ;; around one of the loops that calls accept-process-output)
7666 ;; (Stefan Monnier).
7667 ;; * Autodetect if remote `ls' groks the "--dired" switch.
7668 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
7669 ;; `shell-quote-argument'.
7670 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
7671 ;; by the files in that directory. Add this here.
7672 ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
7673 ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
7674 ;; * When logging in, keep looking for questions according to an alist
7675 ;; and then invoke the right function.
7676 ;; * Case-insensitive filename completion. (Norbert Goevert.)
7677 ;; * Don't use globbing for directories with many files, as this is
7678 ;; likely to produce long command lines, and some shells choke on
7679 ;; long command lines.
7680 ;; * `vc-directory' does not work. It never displays any files, even
7681 ;; if it does show files when run locally.
7682 ;; * How to deal with MULE in `insert-file-contents' and `write-region'?
7683 ;; * Grok `append' parameter for `write-region'.
7684 ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
7685 ;; * abbreviate-file-name
7686 ;; * better error checking. At least whenever we see something
7687 ;; strange when doing zerop, we should kill the process and start
7688 ;; again. (Greg Stark)
7689 ;; * Provide a local cache of old versions of remote files for the rsync
7690 ;; transfer method to use. (Greg Stark)
7691 ;; * Remove unneeded parameters from methods.
7692 ;; * Invoke rsync once for copying a whole directory hierarchy.
7693 ;; (Francesco Potortì)
7694 ;; * Make it work for different encodings, and for different file name
7695 ;; encodings, too. (Daniel Pittman)
7696 ;; * Progress reports while copying files. (Michael Kifer)
7697 ;; * Don't search for perl5 and perl. Instead, only search for perl and
7698 ;; then look if it's the right version (with `perl -v').
7699 ;; * When editing a remote CVS controlled file as a different user, VC
7700 ;; gets confused about the file locking status. Try to find out why
7701 ;; the workaround doesn't work.
7702 ;; * Username and hostname completion.
7703 ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
7704 ;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
7705 ;; Code is nearly identical.
7706 ;; * Allow out-of-band methods as _last_ multi-hop. Open a connection
7707 ;; until the last but one hop via `start-file-process'. Apply it
7708 ;; also for ftp and smb.
7709 ;; * WIBNI if we had a command "trampclient"? If I was editing in
7710 ;; some shell with root priviledges, it would be nice if I could
7711 ;; just call
7712 ;; trampclient filename.c
7713 ;; as an editor, and the _current_ shell would connect to an Emacs
7714 ;; server and would be used in an existing non-priviledged Emacs
7715 ;; session for doing the editing in question.
7716 ;; That way, I need not tell Emacs my password again and be afraid
7717 ;; that it makes it into core dumps or other ugly stuff (I had Emacs
7718 ;; once display a just typed password in the context of a keyboard
7719 ;; sequence prompt for a question immediately following in a shell
7720 ;; script run within Emacs -- nasty).
7721 ;; And if I have some ssh session running to a different computer,
7722 ;; having the possibility of passing a local file there to a local
7723 ;; Emacs session (in case I can arrange for a connection back) would
7724 ;; be nice.
7725 ;; Likely the corresponding Tramp server should not allow the
7726 ;; equivalent of the emacsclient -eval option in order to make this
7727 ;; reasonably unproblematic. And maybe trampclient should have some
7728 ;; way of passing credentials, like by using an SSL socket or
7729 ;; something. (David Kastrup)
7730 ;; * Could Tramp reasonably look for a prompt after ^M rather than
7731 ;; only after ^J ? (Stefan Monnier)
7732 ;; * Reconnect directly to a compliant shell without first going
7733 ;; through the user's default shell. (Pete Forman)
7734 ;; * Make `tramp-default-user' obsolete.
7735 ;; * Tramp shall reconnect automatically to its ssh connection when it
7736 ;; detects that the process "has died". (David Reitter)
7737 ;; * How can I interrupt the remote process with a signal
7738 ;; (interrupt-process seems not to work)? (Markus Triska)
7739 ;; * Avoid the local shell entirely for starting remote processes. If
7740 ;; so, I think even a signal, when delivered directly to the local
7741 ;; SSH instance, would correctly be propagated to the remote process
7742 ;; automatically; possibly SSH would have to be started with
7743 ;; "-t". (Markus Triska)
7744 ;; * Add gvfs support.
7745 ;; * Set `tramp-copy-size-limit' to 0, when there is no remote
7746 ;; encoding routine.
7747 ;; * It makes me wonder if tramp couldn't fall back to ssh when scp
7748 ;; isn't on the remote host. (Mark A. Hershberger)
7749
7750 ;; Functions for file-name-handler-alist:
7751 ;; diff-latest-backup-file -- in diff.el
7752 ;; dired-uncache -- this will be needed when we do insert-directory caching
7753 ;; file-name-sans-versions -- use primitive?
7754 ;; get-file-buffer -- use primitive
7755 ;; vc-registered
7756
7757 ;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
7758 ;;; tramp.el ends here
7759
7760 ;; Local Variables:
7761 ;; mode: Emacs-Lisp
7762 ;; coding: utf-8
7763 ;; End: