]> code.delx.au - gnu-emacs/blob - lisp/net/tramp.el
Add 2012 to FSF copyright years for Emacs files (do not merge to trunk)
[gnu-emacs] / lisp / net / tramp.el
1 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
2
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
5
6 ;; (copyright statements below in code to be updated with the above notice)
7
8 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
9 ;; Michael Albinus <michael.albinus@gmx.de>
10 ;; Keywords: comm, processes
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; This package provides remote file editing, similar to ange-ftp.
30 ;; The difference is that ange-ftp uses FTP to transfer files between
31 ;; the local and the remote host, whereas tramp.el uses a combination
32 ;; of rsh and rcp or other work-alike programs, such as ssh/scp.
33 ;;
34 ;; For more detailed instructions, please see the info file.
35 ;;
36 ;; Notes:
37 ;; -----
38 ;;
39 ;; This package only works for Emacs 22.1 and higher, and for XEmacs 21.4
40 ;; and higher. For XEmacs 21, you need the package `fsf-compat' for
41 ;; the `with-timeout' macro.
42 ;;
43 ;; Also see the todo list at the bottom of this file.
44 ;;
45 ;; The current version of Tramp can be retrieved from the following URL:
46 ;; http://ftp.gnu.org/gnu/tramp/
47 ;;
48 ;; There's a mailing list for this, as well. Its name is:
49 ;; tramp-devel@gnu.org
50 ;; You can use the Web to subscribe, under the following URL:
51 ;; http://lists.gnu.org/mailman/listinfo/tramp-devel
52 ;;
53 ;; For the adventurous, the current development sources are available
54 ;; via CVS. You can find instructions about this at the following URL:
55 ;; http://savannah.gnu.org/projects/tramp/
56 ;; Click on "CVS" in the navigation bar near the top.
57 ;;
58 ;; Don't forget to put on your asbestos longjohns, first!
59
60 ;;; Code:
61
62 ;; Since Emacs 23.1, loading messages have been disabled during
63 ;; autoload. However, loading Tramp takes a while, and it could
64 ;; happen while typing a filename in the minibuffer. Therefore, Tramp
65 ;; shall inform about.
66 (when (and load-in-progress (null (current-message)))
67 (message "Loading tramp..."))
68
69 ;; The Tramp version number and bug report address, as prepared by configure.
70 (require 'trampver)
71 (add-hook 'tramp-unload-hook
72 (lambda ()
73 (when (featurep 'trampver)
74 (unload-feature 'trampver 'force))))
75
76 (require 'tramp-compat)
77 (add-hook 'tramp-unload-hook
78 (lambda ()
79 (when (featurep 'tramp-compat)
80 (unload-feature 'tramp-compat 'force))))
81
82 (require 'format-spec)
83 ;; As long as password.el is not part of (X)Emacs, it shouldn't
84 ;; be mandatory
85 (if (featurep 'xemacs)
86 (load "password" 'noerror)
87 (or (require 'password-cache nil 'noerror)
88 (require 'password nil 'noerror))) ; from No Gnus, also in tar ball
89
90 (require 'shell)
91 (require 'advice)
92
93 (eval-and-compile
94 (if (featurep 'xemacs)
95 (load "auth-source" 'noerror)
96 (require 'auth-source nil 'noerror)))
97
98 ;; Requiring 'tramp-cache results in an endless loop.
99 (autoload 'tramp-get-file-property "tramp-cache")
100 (autoload 'tramp-set-file-property "tramp-cache")
101 (autoload 'tramp-flush-file-property "tramp-cache")
102 (autoload 'tramp-flush-directory-property "tramp-cache")
103 (autoload 'tramp-get-connection-property "tramp-cache")
104 (autoload 'tramp-set-connection-property "tramp-cache")
105 (autoload 'tramp-flush-connection-property "tramp-cache")
106 (autoload 'tramp-parse-connection-properties "tramp-cache")
107 (add-hook 'tramp-unload-hook
108 (lambda ()
109 (when (featurep 'tramp-cache)
110 (unload-feature 'tramp-cache 'force))))
111
112 (autoload 'tramp-uuencode-region "tramp-uu"
113 "Implementation of `uuencode' in Lisp.")
114 (add-hook 'tramp-unload-hook
115 (lambda ()
116 (when (featurep 'tramp-uu)
117 (unload-feature 'tramp-uu 'force))))
118
119 (autoload 'uudecode-decode-region "uudecode")
120
121 ;; The following Tramp packages must be loaded after tramp.el, because
122 ;; they require it as well.
123 (eval-after-load "tramp"
124 '(dolist
125 (feature
126 (list
127
128 ;; Tramp interactive commands.
129 'tramp-cmds
130
131 ;; Load foreign FTP method.
132 (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
133
134 ;; tramp-smb uses "smbclient" from Samba. Not available
135 ;; under Cygwin and Windows, because they don't offer
136 ;; "smbclient". And even not necessary there, because Emacs
137 ;; supports UNC file names like "//host/share/localname".
138 (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
139
140 ;; Load foreign FISH method.
141 'tramp-fish
142
143 ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
144 ;; on some system types. We don't call `dbus-ping', because
145 ;; this would load dbus.el.
146 (when (and (featurep 'dbusbind)
147 (condition-case nil
148 (tramp-compat-funcall 'dbus-get-unique-name :session)
149 (error nil))
150 (tramp-compat-process-running-p "gvfs-fuse-daemon"))
151 'tramp-gvfs)
152
153 ;; Load gateways. It needs `make-network-process' from Emacs 22.
154 (when (functionp 'make-network-process) 'tramp-gw)
155
156 ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
157 ;; (from Emacs 23.2).
158 (when (and (locate-library "epa") (locate-library "imap-hash"))
159 'tramp-imap)))
160
161 (when feature
162 ;; We have used just some basic tests, whether a package shall
163 ;; be added. There might still be other errors during loading,
164 ;; which we will catch here.
165 (catch 'tramp-loading
166 (require feature)
167 (add-hook 'tramp-unload-hook
168 `(lambda ()
169 (when (featurep (quote ,feature))
170 (unload-feature (quote ,feature) 'force)))))
171 (unless (featurep feature)
172 (message "Loading %s failed, ignoring this package" feature)))))
173
174 ;;; User Customizable Internal Variables:
175
176 (defgroup tramp nil
177 "Edit remote files with a combination of rsh and rcp or similar programs."
178 :group 'files
179 :group 'comm
180 :version "22.1")
181
182 ;; Maybe we need once a real Tramp mode, with key bindings etc.
183 ;;;###autoload
184 (defcustom tramp-mode t
185 "*Whether Tramp is enabled.
186 If it is set to nil, all remote file names are used literally."
187 :group 'tramp
188 :type 'boolean)
189
190 (defcustom tramp-verbose 3
191 "*Verbosity level for Tramp messages.
192 Any level x includes messages for all levels 1 .. x-1. The levels are
193
194 0 silent (no tramp messages at all)
195 1 errors
196 2 warnings
197 3 connection to remote hosts (default level)
198 4 activities
199 5 internal
200 6 sent and received strings
201 7 file caching
202 8 connection properties
203 9 test commands
204 10 traces (huge)."
205 :group 'tramp
206 :type 'integer)
207
208 ;; Emacs case.
209 (eval-and-compile
210 (when (boundp 'backup-directory-alist)
211 (defcustom tramp-backup-directory-alist nil
212 "Alist of filename patterns and backup directory names.
213 Each element looks like (REGEXP . DIRECTORY), with the same meaning like
214 in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
215 is a local file name, the backup directory is prepended with Tramp file
216 name prefix \(method, user, host\) of file.
217
218 \(setq tramp-backup-directory-alist backup-directory-alist\)
219
220 gives the same backup policy for Tramp files on their hosts like the
221 policy for local files."
222 :group 'tramp
223 :type '(repeat (cons (regexp :tag "Regexp matching filename")
224 (directory :tag "Backup directory name"))))))
225
226 ;; XEmacs case. We cannot check for `bkup-backup-directory-info', because
227 ;; the package "backup-dir" might not be loaded yet.
228 (eval-and-compile
229 (when (featurep 'xemacs)
230 (defcustom tramp-bkup-backup-directory-info nil
231 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
232 It has the same meaning like `bkup-backup-directory-info' from package
233 `backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
234 file name, the backup directory is prepended with Tramp file name prefix
235 \(method, user, host\) of file.
236
237 \(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
238
239 gives the same backup policy for Tramp files on their hosts like the
240 policy for local files."
241 :type '(repeat
242 (list (regexp :tag "File regexp")
243 (string :tag "Backup Dir")
244 (set :inline t
245 (const ok-create)
246 (const full-path)
247 (const prepend-name)
248 (const search-upward))))
249 :group 'tramp)))
250
251 (defcustom tramp-auto-save-directory nil
252 "*Put auto-save files in this directory, if set.
253 The idea is to use a local directory so that auto-saving is faster."
254 :group 'tramp
255 :type '(choice (const nil) string))
256
257 (defcustom tramp-encoding-shell
258 (if (memq system-type '(windows-nt))
259 (getenv "COMSPEC")
260 "/bin/sh")
261 "*Use this program for encoding and decoding commands on the local host.
262 This shell is used to execute the encoding and decoding command on the
263 local host, so if you want to use `~' in those commands, you should
264 choose a shell here which groks tilde expansion. `/bin/sh' normally
265 does not understand tilde expansion.
266
267 For encoding and deocding, commands like the following are executed:
268
269 /bin/sh -c COMMAND < INPUT > OUTPUT
270
271 This variable can be used to change the \"/bin/sh\" part. See the
272 variable `tramp-encoding-command-switch' for the \"-c\" part.
273
274 Note that this variable is not used for remote commands. There are
275 mechanisms in tramp.el which automatically determine the right shell to
276 use for the remote host."
277 :group 'tramp
278 :type '(file :must-match t))
279
280 (defcustom tramp-encoding-command-switch
281 (if (string-match "cmd\\.exe" tramp-encoding-shell)
282 "/c"
283 "-c")
284 "*Use this switch together with `tramp-encoding-shell' for local commands.
285 See the variable `tramp-encoding-shell' for more information."
286 :group 'tramp
287 :type 'string)
288
289 (defcustom tramp-inline-compress-start-size 4096
290 "*The minimum size of compressing where inline transfer.
291 When inline transfer, compress transfered data of file
292 whose size is this value or above (up to `tramp-copy-size-limit').
293 If it is nil, no compression at all will be applied."
294 :group 'tramp
295 :type '(choice (const nil) integer))
296
297 (defcustom tramp-copy-size-limit 10240
298 "*The maximum file size where inline copying is preferred over an out-of-the-band copy.
299 If it is nil, inline out-of-the-band copy will be used without a check."
300 :group 'tramp
301 :type '(choice (const nil) integer))
302
303 (defcustom tramp-terminal-type "dumb"
304 "*Value of TERM environment variable for logging in to remote host.
305 Because Tramp wants to parse the output of the remote shell, it is easily
306 confused by ANSI color escape sequences and suchlike. Often, shell init
307 files conditionalize this setup based on the TERM environment variable."
308 :group 'tramp
309 :type 'string)
310
311 ;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for
312 ;; root users. It uses the `$' character for other users. In order
313 ;; to guarantee a proper prompt, we use "#$" for the prompt.
314
315 (defvar tramp-end-of-output
316 (format
317 "///%s#$"
318 (md5 (concat (prin1-to-string process-environment) (current-time-string))))
319 "String used to recognize end of output.
320 The '$' character at the end is quoted; the string cannot be
321 detected as prompt when being sent on echoing hosts, therefore.")
322
323 (defconst tramp-initial-end-of-output "#$ "
324 "Prompt when establishing a connection.")
325
326 (defvar tramp-methods
327 `(("rcp" (tramp-login-program "rsh")
328 (tramp-login-args (("%h") ("-l" "%u")))
329 (tramp-remote-sh "/bin/sh")
330 (tramp-copy-program "rcp")
331 (tramp-copy-args (("-p" "%k") ("-r")))
332 (tramp-copy-keep-date t)
333 (tramp-copy-recursive t)
334 (tramp-password-end-of-line nil))
335 ("scp" (tramp-login-program "ssh")
336 (tramp-login-args (("-l" "%u") ("-p" "%p")
337 ("-e" "none") ("%h")))
338 (tramp-async-args (("-q")))
339 (tramp-remote-sh "/bin/sh")
340 (tramp-copy-program "scp")
341 (tramp-copy-args (("-P" "%p") ("-p" "%k")
342 ("-q") ("-r")))
343 (tramp-copy-keep-date t)
344 (tramp-copy-recursive t)
345 (tramp-password-end-of-line nil)
346 (tramp-gw-args (("-o"
347 "GlobalKnownHostsFile=/dev/null")
348 ("-o" "UserKnownHostsFile=/dev/null")
349 ("-o" "StrictHostKeyChecking=no")))
350 (tramp-default-port 22))
351 ("scp1" (tramp-login-program "ssh")
352 (tramp-login-args (("-l" "%u") ("-p" "%p")
353 ("-1") ("-e" "none") ("%h")))
354 (tramp-async-args (("-q")))
355 (tramp-remote-sh "/bin/sh")
356 (tramp-copy-program "scp")
357 (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
358 ("-q") ("-r")))
359 (tramp-copy-keep-date t)
360 (tramp-copy-recursive t)
361 (tramp-password-end-of-line nil)
362 (tramp-gw-args (("-o"
363 "GlobalKnownHostsFile=/dev/null")
364 ("-o" "UserKnownHostsFile=/dev/null")
365 ("-o" "StrictHostKeyChecking=no")))
366 (tramp-default-port 22))
367 ("scp2" (tramp-login-program "ssh")
368 (tramp-login-args (("-l" "%u") ("-p" "%p")
369 ("-2") ("-e" "none") ("%h")))
370 (tramp-async-args (("-q")))
371 (tramp-remote-sh "/bin/sh")
372 (tramp-copy-program "scp")
373 (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
374 ("-q") ("-r")))
375 (tramp-copy-keep-date t)
376 (tramp-copy-recursive t)
377 (tramp-password-end-of-line nil)
378 (tramp-gw-args (("-o"
379 "GlobalKnownHostsFile=/dev/null")
380 ("-o" "UserKnownHostsFile=/dev/null")
381 ("-o" "StrictHostKeyChecking=no")))
382 (tramp-default-port 22))
383 ("scp1_old"
384 (tramp-login-program "ssh1")
385 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
386 ("-e" "none")))
387 (tramp-remote-sh "/bin/sh")
388 (tramp-copy-program "scp1")
389 (tramp-copy-args (("-p" "%k") ("-r")))
390 (tramp-copy-keep-date t)
391 (tramp-copy-recursive t)
392 (tramp-password-end-of-line nil))
393 ("scp2_old"
394 (tramp-login-program "ssh2")
395 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
396 ("-e" "none")))
397 (tramp-remote-sh "/bin/sh")
398 (tramp-copy-program "scp2")
399 (tramp-copy-args (("-p" "%k") ("-r")))
400 (tramp-copy-keep-date t)
401 (tramp-copy-recursive t)
402 (tramp-password-end-of-line nil))
403 ("sftp" (tramp-login-program "ssh")
404 (tramp-login-args (("-l" "%u") ("-p" "%p")
405 ("-e" "none") ("%h")))
406 (tramp-async-args (("-q")))
407 (tramp-remote-sh "/bin/sh")
408 (tramp-copy-program "sftp")
409 (tramp-copy-args nil)
410 (tramp-copy-keep-date nil)
411 (tramp-password-end-of-line nil))
412 ("rsync" (tramp-login-program "ssh")
413 (tramp-login-args (("-l" "%u") ("-p" "%p")
414 ("-e" "none") ("%h")))
415 (tramp-async-args (("-q")))
416 (tramp-remote-sh "/bin/sh")
417 (tramp-copy-program "rsync")
418 (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
419 (tramp-copy-keep-date t)
420 (tramp-copy-keep-tmpfile t)
421 (tramp-copy-recursive t)
422 (tramp-password-end-of-line nil))
423 ("rsyncc"
424 (tramp-login-program "ssh")
425 (tramp-login-args (("-l" "%u") ("-p" "%p")
426 ("-o" "ControlPath=%t.%%r@%%h:%%p")
427 ("-o" "ControlMaster=yes")
428 ("-e" "none") ("%h")))
429 (tramp-async-args (("-q")))
430 (tramp-remote-sh "/bin/sh")
431 (tramp-copy-program "rsync")
432 (tramp-copy-args (("-t" "%k") ("-r")))
433 (tramp-copy-env (("RSYNC_RSH")
434 (,(concat
435 "ssh"
436 " -o ControlPath=%t.%%r@%%h:%%p"
437 " -o ControlMaster=auto"))))
438 (tramp-copy-keep-date t)
439 (tramp-copy-keep-tmpfile t)
440 (tramp-copy-recursive t)
441 (tramp-password-end-of-line nil))
442 ("remcp" (tramp-login-program "remsh")
443 (tramp-login-args (("%h") ("-l" "%u")))
444 (tramp-remote-sh "/bin/sh")
445 (tramp-copy-program "rcp")
446 (tramp-copy-args (("-p" "%k")))
447 (tramp-copy-keep-date t)
448 (tramp-password-end-of-line nil))
449 ("rsh" (tramp-login-program "rsh")
450 (tramp-login-args (("%h") ("-l" "%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 ("ssh" (tramp-login-program "ssh")
457 (tramp-login-args (("-l" "%u") ("-p" "%p")
458 ("-e" "none") ("%h")))
459 (tramp-async-args (("-q")))
460 (tramp-remote-sh "/bin/sh")
461 (tramp-copy-program nil)
462 (tramp-copy-args nil)
463 (tramp-copy-keep-date nil)
464 (tramp-password-end-of-line nil)
465 (tramp-gw-args (("-o"
466 "GlobalKnownHostsFile=/dev/null")
467 ("-o" "UserKnownHostsFile=/dev/null")
468 ("-o" "StrictHostKeyChecking=no")))
469 (tramp-default-port 22))
470 ("ssh1" (tramp-login-program "ssh")
471 (tramp-login-args (("-l" "%u") ("-p" "%p")
472 ("-1") ("-e" "none") ("%h")))
473 (tramp-async-args (("-q")))
474 (tramp-remote-sh "/bin/sh")
475 (tramp-copy-program nil)
476 (tramp-copy-args nil)
477 (tramp-copy-keep-date nil)
478 (tramp-password-end-of-line nil)
479 (tramp-gw-args (("-o"
480 "GlobalKnownHostsFile=/dev/null")
481 ("-o" "UserKnownHostsFile=/dev/null")
482 ("-o" "StrictHostKeyChecking=no")))
483 (tramp-default-port 22))
484 ("ssh2" (tramp-login-program "ssh")
485 (tramp-login-args (("-l" "%u") ("-p" "%p")
486 ("-2") ("-e" "none") ("%h")))
487 (tramp-async-args (("-q")))
488 (tramp-remote-sh "/bin/sh")
489 (tramp-copy-program nil)
490 (tramp-copy-args nil)
491 (tramp-copy-keep-date nil)
492 (tramp-password-end-of-line nil)
493 (tramp-gw-args (("-o"
494 "GlobalKnownHostsFile=/dev/null")
495 ("-o" "UserKnownHostsFile=/dev/null")
496 ("-o" "StrictHostKeyChecking=no")))
497 (tramp-default-port 22))
498 ("ssh1_old"
499 (tramp-login-program "ssh1")
500 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
501 ("-e" "none")))
502 (tramp-async-args (("-q")))
503 (tramp-remote-sh "/bin/sh")
504 (tramp-copy-program nil)
505 (tramp-copy-args nil)
506 (tramp-copy-keep-date nil)
507 (tramp-password-end-of-line nil))
508 ("ssh2_old"
509 (tramp-login-program "ssh2")
510 (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
511 ("-e" "none")))
512 (tramp-remote-sh "/bin/sh")
513 (tramp-copy-program nil)
514 (tramp-copy-args nil)
515 (tramp-copy-keep-date nil)
516 (tramp-password-end-of-line nil))
517 ("remsh" (tramp-login-program "remsh")
518 (tramp-login-args (("%h") ("-l" "%u")))
519 (tramp-remote-sh "/bin/sh")
520 (tramp-copy-program nil)
521 (tramp-copy-args nil)
522 (tramp-copy-keep-date nil)
523 (tramp-password-end-of-line nil))
524 ("telnet"
525 (tramp-login-program "telnet")
526 (tramp-login-args (("%h") ("%p")))
527 (tramp-remote-sh "/bin/sh")
528 (tramp-copy-program nil)
529 (tramp-copy-args nil)
530 (tramp-copy-keep-date nil)
531 (tramp-password-end-of-line nil)
532 (tramp-default-port 23))
533 ("su" (tramp-login-program "su")
534 (tramp-login-args (("-") ("%u")))
535 (tramp-remote-sh "/bin/sh")
536 (tramp-copy-program nil)
537 (tramp-copy-args nil)
538 (tramp-copy-keep-date nil)
539 (tramp-password-end-of-line nil))
540 ("sudo" (tramp-login-program "sudo")
541 (tramp-login-args (("-u" "%u")
542 ("-s") ("-H") ("-p" "Password:")))
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 ("scpc" (tramp-login-program "ssh")
549 (tramp-login-args (("-l" "%u") ("-p" "%p")
550 ("-o" "ControlPath=%t.%%r@%%h:%%p")
551 ("-o" "ControlMaster=yes")
552 ("-e" "none") ("%h")))
553 (tramp-async-args (("-q")))
554 (tramp-remote-sh "/bin/sh")
555 (tramp-copy-program "scp")
556 (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")
557 ("-o" "ControlPath=%t.%%r@%%h:%%p")
558 ("-o" "ControlMaster=auto")))
559 (tramp-copy-keep-date t)
560 (tramp-copy-recursive t)
561 (tramp-password-end-of-line nil)
562 (tramp-gw-args (("-o"
563 "GlobalKnownHostsFile=/dev/null")
564 ("-o" "UserKnownHostsFile=/dev/null")
565 ("-o" "StrictHostKeyChecking=no")))
566 (tramp-default-port 22))
567 ("scpx" (tramp-login-program "ssh")
568 (tramp-login-args (("-l" "%u") ("-p" "%p")
569 ("-e" "none") ("-t" "-t")
570 ("%h") ("/bin/sh")))
571 (tramp-async-args (("-q")))
572 (tramp-remote-sh "/bin/sh")
573 (tramp-copy-program "scp")
574 (tramp-copy-args (("-P" "%p") ("-p" "%k")
575 ("-q") ("-r")))
576 (tramp-copy-keep-date t)
577 (tramp-copy-recursive t)
578 (tramp-password-end-of-line nil)
579 (tramp-gw-args (("-o"
580 "GlobalKnownHostsFile=/dev/null")
581 ("-o" "UserKnownHostsFile=/dev/null")
582 ("-o" "StrictHostKeyChecking=no")))
583 (tramp-default-port 22))
584 ("sshx" (tramp-login-program "ssh")
585 (tramp-login-args (("-l" "%u") ("-p" "%p")
586 ("-e" "none") ("-t" "-t")
587 ("%h") ("/bin/sh")))
588 (tramp-async-args (("-q")))
589 (tramp-remote-sh "/bin/sh")
590 (tramp-copy-program nil)
591 (tramp-copy-args nil)
592 (tramp-copy-keep-date nil)
593 (tramp-password-end-of-line nil)
594 (tramp-gw-args (("-o"
595 "GlobalKnownHostsFile=/dev/null")
596 ("-o" "UserKnownHostsFile=/dev/null")
597 ("-o" "StrictHostKeyChecking=no")))
598 (tramp-default-port 22))
599 ("krlogin"
600 (tramp-login-program "krlogin")
601 (tramp-login-args (("%h") ("-l" "%u") ("-x")))
602 (tramp-remote-sh "/bin/sh")
603 (tramp-copy-program nil)
604 (tramp-copy-args nil)
605 (tramp-copy-keep-date nil)
606 (tramp-password-end-of-line nil))
607 ("plink" (tramp-login-program "plink")
608 (tramp-login-args (("-l" "%u") ("-P" "%p")
609 ("-ssh") ("%h")))
610 (tramp-remote-sh "/bin/sh")
611 (tramp-copy-program nil)
612 (tramp-copy-args nil)
613 (tramp-copy-keep-date nil)
614 (tramp-password-end-of-line "xy") ;see docstring for "xy"
615 (tramp-default-port 22))
616 ("plink1"
617 (tramp-login-program "plink")
618 (tramp-login-args (("-l" "%u") ("-P" "%p")
619 ("-1" "-ssh") ("%h")))
620 (tramp-remote-sh "/bin/sh")
621 (tramp-copy-program nil)
622 (tramp-copy-args nil)
623 (tramp-copy-keep-date nil)
624 (tramp-password-end-of-line "xy") ;see docstring for "xy"
625 (tramp-default-port 22))
626 ("plinkx"
627 (tramp-login-program "plink")
628 ;; ("%h") must be a single element, see
629 ;; `tramp-compute-multi-hops'.
630 (tramp-login-args (("-load") ("%h") ("-t")
631 (,(format
632 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
633 tramp-terminal-type
634 tramp-initial-end-of-output))
635 ("/bin/sh")))
636 (tramp-remote-sh "/bin/sh")
637 (tramp-copy-program nil)
638 (tramp-copy-args nil)
639 (tramp-copy-keep-date nil)
640 (tramp-password-end-of-line nil))
641 ("pscp" (tramp-login-program "plink")
642 (tramp-login-args (("-l" "%u") ("-P" "%p")
643 ("-ssh") ("%h")))
644 (tramp-remote-sh "/bin/sh")
645 (tramp-copy-program "pscp")
646 (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")
647 ("-r")))
648 (tramp-copy-keep-date t)
649 (tramp-copy-recursive t)
650 (tramp-password-end-of-line "xy") ;see docstring for "xy"
651 (tramp-default-port 22))
652 ("psftp" (tramp-login-program "plink")
653 (tramp-login-args (("-l" "%u") ("-P" "%p")
654 ("-ssh") ("%h")))
655 (tramp-remote-sh "/bin/sh")
656 (tramp-copy-program "pscp")
657 (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")
658 ("-r")))
659 (tramp-copy-keep-date t)
660 (tramp-copy-recursive t)
661 (tramp-password-end-of-line "xy")) ;see docstring for "xy"
662 ("fcp" (tramp-login-program "fsh")
663 (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
664 (tramp-remote-sh "/bin/sh -i")
665 (tramp-copy-program "fcp")
666 (tramp-copy-args (("-p" "%k")))
667 (tramp-copy-keep-date t)
668 (tramp-password-end-of-line nil)))
669 "*Alist of methods for remote files.
670 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
671 Each NAME stands for a remote access method. Each PARAM is a
672 pair of the form (KEY VALUE). The following KEYs are defined:
673 * `tramp-remote-sh'
674 This specifies the Bourne shell to use on the remote host. This
675 MUST be a Bourne-like shell. It is normally not necessary to set
676 this to any value other than \"/bin/sh\": Tramp wants to use a shell
677 which groks tilde expansion, but it can search for it. Also note
678 that \"/bin/sh\" exists on all Unixen, this might not be true for
679 the value that you decide to use. You Have Been Warned.
680 * `tramp-login-program'
681 This specifies the name of the program to use for logging in to the
682 remote host. This may be the name of rsh or a workalike program,
683 or the name of telnet or a workalike, or the name of su or a workalike.
684 * `tramp-login-args'
685 This specifies the list of arguments to pass to the above
686 mentioned program. Please note that this is a list of list of arguments,
687 that is, normally you don't want to put \"-a -b\" or \"-f foo\"
688 here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
689 There are some patterns: \"%h\" in this list is replaced by the host
690 name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
691 port number, and \"%%\" can be used to obtain a literal percent character.
692 If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
693 expansion (i.e. no host or no user specified), this list is not used as
694 argument. By this, arguments like (\"-l\" \"%u\") are optional.
695 \"%t\" is replaced by the temporary file name produced with
696 `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
697 parameter of a program, if exists.
698 * `tramp-async-args'
699 When an asynchronous process is started, we know already that
700 the connection works. Therefore, we can pass additional
701 parameters to suppress diagnostic messages, in order not to
702 tamper the process output.
703 * `tramp-copy-program'
704 This specifies the name of the program to use for remotely copying
705 the file; this might be the absolute filename of rcp or the name of
706 a workalike program.
707 * `tramp-copy-args'
708 This specifies the list of parameters to pass to the above mentioned
709 program, the hints for `tramp-login-args' also apply here.
710 * `tramp-copy-keep-date'
711 This specifies whether the copying program when the preserves the
712 timestamp of the original file.
713 * `tramp-copy-keep-tmpfile'
714 This specifies whether a temporary local file shall be kept
715 for optimization reasons (useful for \"rsync\" methods).
716 * `tramp-copy-recursive'
717 Whether the operation copies directories recursively.
718 * `tramp-default-port'
719 The default port of a method is needed in case of gateway connections.
720 Additionally, it is used as indication which method is prepared for
721 passing gateways.
722 * `tramp-gw-args'
723 As the attribute name says, additional arguments are specified here
724 when a method is applied via a gateway.
725 * `tramp-password-end-of-line'
726 This specifies the string to use for terminating the line after
727 submitting the password. If this method parameter is nil, then the
728 value of the normal variable `tramp-default-password-end-of-line'
729 is used. This parameter is necessary because the \"plink\" program
730 requires any two characters after sending the password. These do
731 not have to be newline or carriage return characters. Other login
732 programs are happy with just one character, the newline character.
733 We use \"xy\" as the value for methods using \"plink\".
734
735 What does all this mean? Well, you should specify `tramp-login-program'
736 for all methods; this program is used to log in to the remote site. Then,
737 there are two ways to actually transfer the files between the local and the
738 remote side. One way is using an additional rcp-like program. If you want
739 to do this, set `tramp-copy-program' in the method.
740
741 Another possibility for file transfer is inline transfer, i.e. the
742 file is passed through the same buffer used by `tramp-login-program'. In
743 this case, the file contents need to be protected since the
744 `tramp-login-program' might use escape codes or the connection might not
745 be eight-bit clean. Therefore, file contents are encoded for transit.
746 See the variables `tramp-local-coding-commands' and
747 `tramp-remote-coding-commands' for details.
748
749 So, to summarize: if the method is an out-of-band method, then you
750 must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
751 inline method, then these two parameters should be nil. Methods which
752 are fit for gateways must have `tramp-default-port' at least.
753
754 Notes:
755
756 When using `su' or `sudo' the phrase `open connection to a remote
757 host' sounds strange, but it is used nevertheless, for consistency.
758 No connection is opened to a remote host, but `su' or `sudo' is
759 started on the local host. You should specify a remote host
760 `localhost' or the name of the local host. Another host name is
761 useful only in combination with `tramp-default-proxies-alist'.")
762
763 (defun tramp-detect-ssh-controlmaster ()
764 "Call ssh to detect whether it supports the ControlMaster argument.
765 This function may return nil when the argument is supported, but
766 shouldn't return t when it isn't."
767 (ignore-errors
768 (with-temp-buffer
769 (call-process "ssh" nil t nil "-o" "ControlMaster")
770 (goto-char (point-min))
771 (search-forward-regexp "Missing ControlMaster argument" nil t))))
772
773 (defcustom tramp-default-method
774 ;; An external copy method seems to be preferred, because it is much
775 ;; more performant for large files, and it hasn't too serious delays
776 ;; for small files. But it must be ensured that there aren't
777 ;; permanent password queries. Either a password agent like
778 ;; "ssh-agent" or "Pageant" shall run, or the optional
779 ;; password-cache.el or auth-sources.el packages shall be active for
780 ;; password caching. "scpc" is chosen if we detect that the user is
781 ;; running OpenSSH 4.0 or newer.
782 (cond
783 ;; PuTTY is installed. We don't take it, if it is installed on a
784 ;; non-windows system, or pscp from the pssh (parallel ssh) package
785 ;; is found.
786 ((and (eq system-type 'windows-nt)
787 (executable-find "pscp"))
788 (if (or (fboundp 'password-read)
789 (fboundp 'auth-source-user-or-password)
790 ;; Pageant is running.
791 (tramp-compat-process-running-p "Pageant"))
792 "pscp"
793 "plink"))
794 ;; There is an ssh installation.
795 ((executable-find "scp")
796 (cond
797 ((tramp-detect-ssh-controlmaster) "scpc")
798 ((or (fboundp 'password-read)
799 (fboundp 'auth-source-user-or-password)
800 ;; ssh-agent is running.
801 (getenv "SSH_AUTH_SOCK")
802 (getenv "SSH_AGENT_PID"))
803 "scp")
804 (t "ssh")))
805 ;; Fallback.
806 (t "ftp"))
807 "*Default method to use for transferring files.
808 See `tramp-methods' for possibilities.
809 Also see `tramp-default-method-alist'."
810 :group 'tramp
811 :type 'string)
812
813 (defcustom tramp-default-method-alist
814 '(("\\`localhost\\'" "\\`root\\'" "su"))
815 "*Default method to use for specific host/user pairs.
816 This is an alist of items (HOST USER METHOD). The first matching item
817 specifies the method to use for a file name which does not specify a
818 method. HOST and USER are regular expressions or nil, which is
819 interpreted as a regular expression which always matches. If no entry
820 matches, the variable `tramp-default-method' takes effect.
821
822 If the file name does not specify the user, lookup is done using the
823 empty string for the user name.
824
825 See `tramp-methods' for a list of possibilities for METHOD."
826 :group 'tramp
827 :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
828 (choice :tag "User regexp" regexp sexp)
829 (choice :tag "Method name" string (const nil)))))
830
831 (defcustom tramp-default-user
832 nil
833 "*Default user to use for transferring files.
834 It is nil by default; otherwise settings in configuration files like
835 \"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
836
837 This variable is regarded as obsolete, and will be removed soon."
838 :group 'tramp
839 :type '(choice (const nil) string))
840
841 (defcustom tramp-default-user-alist
842 `(("\\`su\\(do\\)?\\'" nil "root")
843 ("\\`r\\(em\\)?\\(cp\\|sh\\)\\|telnet\\|plink1?\\'"
844 nil ,(user-login-name)))
845 "*Default user to use for specific method/host pairs.
846 This is an alist of items (METHOD HOST USER). The first matching item
847 specifies the user to use for a file name which does not specify a
848 user. METHOD and USER are regular expressions or nil, which is
849 interpreted as a regular expression which always matches. If no entry
850 matches, the variable `tramp-default-user' takes effect.
851
852 If the file name does not specify the method, lookup is done using the
853 empty string for the method name."
854 :group 'tramp
855 :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
856 (choice :tag " Host regexp" regexp sexp)
857 (choice :tag " User name" string (const nil)))))
858
859 (defcustom tramp-default-host
860 (system-name)
861 "*Default host to use for transferring files.
862 Useful for su and sudo methods mostly."
863 :group 'tramp
864 :type 'string)
865
866 (defcustom tramp-default-proxies-alist nil
867 "*Route to be followed for specific host/user pairs.
868 This is an alist of items (HOST USER PROXY). The first matching
869 item specifies the proxy to be passed for a file name located on
870 a remote target matching USER@HOST. HOST and USER are regular
871 expressions. PROXY must be a Tramp filename without a localname
872 part. Method and user name on PROXY are optional, which is
873 interpreted with the default values. PROXY can contain the
874 patterns %h and %u, which are replaced by the strings matching
875 HOST or USER, respectively.
876
877 HOST, USER or PROXY could also be Lisp forms, which will be
878 evaluated. The result must be a string or nil, which is
879 interpreted as a regular expression which always matches."
880 :group 'tramp
881 :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
882 (choice :tag "User regexp" regexp sexp)
883 (choice :tag " Proxy name" string (const nil)))))
884
885 (defconst tramp-local-host-regexp
886 (concat
887 "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$")
888 "*Host names which are regarded as local host.")
889
890 (defconst tramp-completion-function-alist-rsh
891 '((tramp-parse-rhosts "/etc/hosts.equiv")
892 (tramp-parse-rhosts "~/.rhosts"))
893 "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
894
895 (defconst tramp-completion-function-alist-ssh
896 '((tramp-parse-rhosts "/etc/hosts.equiv")
897 (tramp-parse-rhosts "/etc/shosts.equiv")
898 (tramp-parse-shosts "/etc/ssh_known_hosts")
899 (tramp-parse-sconfig "/etc/ssh_config")
900 (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
901 (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
902 (tramp-parse-rhosts "~/.rhosts")
903 (tramp-parse-rhosts "~/.shosts")
904 (tramp-parse-shosts "~/.ssh/known_hosts")
905 (tramp-parse-sconfig "~/.ssh/config")
906 (tramp-parse-shostkeys "~/.ssh2/hostkeys")
907 (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
908 "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
909
910 (defconst tramp-completion-function-alist-telnet
911 '((tramp-parse-hosts "/etc/hosts"))
912 "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
913
914 (defconst tramp-completion-function-alist-su
915 '((tramp-parse-passwd "/etc/passwd"))
916 "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
917
918 (defconst tramp-completion-function-alist-putty
919 '((tramp-parse-putty
920 "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"))
921 "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.")
922
923 (defvar tramp-completion-function-alist nil
924 "*Alist of methods for remote files.
925 This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
926 Each NAME stands for a remote access method. Each PAIR is of the form
927 \(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
928 names from FILE for completion. The following predefined FUNCTIONs exists:
929
930 * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
931 * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
932 * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
933 * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
934 * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
935 * `tramp-parse-hosts' for \"/etc/hosts\" like files,
936 * `tramp-parse-passwd' for \"/etc/passwd\" like files.
937 * `tramp-parse-netrc' for \"~/.netrc\" like files.
938 * `tramp-parse-putty' for PuTTY registry keys.
939
940 FUNCTION can also be a customer defined function. For more details see
941 the info pages.")
942
943 (eval-after-load "tramp"
944 '(progn
945 (tramp-set-completion-function
946 "rcp" tramp-completion-function-alist-rsh)
947 (tramp-set-completion-function
948 "scp" tramp-completion-function-alist-ssh)
949 (tramp-set-completion-function
950 "scp1" tramp-completion-function-alist-ssh)
951 (tramp-set-completion-function
952 "scp2" tramp-completion-function-alist-ssh)
953 (tramp-set-completion-function
954 "scp1_old" tramp-completion-function-alist-ssh)
955 (tramp-set-completion-function
956 "scp2_old" tramp-completion-function-alist-ssh)
957 (tramp-set-completion-function
958 "rsync" tramp-completion-function-alist-ssh)
959 (tramp-set-completion-function
960 "rsyncc" tramp-completion-function-alist-ssh)
961 (tramp-set-completion-function
962 "remcp" tramp-completion-function-alist-rsh)
963 (tramp-set-completion-function
964 "rsh" tramp-completion-function-alist-rsh)
965 (tramp-set-completion-function
966 "ssh" tramp-completion-function-alist-ssh)
967 (tramp-set-completion-function
968 "ssh1" tramp-completion-function-alist-ssh)
969 (tramp-set-completion-function
970 "ssh2" tramp-completion-function-alist-ssh)
971 (tramp-set-completion-function
972 "ssh1_old" tramp-completion-function-alist-ssh)
973 (tramp-set-completion-function
974 "ssh2_old" tramp-completion-function-alist-ssh)
975 (tramp-set-completion-function
976 "remsh" tramp-completion-function-alist-rsh)
977 (tramp-set-completion-function
978 "telnet" tramp-completion-function-alist-telnet)
979 (tramp-set-completion-function
980 "su" tramp-completion-function-alist-su)
981 (tramp-set-completion-function
982 "sudo" tramp-completion-function-alist-su)
983 (tramp-set-completion-function
984 "scpx" tramp-completion-function-alist-ssh)
985 (tramp-set-completion-function
986 "sshx" tramp-completion-function-alist-ssh)
987 (tramp-set-completion-function
988 "krlogin" tramp-completion-function-alist-rsh)
989 (tramp-set-completion-function
990 "plink" tramp-completion-function-alist-ssh)
991 (tramp-set-completion-function
992 "plink1" tramp-completion-function-alist-ssh)
993 (tramp-set-completion-function
994 "plinkx" tramp-completion-function-alist-putty)
995 (tramp-set-completion-function
996 "pscp" tramp-completion-function-alist-ssh)
997 (tramp-set-completion-function
998 "fcp" tramp-completion-function-alist-ssh)))
999
1000 (defconst tramp-echo-mark-marker "_echo"
1001 "String marker to surround echoed commands.")
1002
1003 (defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
1004 "String length of `tramp-echo-mark-marker'.")
1005
1006 (defconst tramp-echo-mark
1007 (concat tramp-echo-mark-marker
1008 (make-string tramp-echo-mark-marker-length ?\b))
1009 "String mark to be transmitted around shell commands.
1010 Used to separate their echo from the output they produce. This
1011 will only be used if we cannot disable remote echo via stty.
1012 This string must have no effect on the remote shell except for
1013 producing some echo which can later be detected by
1014 `tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
1015 followed by an equal number of backspaces to erase them will
1016 usually suffice.")
1017
1018 (defconst tramp-echoed-echo-mark-regexp
1019 (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
1020 tramp-echo-mark-marker tramp-echo-mark-marker-length)
1021 "Regexp which matches `tramp-echo-mark' as it gets echoed by
1022 the remote shell.")
1023
1024 (defcustom tramp-rsh-end-of-line "\n"
1025 "*String used for end of line in rsh connections.
1026 I don't think this ever needs to be changed, so please tell me about it
1027 if you need to change this.
1028 Also see the method parameter `tramp-password-end-of-line' and the normal
1029 variable `tramp-default-password-end-of-line'."
1030 :group 'tramp
1031 :type 'string)
1032
1033 (defcustom tramp-default-password-end-of-line
1034 tramp-rsh-end-of-line
1035 "*String used for end of line after sending a password.
1036 This variable provides the default value for the method parameter
1037 `tramp-password-end-of-line', see `tramp-methods' for more details.
1038
1039 It seems that people using plink under Windows need to send
1040 \"\\r\\n\" (carriage-return, then newline) after a password, but just
1041 \"\\n\" after all other lines. This variable can be used for the
1042 password, see `tramp-rsh-end-of-line' for the other cases.
1043
1044 The default value is to use the same value as `tramp-rsh-end-of-line'."
1045 :group 'tramp
1046 :type 'string)
1047
1048 ;; "getconf PATH" yields:
1049 ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
1050 ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
1051 ;; GNU/Linux (Debian, Suse): /bin:/usr/bin
1052 ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
1053 ;; IRIX64: /usr/bin
1054 (defcustom tramp-remote-path
1055 '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
1056 "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
1057 "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
1058 "*List of directories to search for executables on remote host.
1059 For every remote host, this variable will be set buffer local,
1060 keeping the list of existing directories on that host.
1061
1062 You can use `~' in this list, but when searching for a shell which groks
1063 tilde expansion, all directory names starting with `~' will be ignored.
1064
1065 `Default Directories' represent the list of directories given by
1066 the command \"getconf PATH\". It is recommended to use this
1067 entry on top of this list, because these are the default
1068 directories for POSIX compatible commands.
1069
1070 `Private Directories' are the settings of the $PATH environment,
1071 as given in your `~/.profile'."
1072 :group 'tramp
1073 :type '(repeat (choice
1074 (const :tag "Default Directories" tramp-default-remote-path)
1075 (const :tag "Private Directories" tramp-own-remote-path)
1076 (string :tag "Directory"))))
1077
1078 (defcustom tramp-remote-process-environment
1079 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
1080 ,(format "TERM=%s" tramp-terminal-type)
1081 "EMACS=t" ;; Deprecated.
1082 ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
1083 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
1084 "autocorrect=" "correct=")
1085
1086 "*List of environment variables to be set on the remote host.
1087
1088 Each element should be a string of the form ENVVARNAME=VALUE. An
1089 entry ENVVARNAME= diables the corresponding environment variable,
1090 which might have been set in the init files like ~/.profile.
1091
1092 Special handling is applied to the PATH environment, which should
1093 not be set here. Instead of, it should be set via `tramp-remote-path'."
1094 :group 'tramp
1095 :type '(repeat string))
1096
1097 (defcustom tramp-login-prompt-regexp
1098 ".*ogin\\( .*\\)?: *"
1099 "*Regexp matching login-like prompts.
1100 The regexp should match at end of buffer.
1101
1102 Sometimes the prompt is reported to look like \"login as:\"."
1103 :group 'tramp
1104 :type 'regexp)
1105
1106 (defcustom tramp-shell-prompt-pattern
1107 ;; Allow a prompt to start right after a ^M since it indeed would be
1108 ;; displayed at the beginning of the line (and Zsh uses it). This
1109 ;; regexp works only for GNU Emacs.
1110 (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
1111 "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
1112 "Regexp to match prompts from remote shell.
1113 Normally, Tramp expects you to configure `shell-prompt-pattern'
1114 correctly, but sometimes it happens that you are connecting to a
1115 remote host which sends a different kind of shell prompt. Therefore,
1116 Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
1117 and also things matched by this variable. The default value of this
1118 variable is similar to the default value of `shell-prompt-pattern',
1119 which should work well in many cases.
1120
1121 This regexp must match both `tramp-initial-end-of-output' and
1122 `tramp-end-of-output'."
1123 :group 'tramp
1124 :type 'regexp)
1125
1126 (defcustom tramp-password-prompt-regexp
1127 "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
1128 "*Regexp matching password-like prompts.
1129 The regexp should match at end of buffer.
1130
1131 The `sudo' program appears to insert a `^@' character into the prompt."
1132 :group 'tramp
1133 :type 'regexp)
1134
1135 (defcustom tramp-wrong-passwd-regexp
1136 (concat "^.*"
1137 ;; These strings should be on the last line
1138 (regexp-opt '("Permission denied"
1139 "Login incorrect"
1140 "Login Incorrect"
1141 "Connection refused"
1142 "Connection closed"
1143 "Timeout, server not responding."
1144 "Sorry, try again."
1145 "Name or service not known"
1146 "Host key verification failed."
1147 "No supported authentication methods left to try!") t)
1148 ".*"
1149 "\\|"
1150 "^.*\\("
1151 ;; Here comes a list of regexes, separated by \\|
1152 "Received signal [0-9]+"
1153 "\\).*")
1154 "*Regexp matching a `login failed' message.
1155 The regexp should match at end of buffer."
1156 :group 'tramp
1157 :type 'regexp)
1158
1159 (defcustom tramp-yesno-prompt-regexp
1160 (concat
1161 (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
1162 "\\s-*")
1163 "Regular expression matching all yes/no queries which need to be confirmed.
1164 The confirmation should be done with yes or no.
1165 The regexp should match at end of buffer.
1166 See also `tramp-yn-prompt-regexp'."
1167 :group 'tramp
1168 :type 'regexp)
1169
1170 (defcustom tramp-yn-prompt-regexp
1171 (concat
1172 (regexp-opt '("Store key in cache? (y/n)"
1173 "Update cached key? (y/n, Return cancels connection)") t)
1174 "\\s-*")
1175 "Regular expression matching all y/n queries which need to be confirmed.
1176 The confirmation should be done with y or n.
1177 The regexp should match at end of buffer.
1178 See also `tramp-yesno-prompt-regexp'."
1179 :group 'tramp
1180 :type 'regexp)
1181
1182 (defcustom tramp-terminal-prompt-regexp
1183 (concat "\\("
1184 "TERM = (.*)"
1185 "\\|"
1186 "Terminal type\\? \\[.*\\]"
1187 "\\)\\s-*")
1188 "Regular expression matching all terminal setting prompts.
1189 The regexp should match at end of buffer.
1190 The answer will be provided by `tramp-action-terminal', which see."
1191 :group 'tramp
1192 :type 'regexp)
1193
1194 (defcustom tramp-operation-not-permitted-regexp
1195 (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
1196 (regexp-opt '("Operation not permitted") t))
1197 "Regular expression matching keep-date problems in (s)cp operations.
1198 Copying has been performed successfully already, so this message can
1199 be ignored safely."
1200 :group 'tramp
1201 :type 'regexp)
1202
1203 (defcustom tramp-copy-failed-regexp
1204 (concat "\\(.+: "
1205 (regexp-opt '("Permission denied"
1206 "not a regular file"
1207 "is a directory"
1208 "No such file or directory") t)
1209 "\\)\\s-*")
1210 "Regular expression matching copy problems in (s)cp operations."
1211 :group 'tramp
1212 :type 'regexp)
1213
1214 (defcustom tramp-process-alive-regexp
1215 ""
1216 "Regular expression indicating a process has finished.
1217 In fact this expression is empty by intention, it will be used only to
1218 check regularly the status of the associated process.
1219 The answer will be provided by `tramp-action-process-alive',
1220 `tramp-action-out-of-band', which see."
1221 :group 'tramp
1222 :type 'regexp)
1223
1224 (defcustom tramp-temp-name-prefix "tramp."
1225 "*Prefix to use for temporary files.
1226 If this is a relative file name (such as \"tramp.\"), it is considered
1227 relative to the directory name returned by the function
1228 `tramp-compat-temporary-file-directory' (which see). It may also be an
1229 absolute file name; don't forget to include a prefix for the filename
1230 part, though."
1231 :group 'tramp
1232 :type 'string)
1233
1234 (defconst tramp-temp-buffer-name " *tramp temp*"
1235 "Buffer name for a temporary buffer.
1236 It shall be used in combination with `generate-new-buffer-name'.")
1237
1238 (defvar tramp-temp-buffer-file-name nil
1239 "File name of a persistent local temporary file.
1240 Useful for \"rsync\" like methods.")
1241 (make-variable-buffer-local 'tramp-temp-buffer-file-name)
1242
1243 (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
1244 "*Alist specifying extra arguments to pass to the remote shell.
1245 Entries are (REGEXP . ARGS) where REGEXP is a regular expression
1246 matching the shell file name and ARGS is a string specifying the
1247 arguments.
1248
1249 This variable is only used when Tramp needs to start up another shell
1250 for tilde expansion. The extra arguments should typically prevent the
1251 shell from reading its init file."
1252 :group 'tramp
1253 ;; This might be the wrong way to test whether the widget type
1254 ;; `alist' is available. Who knows the right way to test it?
1255 :type (if (get 'alist 'widget-type)
1256 '(alist :key-type string :value-type string)
1257 '(repeat (cons string string))))
1258
1259 ;; XEmacs is distributed with few Lisp packages. Further packages are
1260 ;; installed using EFS. If we use a unified filename format, then
1261 ;; Tramp is required in addition to EFS. (But why can't Tramp just
1262 ;; disable EFS when Tramp is loaded? Then XEmacs can ship with EFS
1263 ;; just like before.) Another reason for using a separate filename
1264 ;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
1265 ;; Tramp only knows how to deal with `file-name-handler-alist', not
1266 ;; the other places.
1267
1268 ;; Currently, we have the choice between 'ftp, 'sep, and 'url.
1269 ;;;###autoload
1270 (defcustom tramp-syntax
1271 (if (featurep 'xemacs) 'sep 'ftp)
1272 "Tramp filename syntax to be used.
1273
1274 It can have the following values:
1275
1276 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
1277 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
1278 'url -- URL-like syntax."
1279 :group 'tramp
1280 :type (if (featurep 'xemacs)
1281 '(choice (const :tag "EFS" ftp)
1282 (const :tag "XEmacs" sep)
1283 (const :tag "URL" url))
1284 '(choice (const :tag "Ange-FTP" ftp)
1285 (const :tag "URL" url))))
1286
1287 (defconst tramp-prefix-format
1288 (cond ((equal tramp-syntax 'ftp) "/")
1289 ((equal tramp-syntax 'sep) "/[")
1290 ((equal tramp-syntax 'url) "/")
1291 (t (error "Wrong `tramp-syntax' defined")))
1292 "*String matching the very beginning of Tramp file names.
1293 Used in `tramp-make-tramp-file-name'.")
1294
1295 (defconst tramp-prefix-regexp
1296 (concat "^" (regexp-quote tramp-prefix-format))
1297 "*Regexp matching the very beginning of Tramp file names.
1298 Should always start with \"^\". Derived from `tramp-prefix-format'.")
1299
1300 (defconst tramp-method-regexp
1301 "[a-zA-Z_0-9-]+"
1302 "*Regexp matching methods identifiers.")
1303
1304 (defconst tramp-postfix-method-format
1305 (cond ((equal tramp-syntax 'ftp) ":")
1306 ((equal tramp-syntax 'sep) "/")
1307 ((equal tramp-syntax 'url) "://")
1308 (t (error "Wrong `tramp-syntax' defined")))
1309 "*String matching delimeter between method and user or host names.
1310 Used in `tramp-make-tramp-file-name'.")
1311
1312 (defconst tramp-postfix-method-regexp
1313 (regexp-quote tramp-postfix-method-format)
1314 "*Regexp matching delimeter between method and user or host names.
1315 Derived from `tramp-postfix-method-format'.")
1316
1317 (defconst tramp-user-regexp
1318 "[^:/ \t]+"
1319 "*Regexp matching user names.")
1320
1321 (defconst tramp-prefix-domain-format "%"
1322 "*String matching delimeter between user and domain names.")
1323
1324 (defconst tramp-prefix-domain-regexp
1325 (regexp-quote tramp-prefix-domain-format)
1326 "*Regexp matching delimeter between user and domain names.
1327 Derived from `tramp-prefix-domain-format'.")
1328
1329 (defconst tramp-domain-regexp
1330 "[-a-zA-Z0-9_.]+"
1331 "*Regexp matching domain names.")
1332
1333 (defconst tramp-user-with-domain-regexp
1334 (concat "\\(" tramp-user-regexp "\\)"
1335 tramp-prefix-domain-regexp
1336 "\\(" tramp-domain-regexp "\\)")
1337 "*Regexp matching user names with domain names.")
1338
1339 (defconst tramp-postfix-user-format
1340 "@"
1341 "*String matching delimeter between user and host names.
1342 Used in `tramp-make-tramp-file-name'.")
1343
1344 (defconst tramp-postfix-user-regexp
1345 (regexp-quote tramp-postfix-user-format)
1346 "*Regexp matching delimeter between user and host names.
1347 Derived from `tramp-postfix-user-format'.")
1348
1349 (defconst tramp-host-regexp
1350 "[a-zA-Z0-9_.-]+"
1351 "*Regexp matching host names.")
1352
1353 (defconst tramp-prefix-ipv6-format
1354 (cond ((equal tramp-syntax 'ftp) "[")
1355 ((equal tramp-syntax 'sep) "")
1356 ((equal tramp-syntax 'url) "[")
1357 (t (error "Wrong `tramp-syntax' defined")))
1358 "*String matching left hand side of IPv6 addresses.
1359 Used in `tramp-make-tramp-file-name'.")
1360
1361 (defconst tramp-prefix-ipv6-regexp
1362 (regexp-quote tramp-prefix-ipv6-format)
1363 "*Regexp matching left hand side of IPv6 addresses.
1364 Derived from `tramp-prefix-ipv6-format'.")
1365
1366 ;; The following regexp is a bit sloppy. But it shall serve our
1367 ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
1368 ;; "::ffff:192.168.0.1".
1369 (defconst tramp-ipv6-regexp
1370 "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
1371 "*Regexp matching IPv6 addresses.")
1372
1373 (defconst tramp-postfix-ipv6-format
1374 (cond ((equal tramp-syntax 'ftp) "]")
1375 ((equal tramp-syntax 'sep) "")
1376 ((equal tramp-syntax 'url) "]")
1377 (t (error "Wrong `tramp-syntax' defined")))
1378 "*String matching right hand side of IPv6 addresses.
1379 Used in `tramp-make-tramp-file-name'.")
1380
1381 (defconst tramp-postfix-ipv6-regexp
1382 (regexp-quote tramp-postfix-ipv6-format)
1383 "*Regexp matching right hand side of IPv6 addresses.
1384 Derived from `tramp-postfix-ipv6-format'.")
1385
1386 (defconst tramp-prefix-port-format
1387 (cond ((equal tramp-syntax 'ftp) "#")
1388 ((equal tramp-syntax 'sep) "#")
1389 ((equal tramp-syntax 'url) ":")
1390 (t (error "Wrong `tramp-syntax' defined")))
1391 "*String matching delimeter between host names and port numbers.")
1392
1393 (defconst tramp-prefix-port-regexp
1394 (regexp-quote tramp-prefix-port-format)
1395 "*Regexp matching delimeter between host names and port numbers.
1396 Derived from `tramp-prefix-port-format'.")
1397
1398 (defconst tramp-port-regexp
1399 "[0-9]+"
1400 "*Regexp matching port numbers.")
1401
1402 (defconst tramp-host-with-port-regexp
1403 (concat "\\(" tramp-host-regexp "\\)"
1404 tramp-prefix-port-regexp
1405 "\\(" tramp-port-regexp "\\)")
1406 "*Regexp matching host names with port numbers.")
1407
1408 (defconst tramp-postfix-host-format
1409 (cond ((equal tramp-syntax 'ftp) ":")
1410 ((equal tramp-syntax 'sep) "]")
1411 ((equal tramp-syntax 'url) "")
1412 (t (error "Wrong `tramp-syntax' defined")))
1413 "*String matching delimeter between host names and localnames.
1414 Used in `tramp-make-tramp-file-name'.")
1415
1416 (defconst tramp-postfix-host-regexp
1417 (regexp-quote tramp-postfix-host-format)
1418 "*Regexp matching delimeter between host names and localnames.
1419 Derived from `tramp-postfix-host-format'.")
1420
1421 (defconst tramp-localname-regexp
1422 ".*$"
1423 "*Regexp matching localnames.")
1424
1425 ;; File name format.
1426
1427 (defconst tramp-file-name-structure
1428 (list
1429 (concat
1430 tramp-prefix-regexp
1431 "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
1432 "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
1433 "\\(" "\\(" tramp-host-regexp
1434 "\\|"
1435 tramp-prefix-ipv6-regexp tramp-ipv6-regexp
1436 tramp-postfix-ipv6-regexp "\\)"
1437 "\\(" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"
1438 tramp-postfix-host-regexp
1439 "\\(" tramp-localname-regexp "\\)")
1440 2 4 5 8)
1441
1442 "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
1443 the Tramp file name structure.
1444
1445 The first element REGEXP is a regular expression matching a Tramp file
1446 name. The regex should contain parentheses around the method name,
1447 the user name, the host name, and the file name parts.
1448
1449 The second element METHOD is a number, saying which pair of
1450 parentheses matches the method name. The third element USER is
1451 similar, but for the user name. The fourth element HOST is similar,
1452 but for the host name. The fifth element FILE is for the file name.
1453 These numbers are passed directly to `match-string', which see. That
1454 means the opening parentheses are counted to identify the pair.
1455
1456 See also `tramp-file-name-regexp'.")
1457
1458 ;;;###autoload
1459 (defconst tramp-file-name-regexp-unified
1460 (if (memq system-type '(cygwin windows-nt))
1461 "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
1462 "\\`/\\([^[/:]+\\|[^/]+]\\):")
1463 "Value for `tramp-file-name-regexp' for unified remoting.
1464 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
1465 Tramp. See `tramp-file-name-structure' for more explanations.
1466
1467 On W32 systems, the volume letter must be ignored.")
1468
1469 ;;;###autoload
1470 (defconst tramp-file-name-regexp-separate
1471 "\\`/\\[.*\\]"
1472 "Value for `tramp-file-name-regexp' for separate remoting.
1473 XEmacs uses a separate filename syntax for Tramp and EFS.
1474 See `tramp-file-name-structure' for more explanations.")
1475
1476 ;;;###autoload
1477 (defconst tramp-file-name-regexp-url
1478 "\\`/[^/:]+://"
1479 "Value for `tramp-file-name-regexp' for URL-like remoting.
1480 See `tramp-file-name-structure' for more explanations.")
1481
1482 ;;;###autoload
1483 (defconst tramp-file-name-regexp
1484 (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
1485 ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
1486 ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
1487 (t (error "Wrong `tramp-syntax' defined")))
1488 "*Regular expression matching file names handled by Tramp.
1489 This regexp should match Tramp file names but no other file names.
1490 When tramp.el is loaded, this regular expression is prepended to
1491 `file-name-handler-alist', and that is searched sequentially. Thus,
1492 if the Tramp entry appears rather early in the `file-name-handler-alist'
1493 and is a bit too general, then some files might be considered Tramp
1494 files which are not really Tramp files.
1495
1496 Please note that the entry in `file-name-handler-alist' is made when
1497 this file \(tramp.el\) is loaded. This means that this variable must be set
1498 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1499 updated after changing this variable.
1500
1501 Also see `tramp-file-name-structure'.")
1502
1503 ;;;###autoload
1504 (defconst tramp-root-regexp
1505 (if (memq system-type '(cygwin windows-nt))
1506 "\\`\\([a-zA-Z]:\\)?/"
1507 "\\`/")
1508 "Beginning of an incomplete Tramp file name.
1509 Usually, it is just \"\\\\`/\". On W32 systems, there might be a
1510 volume letter, which will be removed by `tramp-drop-volume-letter'.")
1511
1512 ;;;###autoload
1513 (defconst tramp-completion-file-name-regexp-unified
1514 (if (memq system-type '(cygwin windows-nt))
1515 (concat tramp-root-regexp "[^/]\\{2,\\}\\'")
1516 (concat tramp-root-regexp "[^/]*\\'"))
1517 "Value for `tramp-completion-file-name-regexp' for unified remoting.
1518 GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
1519 See `tramp-file-name-structure' for more explanations.
1520
1521 On W32 systems, the volume letter must be ignored.")
1522
1523 ;;;###autoload
1524 (defconst tramp-completion-file-name-regexp-separate
1525 (concat tramp-root-regexp "\\([[][^]]*\\)?\\'")
1526 "Value for `tramp-completion-file-name-regexp' for separate remoting.
1527 XEmacs uses a separate filename syntax for Tramp and EFS.
1528 See `tramp-file-name-structure' for more explanations.")
1529
1530 ;;;###autoload
1531 (defconst tramp-completion-file-name-regexp-url
1532 (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'")
1533 "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
1534 See `tramp-file-name-structure' for more explanations.")
1535
1536 ;;;###autoload
1537 (defconst tramp-completion-file-name-regexp
1538 (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
1539 ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
1540 ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
1541 (t (error "Wrong `tramp-syntax' defined")))
1542 "*Regular expression matching file names handled by Tramp completion.
1543 This regexp should match partial Tramp file names only.
1544
1545 Please note that the entry in `file-name-handler-alist' is made when
1546 this file (tramp.el) is loaded. This means that this variable must be set
1547 before loading tramp.el. Alternatively, `file-name-handler-alist' can be
1548 updated after changing this variable.
1549
1550 Also see `tramp-file-name-structure'.")
1551
1552 (defconst tramp-actions-before-shell
1553 '((tramp-login-prompt-regexp tramp-action-login)
1554 (tramp-password-prompt-regexp tramp-action-password)
1555 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1556 (shell-prompt-pattern tramp-action-succeed)
1557 (tramp-shell-prompt-pattern tramp-action-succeed)
1558 (tramp-yesno-prompt-regexp tramp-action-yesno)
1559 (tramp-yn-prompt-regexp tramp-action-yn)
1560 (tramp-terminal-prompt-regexp tramp-action-terminal)
1561 (tramp-process-alive-regexp tramp-action-process-alive))
1562 "List of pattern/action pairs.
1563 Whenever a pattern matches, the corresponding action is performed.
1564 Each item looks like (PATTERN ACTION).
1565
1566 The PATTERN should be a symbol, a variable. The value of this
1567 variable gives the regular expression to search for. Note that the
1568 regexp must match at the end of the buffer, \"\\'\" is implicitly
1569 appended to it.
1570
1571 The ACTION should also be a symbol, but a function. When the
1572 corresponding PATTERN matches, the ACTION function is called.")
1573
1574 (defconst tramp-actions-copy-out-of-band
1575 '((tramp-password-prompt-regexp tramp-action-password)
1576 (tramp-wrong-passwd-regexp tramp-action-permission-denied)
1577 (tramp-copy-failed-regexp tramp-action-permission-denied)
1578 (tramp-process-alive-regexp tramp-action-out-of-band))
1579 "List of pattern/action pairs.
1580 This list is used for copying/renaming with out-of-band methods.
1581
1582 See `tramp-actions-before-shell' for more info.")
1583
1584 ;; Chunked sending kludge. We set this to 500 for black-listed constellations
1585 ;; known to have a bug in `process-send-string'; some ssh connections appear
1586 ;; to drop bytes when data is sent too quickly. There is also a connection
1587 ;; buffer local variable, which is computed depending on remote host properties
1588 ;; when `tramp-chunksize' is zero or nil.
1589 (defcustom tramp-chunksize
1590 (when (and (not (featurep 'xemacs))
1591 (memq system-type '(hpux)))
1592 500)
1593 ;; Parentheses in docstring starting at beginning of line are escaped.
1594 ;; Fontification is messed up when
1595 ;; `open-paren-in-column-0-is-defun-start' set to t.
1596 "*If non-nil, chunksize for sending input to local process.
1597 It is necessary only on systems which have a buggy `process-send-string'
1598 implementation. The necessity, whether this variable must be set, can be
1599 checked via the following code:
1600
1601 (with-temp-buffer
1602 (let* ((user \"xxx\") (host \"yyy\")
1603 (init 0) (step 50)
1604 (sent init) (received init))
1605 (while (= sent received)
1606 (setq sent (+ sent step))
1607 (erase-buffer)
1608 (let ((proc (start-process (buffer-name) (current-buffer)
1609 \"ssh\" \"-l\" user host \"wc\" \"-c\")))
1610 (when (memq (process-status proc) '(run open))
1611 (process-send-string proc (make-string sent ?\\ ))
1612 (process-send-eof proc)
1613 (process-send-eof proc))
1614 (while (not (progn (goto-char (point-min))
1615 (re-search-forward \"\\\\w+\" (point-max) t)))
1616 (accept-process-output proc 1))
1617 (when (memq (process-status proc) '(run open))
1618 (setq received (string-to-number (match-string 0)))
1619 (delete-process proc)
1620 (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
1621 (sit-for 0))))
1622 (if (> sent (+ init step))
1623 (message \"You should set `tramp-chunksize' to a maximum of %s\"
1624 (- sent step))
1625 (message \"Test does not work\")
1626 (display-buffer (current-buffer))
1627 (sit-for 30))))
1628
1629 In the Emacs normally running Tramp, evaluate the above code
1630 \(replace \"xxx\" and \"yyy\" by the remote user and host name,
1631 respectively\). You can do this, for example, by pasting it into
1632 the `*scratch*' buffer and then hitting C-j with the cursor after the
1633 last closing parenthesis. Note that it works only if you have configured
1634 \"ssh\" to run without password query, see ssh-agent\(1\).
1635
1636 You will see the number of bytes sent successfully to the remote host.
1637 If that number exceeds 1000, you can stop the execution by hitting
1638 C-g, because your Emacs is likely clean.
1639
1640 When it is necessary to set `tramp-chunksize', you might consider to
1641 use an out-of-the-band method \(like \"scp\"\) instead of an internal one
1642 \(like \"ssh\"\), because setting `tramp-chunksize' to non-nil decreases
1643 performance.
1644
1645 If your Emacs is buggy, the code stops and gives you an indication
1646 about the value `tramp-chunksize' should be set. Maybe you could just
1647 experiment a bit, e.g. changing the values of `init' and `step'
1648 in the third line of the code.
1649
1650 Please raise a bug report via \"M-x tramp-bug\" if your system needs
1651 this variable to be set as well."
1652 :group 'tramp
1653 :type '(choice (const nil) integer))
1654
1655 ;; Logging in to a remote host normally requires obtaining a pty. But
1656 ;; Emacs on MacOS X has process-connection-type set to nil by default,
1657 ;; so on those systems Tramp doesn't obtain a pty. Here, we allow
1658 ;; for an override of the system default.
1659 (defcustom tramp-process-connection-type t
1660 "Overrides `process-connection-type' for connections from Tramp.
1661 Tramp binds process-connection-type to the value given here before
1662 opening a connection to a remote host."
1663 :group 'tramp
1664 :type '(choice (const nil) (const t) (const pty)))
1665
1666 (defcustom tramp-completion-reread-directory-timeout 10
1667 "Defines seconds since last remote command before rereading a directory.
1668 A remote directory might have changed its contents. In order to
1669 make it visible during file name completion in the minibuffer,
1670 Tramp flushes its cache and rereads the directory contents when
1671 more than `tramp-completion-reread-directory-timeout' seconds
1672 have been gone since last remote command execution. A value of 0
1673 would require an immediate reread during filename completion, nil
1674 means to use always cached values for the directory contents."
1675 :group 'tramp
1676 :type '(choice (const nil) integer))
1677
1678 ;;; Internal Variables:
1679
1680 (defvar tramp-current-method nil
1681 "Connection method for this *tramp* buffer.")
1682
1683 (defvar tramp-current-user nil
1684 "Remote login name for this *tramp* buffer.")
1685
1686 (defvar tramp-current-host nil
1687 "Remote host for this *tramp* buffer.")
1688
1689 (defconst tramp-uudecode
1690 "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
1691 cat /tmp/tramp.$$
1692 rm -f /tmp/tramp.$$"
1693 "Shell function to implement `uudecode' to standard output.
1694 Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
1695 for this or `uudecode -p', but some systems don't, and for them
1696 we have this shell function.")
1697
1698 (defconst tramp-perl-file-truename
1699 "%s -e '
1700 use File::Spec;
1701 use Cwd \"realpath\";
1702
1703 sub recursive {
1704 my ($volume, @dirs) = @_;
1705 my $real = realpath(File::Spec->catpath(
1706 $volume, File::Spec->catdir(@dirs), \"\"));
1707 if ($real) {
1708 my ($vol, $dir) = File::Spec->splitpath($real, 1);
1709 return ($vol, File::Spec->splitdir($dir));
1710 }
1711 else {
1712 my $last = pop(@dirs);
1713 ($volume, @dirs) = recursive($volume, @dirs);
1714 push(@dirs, $last);
1715 return ($volume, @dirs);
1716 }
1717 }
1718
1719 $result = realpath($ARGV[0]);
1720 if (!$result) {
1721 my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
1722 ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
1723
1724 $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
1725 }
1726
1727 if ($ARGV[0] =~ /\\/$/) {
1728 $result = $result . \"/\";
1729 }
1730
1731 print \"\\\"$result\\\"\\n\";
1732 ' \"$1\" 2>/dev/null"
1733 "Perl script to produce output suitable for use with `file-truename'
1734 on the remote file system.
1735 Escape sequence %s is replaced with name of Perl binary.
1736 This string is passed to `format', so percent characters need to be doubled.")
1737
1738 (defconst tramp-perl-file-name-all-completions
1739 "%s -e 'sub case {
1740 my $str = shift;
1741 if ($ARGV[2]) {
1742 return lc($str);
1743 }
1744 else {
1745 return $str;
1746 }
1747 }
1748 opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
1749 @files = readdir(d); closedir(d);
1750 foreach $f (@files) {
1751 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
1752 if (-d \"$ARGV[0]/$f\") {
1753 print \"$f/\\n\";
1754 }
1755 else {
1756 print \"$f\\n\";
1757 }
1758 }
1759 }
1760 print \"ok\\n\"
1761 ' \"$1\" \"$2\" \"$3\" 2>/dev/null"
1762 "Perl script to produce output suitable for use with
1763 `file-name-all-completions' on the remote file system. Escape
1764 sequence %s is replaced with name of Perl binary. This string is
1765 passed to `format', so percent characters need to be doubled.")
1766
1767 ;; Perl script to implement `file-attributes' in a Lisp `read'able
1768 ;; output. If you are hacking on this, note that you get *no* output
1769 ;; unless this spits out a complete line, including the '\n' at the
1770 ;; end.
1771 ;; The device number is returned as "-1", because there will be a virtual
1772 ;; device number set in `tramp-handle-file-attributes'.
1773 (defconst tramp-perl-file-attributes
1774 "%s -e '
1775 @stat = lstat($ARGV[0]);
1776 if (!@stat) {
1777 print \"nil\\n\";
1778 exit 0;
1779 }
1780 if (($stat[2] & 0170000) == 0120000)
1781 {
1782 $type = readlink($ARGV[0]);
1783 $type = \"\\\"$type\\\"\";
1784 }
1785 elsif (($stat[2] & 0170000) == 040000)
1786 {
1787 $type = \"t\";
1788 }
1789 else
1790 {
1791 $type = \"nil\"
1792 };
1793 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1794 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1795 printf(
1796 \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\",
1797 $type,
1798 $stat[3],
1799 $uid,
1800 $gid,
1801 $stat[8] >> 16 & 0xffff,
1802 $stat[8] & 0xffff,
1803 $stat[9] >> 16 & 0xffff,
1804 $stat[9] & 0xffff,
1805 $stat[10] >> 16 & 0xffff,
1806 $stat[10] & 0xffff,
1807 $stat[7],
1808 $stat[2],
1809 $stat[1] >> 16 & 0xffff,
1810 $stat[1] & 0xffff
1811 );' \"$1\" \"$2\" 2>/dev/null"
1812 "Perl script to produce output suitable for use with `file-attributes'
1813 on the remote file system.
1814 Escape sequence %s is replaced with name of Perl binary.
1815 This string is passed to `format', so percent characters need to be doubled.")
1816
1817 (defconst tramp-perl-directory-files-and-attributes
1818 "%s -e '
1819 chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
1820 opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
1821 @list = readdir(DIR);
1822 closedir(DIR);
1823 $n = scalar(@list);
1824 printf(\"(\\n\");
1825 for($i = 0; $i < $n; $i++)
1826 {
1827 $filename = $list[$i];
1828 @stat = lstat($filename);
1829 if (($stat[2] & 0170000) == 0120000)
1830 {
1831 $type = readlink($filename);
1832 $type = \"\\\"$type\\\"\";
1833 }
1834 elsif (($stat[2] & 0170000) == 040000)
1835 {
1836 $type = \"t\";
1837 }
1838 else
1839 {
1840 $type = \"nil\"
1841 };
1842 $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
1843 $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
1844 printf(
1845 \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
1846 $filename,
1847 $type,
1848 $stat[3],
1849 $uid,
1850 $gid,
1851 $stat[8] >> 16 & 0xffff,
1852 $stat[8] & 0xffff,
1853 $stat[9] >> 16 & 0xffff,
1854 $stat[9] & 0xffff,
1855 $stat[10] >> 16 & 0xffff,
1856 $stat[10] & 0xffff,
1857 $stat[7],
1858 $stat[2],
1859 $stat[1] >> 16 & 0xffff,
1860 $stat[1] & 0xffff,
1861 $stat[0] >> 16 & 0xffff,
1862 $stat[0] & 0xffff);
1863 }
1864 printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
1865 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1866 output.
1867 Escape sequence %s is replaced with name of Perl binary.
1868 This string is passed to `format', so percent characters need to be doubled.")
1869
1870 ;; ;; These two use uu encoding.
1871 ;; (defvar tramp-perl-encode "%s -e'\
1872 ;; print qq(begin 644 xxx\n);
1873 ;; my $s = q();
1874 ;; my $res = q();
1875 ;; while (read(STDIN, $s, 45)) {
1876 ;; print pack(q(u), $s);
1877 ;; }
1878 ;; print qq(`\n);
1879 ;; print qq(end\n);
1880 ;; '"
1881 ;; "Perl program to use for encoding a file.
1882 ;; Escape sequence %s is replaced with name of Perl binary.")
1883
1884 ;; (defvar tramp-perl-decode "%s -ne '
1885 ;; print unpack q(u), $_;
1886 ;; '"
1887 ;; "Perl program to use for decoding a file.
1888 ;; Escape sequence %s is replaced with name of Perl binary.")
1889
1890 ;; These two use base64 encoding.
1891 (defconst tramp-perl-encode-with-module
1892 "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
1893 "Perl program to use for encoding a file.
1894 Escape sequence %s is replaced with name of Perl binary.
1895 This string is passed to `format', so percent characters need to be doubled.
1896 This implementation requires the MIME::Base64 Perl module to be installed
1897 on the remote host.")
1898
1899 (defconst tramp-perl-decode-with-module
1900 "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
1901 "Perl program to use for decoding a file.
1902 Escape sequence %s is replaced with name of Perl binary.
1903 This string is passed to `format', so percent characters need to be doubled.
1904 This implementation requires the MIME::Base64 Perl module to be installed
1905 on the remote host.")
1906
1907 (defconst tramp-perl-encode
1908 "%s -e '
1909 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1910 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
1911 # 2011, 2012 Free Software Foundation, Inc.
1912 use strict;
1913
1914 my %%trans = do {
1915 my $i = 0;
1916 map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
1917 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
1918 };
1919
1920 binmode(\\*STDIN);
1921
1922 # We read in chunks of 54 bytes, to generate output lines
1923 # of 72 chars (plus end of line)
1924 $/ = \\54;
1925
1926 while (my $data = <STDIN>) {
1927 my $pad = q();
1928
1929 # Only for the last chunk, and only if did not fill the last three-byte packet
1930 if (eof) {
1931 my $mod = length($data) %% 3;
1932 $pad = q(=) x (3 - $mod) if $mod;
1933 }
1934
1935 # Not the fastest method, but it is simple: unpack to binary string, split
1936 # by groups of 6 bits and convert back from binary to byte; then map into
1937 # the translation table
1938 print
1939 join q(),
1940 map($trans{$_},
1941 (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
1942 $pad,
1943 qq(\\n);
1944 }' 2>/dev/null"
1945 "Perl program to use for encoding a file.
1946 Escape sequence %s is replaced with name of Perl binary.
1947 This string is passed to `format', so percent characters need to be doubled.")
1948
1949 (defconst tramp-perl-decode
1950 "%s -e '
1951 # This script contributed by Juanma Barranquero <lektu@terra.es>.
1952 # Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
1953 # 2011, 2012 Free Software Foundation, Inc.
1954 use strict;
1955
1956 my %%trans = do {
1957 my $i = 0;
1958 map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
1959 split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
1960 };
1961
1962 my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
1963
1964 binmode(\\*STDOUT);
1965
1966 # We are going to accumulate into $pending to accept any line length
1967 # (we do not check they are <= 76 chars as the RFC says)
1968 my $pending = q();
1969
1970 while (my $data = <STDIN>) {
1971 chomp $data;
1972
1973 # If we find one or two =, we have reached the end and
1974 # any following data is to be discarded
1975 my $finished = $data =~ s/(==?).*/$1/;
1976 $pending .= $data;
1977
1978 my $len = length($pending);
1979 my $chunk = substr($pending, 0, $len & ~3);
1980 $pending = substr($pending, $len & ~3 + 1);
1981
1982 # Easy method: translate from chars to (pregenerated) six-bit packets, join,
1983 # split in 8-bit chunks and convert back to char.
1984 print join q(),
1985 map $bytes{$_},
1986 ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
1987
1988 last if $finished;
1989 }' 2>/dev/null"
1990 "Perl program to use for decoding a file.
1991 Escape sequence %s is replaced with name of Perl binary.
1992 This string is passed to `format', so percent characters need to be doubled.")
1993
1994 (defconst tramp-vc-registered-read-file-names
1995 "echo \"(\"
1996 while read file; do
1997 if %s \"$file\"; then
1998 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
1999 else
2000 echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
2001 fi
2002 if %s \"$file\"; then
2003 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
2004 else
2005 echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
2006 fi
2007 done
2008 echo \")\""
2009 "Script to check existence of VC related files.
2010 It must be send formatted with two strings; the tests for file
2011 existence, and file readability. Input shall be read via
2012 here-document, otherwise the command could exceed maximum length
2013 of command line.")
2014
2015 (defconst tramp-file-mode-type-map
2016 '((0 . "-") ; Normal file (SVID-v2 and XPG2)
2017 (1 . "p") ; fifo
2018 (2 . "c") ; character device
2019 (3 . "m") ; multiplexed character device (v7)
2020 (4 . "d") ; directory
2021 (5 . "?") ; Named special file (XENIX)
2022 (6 . "b") ; block device
2023 (7 . "?") ; multiplexed block device (v7)
2024 (8 . "-") ; regular file
2025 (9 . "n") ; network special file (HP-UX)
2026 (10 . "l") ; symlink
2027 (11 . "?") ; ACL shadow inode (Solaris, not userspace)
2028 (12 . "s") ; socket
2029 (13 . "D") ; door special (Solaris)
2030 (14 . "w")) ; whiteout (BSD)
2031 "A list of file types returned from the `stat' system call.
2032 This is used to map a mode number to a permission string.")
2033
2034 ;; New handlers should be added here. The following operations can be
2035 ;; handled using the normal primitives: file-name-sans-versions,
2036 ;; get-file-buffer.
2037 (defconst tramp-file-name-handler-alist
2038 '((load . tramp-handle-load)
2039 (make-symbolic-link . tramp-handle-make-symbolic-link)
2040 (file-name-as-directory . tramp-handle-file-name-as-directory)
2041 (file-name-directory . tramp-handle-file-name-directory)
2042 (file-name-nondirectory . tramp-handle-file-name-nondirectory)
2043 (file-truename . tramp-handle-file-truename)
2044 (file-exists-p . tramp-handle-file-exists-p)
2045 (file-directory-p . tramp-handle-file-directory-p)
2046 (file-executable-p . tramp-handle-file-executable-p)
2047 (file-readable-p . tramp-handle-file-readable-p)
2048 (file-regular-p . tramp-handle-file-regular-p)
2049 (file-symlink-p . tramp-handle-file-symlink-p)
2050 (file-writable-p . tramp-handle-file-writable-p)
2051 (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
2052 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
2053 (file-attributes . tramp-handle-file-attributes)
2054 (file-modes . tramp-handle-file-modes)
2055 (directory-files . tramp-handle-directory-files)
2056 (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
2057 (file-name-all-completions . tramp-handle-file-name-all-completions)
2058 (file-name-completion . tramp-handle-file-name-completion)
2059 (add-name-to-file . tramp-handle-add-name-to-file)
2060 (copy-file . tramp-handle-copy-file)
2061 (copy-directory . tramp-handle-copy-directory)
2062 (rename-file . tramp-handle-rename-file)
2063 (set-file-modes . tramp-handle-set-file-modes)
2064 (set-file-times . tramp-handle-set-file-times)
2065 (make-directory . tramp-handle-make-directory)
2066 (delete-directory . tramp-handle-delete-directory)
2067 (delete-file . tramp-handle-delete-file)
2068 (directory-file-name . tramp-handle-directory-file-name)
2069 ;; `executable-find' is not official yet.
2070 (executable-find . tramp-handle-executable-find)
2071 (start-file-process . tramp-handle-start-file-process)
2072 (process-file . tramp-handle-process-file)
2073 (shell-command . tramp-handle-shell-command)
2074 (insert-directory . tramp-handle-insert-directory)
2075 (expand-file-name . tramp-handle-expand-file-name)
2076 (substitute-in-file-name . tramp-handle-substitute-in-file-name)
2077 (file-local-copy . tramp-handle-file-local-copy)
2078 (file-remote-p . tramp-handle-file-remote-p)
2079 (insert-file-contents . tramp-handle-insert-file-contents)
2080 (insert-file-contents-literally
2081 . tramp-handle-insert-file-contents-literally)
2082 (write-region . tramp-handle-write-region)
2083 (find-backup-file-name . tramp-handle-find-backup-file-name)
2084 (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
2085 (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
2086 (dired-compress-file . tramp-handle-dired-compress-file)
2087 (dired-recursive-delete-directory
2088 . tramp-handle-dired-recursive-delete-directory)
2089 (dired-uncache . tramp-handle-dired-uncache)
2090 (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
2091 (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
2092 (file-selinux-context . tramp-handle-file-selinux-context)
2093 (set-file-selinux-context . tramp-handle-set-file-selinux-context)
2094 (vc-registered . tramp-handle-vc-registered))
2095 "Alist of handler functions.
2096 Operations not mentioned here will be handled by the normal Emacs functions.")
2097
2098 ;; Handlers for partial Tramp file names. For Emacs just
2099 ;; `file-name-all-completions' is needed.
2100 ;;;###autoload
2101 (defconst tramp-completion-file-name-handler-alist
2102 '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
2103 (file-name-completion . tramp-completion-handle-file-name-completion))
2104 "Alist of completion handler functions.
2105 Used for file names matching `tramp-file-name-regexp'. Operations not
2106 mentioned here will be handled by `tramp-file-name-handler-alist' or the
2107 normal Emacs functions.")
2108
2109 ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
2110 (defvar tramp-foreign-file-name-handler-alist
2111 ;; (identity . tramp-sh-file-name-handler) should always be the last
2112 ;; entry, because `identity' always matches.
2113 '((identity . tramp-sh-file-name-handler))
2114 "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
2115 If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
2116 calling HANDLER.")
2117
2118 ;;; Internal functions which must come first:
2119
2120 (defsubst tramp-debug-message (vec fmt-string &rest args)
2121 "Append message to debug buffer.
2122 Message is formatted with FMT-STRING as control string and the remaining
2123 ARGS to actually emit the message (if applicable)."
2124 (when (get-buffer (tramp-buffer-name vec))
2125 (with-current-buffer (tramp-get-debug-buffer vec)
2126 (goto-char (point-max))
2127 ;; Headline.
2128 (when (bobp)
2129 (insert
2130 (format
2131 ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
2132 (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
2133 emacs-version tramp-version)))
2134 (unless (bolp)
2135 (insert "\n"))
2136 ;; Timestamp.
2137 (let ((now (current-time)))
2138 (insert (format-time-string "%T." now))
2139 (insert (format "%06d " (nth 2 now))))
2140 ;; Calling function.
2141 (let ((btn 1) btf fn)
2142 (while (not fn)
2143 (setq btf (nth 1 (backtrace-frame btn)))
2144 (if (not btf)
2145 (setq fn "")
2146 (when (symbolp btf)
2147 (setq fn (symbol-name btf))
2148 (unless (and (string-match "^tramp" fn)
2149 (not (string-match
2150 "^tramp\\(-debug\\)?\\(-message\\|-error\\|-compat-funcall\\)$"
2151 fn)))
2152 (setq fn nil)))
2153 (setq btn (1+ btn))))
2154 ;; The following code inserts filename and line number.
2155 ;; Should be deactivated by default, because it is time
2156 ;; consuming.
2157 ; (let ((ffn (find-function-noselect (intern fn))))
2158 ; (insert
2159 ; (format
2160 ; "%s:%d: "
2161 ; (file-name-nondirectory (buffer-file-name (car ffn)))
2162 ; (with-current-buffer (car ffn)
2163 ; (1+ (count-lines (point-min) (cdr ffn)))))))
2164 (insert (format "%s " fn)))
2165 ;; The message.
2166 (insert (apply 'format fmt-string args)))))
2167
2168 (defvar tramp-message-show-message t
2169 "Show Tramp message in the minibuffer.
2170 This variable is used to disable messages from `tramp-error'.
2171 The messages are visible anyway, because an error is raised.")
2172
2173 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
2174 "Emit a message depending on verbosity level.
2175 VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
2176 vector or a process. LEVEL says to be quiet if `tramp-verbose' is
2177 less than LEVEL. The message is emitted only if `tramp-verbose' is
2178 greater than or equal to LEVEL.
2179
2180 The message is also logged into the debug buffer when `tramp-verbose'
2181 is greater than or equal 4.
2182
2183 Calls functions `message' and `tramp-debug-message' with FMT-STRING as
2184 control string and the remaining ARGS to actually emit the message (if
2185 applicable)."
2186 (condition-case nil
2187 (when (<= level tramp-verbose)
2188 ;; Match data must be preserved!
2189 (save-match-data
2190 ;; Display only when there is a minimum level.
2191 (when (and tramp-message-show-message (<= level 3))
2192 (apply 'message
2193 (concat
2194 (cond
2195 ((= level 0) "")
2196 ((= level 1) "")
2197 ((= level 2) "Warning: ")
2198 (t "Tramp: "))
2199 fmt-string)
2200 args))
2201 ;; Log only when there is a minimum level.
2202 (when (>= tramp-verbose 4)
2203 (when (and vec-or-proc
2204 (processp vec-or-proc)
2205 (buffer-name (process-buffer vec-or-proc)))
2206 (with-current-buffer (process-buffer vec-or-proc)
2207 ;; Translate proc to vec.
2208 (setq vec-or-proc (tramp-dissect-file-name default-directory))))
2209 (when (and vec-or-proc (vectorp vec-or-proc))
2210 (apply 'tramp-debug-message
2211 vec-or-proc
2212 (concat (format "(%d) # " level) fmt-string)
2213 args)))))
2214 ;; Suppress all errors.
2215 (error nil)))
2216
2217 (defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
2218 "Emit an error.
2219 VEC-OR-PROC identifies the connection to use, SIGNAL is the
2220 signal identifier to be raised, remaining args passed to
2221 `tramp-message'. Finally, signal SIGNAL is raised."
2222 (let (tramp-message-show-message)
2223 (tramp-message
2224 vec-or-proc 1 "%s"
2225 (error-message-string
2226 (list signal
2227 (get signal 'error-message)
2228 (apply 'format fmt-string args))))
2229 (signal signal (list (apply 'format fmt-string args)))))
2230
2231 (defsubst tramp-error-with-buffer
2232 (buffer vec-or-proc signal fmt-string &rest args)
2233 "Emit an error, and show BUFFER.
2234 If BUFFER is nil, show the connection buffer. Wait for 30\", or until
2235 an input event arrives. The other arguments are passed to `tramp-error'."
2236 (save-window-excursion
2237 (unwind-protect
2238 (apply 'tramp-error vec-or-proc signal fmt-string args)
2239 (when (and vec-or-proc
2240 (not (zerop tramp-verbose))
2241 (not (tramp-completion-mode-p)))
2242 (let ((enable-recursive-minibuffers t))
2243 (pop-to-buffer
2244 (or (and (bufferp buffer) buffer)
2245 (and (processp vec-or-proc) (process-buffer vec-or-proc))
2246 (tramp-get-buffer vec-or-proc)))
2247 (sit-for 30))))))
2248
2249 (defmacro with-parsed-tramp-file-name (filename var &rest body)
2250 "Parse a Tramp filename and make components available in the body.
2251
2252 First arg FILENAME is evaluated and dissected into its components.
2253 Second arg VAR is a symbol. It is used as a variable name to hold
2254 the filename structure. It is also used as a prefix for the variables
2255 holding the components. For example, if VAR is the symbol `foo', then
2256 `foo' will be bound to the whole structure, `foo-method' will be bound to
2257 the method component, and so on for `foo-user', `foo-host', `foo-localname'.
2258
2259 Remaining args are Lisp expressions to be evaluated (inside an implicit
2260 `progn').
2261
2262 If VAR is nil, then we bind `v' to the structure and `method', `user',
2263 `host', `localname' to the components."
2264 `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
2265 (,(if var (intern (concat (symbol-name var) "-method")) 'method)
2266 (tramp-file-name-method ,(or var 'v)))
2267 (,(if var (intern (concat (symbol-name var) "-user")) 'user)
2268 (tramp-file-name-user ,(or var 'v)))
2269 (,(if var (intern (concat (symbol-name var) "-host")) 'host)
2270 (tramp-file-name-host ,(or var 'v)))
2271 (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
2272 (tramp-file-name-localname ,(or var 'v))))
2273 ,@body))
2274
2275 (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
2276 (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
2277 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
2278
2279 (defmacro with-file-property (vec file property &rest body)
2280 "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
2281 FILE must be a local file name on a connection identified via VEC."
2282 `(if (file-name-absolute-p ,file)
2283 (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
2284 (when (eq value 'undef)
2285 ;; We cannot pass @body as parameter to
2286 ;; `tramp-set-file-property' because it mangles our
2287 ;; debug messages.
2288 (setq value (progn ,@body))
2289 (tramp-set-file-property ,vec ,file ,property value))
2290 value)
2291 ,@body))
2292
2293 (put 'with-file-property 'lisp-indent-function 3)
2294 (put 'with-file-property 'edebug-form-spec t)
2295 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
2296
2297 (defmacro with-connection-property (key property &rest body)
2298 "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
2299 `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
2300 (when (eq value 'undef)
2301 ;; We cannot pass ,@body as parameter to
2302 ;; `tramp-set-connection-property' because it mangles our debug
2303 ;; messages.
2304 (setq value (progn ,@body))
2305 (tramp-set-connection-property ,key ,property value))
2306 value))
2307
2308 (put 'with-connection-property 'lisp-indent-function 2)
2309 (put 'with-connection-property 'edebug-form-spec t)
2310 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
2311
2312 (defun tramp-progress-reporter-update (reporter &optional value)
2313 (let* ((parameters (cdr reporter))
2314 (message (aref parameters 3)))
2315 (when (string-match message (or (current-message) ""))
2316 (tramp-compat-funcall 'progress-reporter-update reporter value))))
2317
2318 (defmacro with-progress-reporter (vec level message &rest body)
2319 "Executes BODY, spinning a progress reporter with MESSAGE.
2320 If LEVEL does not fit for visible messages, or if this is a
2321 nested call of the macro, there are only traces without a visible
2322 progress reporter."
2323 `(let (pr tm)
2324 (tramp-message ,vec ,level "%s..." ,message)
2325 ;; We start a pulsing progress reporter after 3 seconds. Feature
2326 ;; introduced in Emacs 24.1.
2327 (when (and tramp-message-show-message
2328 ;; Display only when there is a minimum level.
2329 (<= ,level (min tramp-verbose 3)))
2330 (condition-case nil
2331 (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
2332 tm (when pr
2333 (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))
2334 (error nil)))
2335 (unwind-protect
2336 ;; Execute the body. Unset `tramp-message-show-message' when
2337 ;; the timer object is created, in order to suppress
2338 ;; concurrent timers.
2339 (let ((tramp-message-show-message
2340 (and tramp-message-show-message (not tm))))
2341 ,@body)
2342 ;; Stop progress reporter.
2343 (if tm (tramp-compat-funcall 'cancel-timer tm))
2344 (tramp-message ,vec ,level "%s...done" ,message))))
2345
2346 (put 'with-progress-reporter 'lisp-indent-function 3)
2347 (put 'with-progress-reporter 'edebug-form-spec t)
2348 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
2349
2350 (eval-and-compile ;; Silence compiler.
2351 (if (memq system-type '(cygwin windows-nt))
2352 (defun tramp-drop-volume-letter (name)
2353 "Cut off unnecessary drive letter from file NAME.
2354 The function `tramp-handle-expand-file-name' calls `expand-file-name'
2355 locally on a remote file name. When the local system is a W32 system
2356 but the remote system is Unix, this introduces a superfluous drive
2357 letter into the file name. This function removes it."
2358 (save-match-data
2359 (if (string-match tramp-root-regexp name)
2360 (replace-match "/" nil t name)
2361 name)))
2362
2363 (defalias 'tramp-drop-volume-letter 'identity)))
2364
2365 (defsubst tramp-make-tramp-temp-file (vec)
2366 "Create a temporary file on the remote host identified by VEC.
2367 Return the local name of the temporary file."
2368 (let ((prefix
2369 (tramp-make-tramp-file-name
2370 (tramp-file-name-method vec)
2371 (tramp-file-name-user vec)
2372 (tramp-file-name-host vec)
2373 (tramp-drop-volume-letter
2374 (expand-file-name
2375 tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
2376 result)
2377 (while (not result)
2378 ;; `make-temp-file' would be the natural choice for
2379 ;; implementation. But it calls `write-region' internally,
2380 ;; which also needs a temporary file - we would end in an
2381 ;; infinite loop.
2382 (setq result (make-temp-name prefix))
2383 (if (file-exists-p result)
2384 (setq result nil)
2385 ;; This creates the file by side effect.
2386 (set-file-times result)
2387 (set-file-modes result (tramp-octal-to-decimal "0700"))))
2388
2389 ;; Return the local part.
2390 (with-parsed-tramp-file-name result nil localname)))
2391
2392
2393 ;;; Config Manipulation Functions:
2394
2395 (defun tramp-set-completion-function (method function-list)
2396 "Sets the list of completion functions for METHOD.
2397 FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
2398 The FUNCTION is intended to parse FILE according its syntax.
2399 It might be a predefined FUNCTION, or a user defined FUNCTION.
2400 Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
2401 `tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
2402 and `tramp-parse-netrc'.
2403
2404 Example:
2405
2406 (tramp-set-completion-function
2407 \"ssh\"
2408 '((tramp-parse-sconfig \"/etc/ssh_config\")
2409 (tramp-parse-sconfig \"~/.ssh/config\")))"
2410
2411 (let ((r function-list)
2412 (v function-list))
2413 (setq tramp-completion-function-alist
2414 (delete (assoc method tramp-completion-function-alist)
2415 tramp-completion-function-alist))
2416
2417 (while v
2418 ;; Remove double entries.
2419 (when (member (car v) (cdr v))
2420 (setcdr v (delete (car v) (cdr v))))
2421 ;; Check for function and file or registry key.
2422 (unless (and (functionp (nth 0 (car v)))
2423 (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
2424 ;; Windows registry.
2425 (and (memq system-type '(cygwin windows-nt))
2426 (zerop
2427 (tramp-local-call-process
2428 "reg" nil nil nil "query" (nth 1 (car v)))))
2429 ;; Configuration file.
2430 (file-exists-p (nth 1 (car v)))))
2431 (setq r (delete (car v) r)))
2432 (setq v (cdr v)))
2433
2434 (when r
2435 (add-to-list 'tramp-completion-function-alist
2436 (cons method r)))))
2437
2438 (defun tramp-get-completion-function (method)
2439 "Returns a list of completion functions for METHOD.
2440 For definition of that list see `tramp-set-completion-function'."
2441 (cons
2442 ;; Hosts visited once shall be remembered.
2443 `(tramp-parse-connection-properties ,method)
2444 ;; The method related defaults.
2445 (cdr (assoc method tramp-completion-function-alist))))
2446
2447
2448 ;;; Fontification of `read-file-name':
2449
2450 ;; rfn-eshadow.el is part of Emacs 22. It is autoloaded.
2451 (defvar tramp-rfn-eshadow-overlay)
2452 (make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
2453
2454 (defun tramp-rfn-eshadow-setup-minibuffer ()
2455 "Set up a minibuffer for `file-name-shadow-mode'.
2456 Adds another overlay hiding filename parts according to Tramp's
2457 special handling of `substitute-in-file-name'."
2458 (when (symbol-value 'minibuffer-completing-file-name)
2459 (setq tramp-rfn-eshadow-overlay
2460 (tramp-compat-funcall
2461 'make-overlay
2462 (tramp-compat-funcall 'minibuffer-prompt-end)
2463 (tramp-compat-funcall 'minibuffer-prompt-end)))
2464 ;; Copy rfn-eshadow-overlay properties.
2465 (let ((props (tramp-compat-funcall
2466 'overlay-properties (symbol-value 'rfn-eshadow-overlay))))
2467 (while props
2468 (tramp-compat-funcall
2469 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))))))
2470
2471 (when (boundp 'rfn-eshadow-setup-minibuffer-hook)
2472 (add-hook 'rfn-eshadow-setup-minibuffer-hook
2473 'tramp-rfn-eshadow-setup-minibuffer)
2474 (add-hook 'tramp-unload-hook
2475 (lambda ()
2476 (remove-hook 'rfn-eshadow-setup-minibuffer-hook
2477 'tramp-rfn-eshadow-setup-minibuffer))))
2478
2479 (defconst tramp-rfn-eshadow-update-overlay-regexp
2480 (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
2481
2482 (defun tramp-rfn-eshadow-update-overlay ()
2483 "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
2484 This is intended to be used as a minibuffer `post-command-hook' for
2485 `file-name-shadow-mode'; the minibuffer should have already
2486 been set up by `rfn-eshadow-setup-minibuffer'."
2487 ;; In remote files name, there is a shadowing just for the local part.
2488 (let ((end (or (tramp-compat-funcall
2489 'overlay-end (symbol-value 'rfn-eshadow-overlay))
2490 (tramp-compat-funcall 'minibuffer-prompt-end))))
2491 (when
2492 (file-remote-p
2493 (tramp-compat-funcall 'buffer-substring-no-properties end (point-max)))
2494 (save-excursion
2495 (save-restriction
2496 (narrow-to-region
2497 (1+ (or (string-match
2498 tramp-rfn-eshadow-update-overlay-regexp (buffer-string) end)
2499 end))
2500 (point-max))
2501 (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
2502 (rfn-eshadow-update-overlay-hook nil))
2503 (tramp-compat-funcall
2504 'move-overlay rfn-eshadow-overlay (point-max) (point-max))
2505 (tramp-compat-funcall 'rfn-eshadow-update-overlay)))))))
2506
2507 (when (boundp 'rfn-eshadow-update-overlay-hook)
2508 (add-hook 'rfn-eshadow-update-overlay-hook
2509 'tramp-rfn-eshadow-update-overlay)
2510 (add-hook 'tramp-unload-hook
2511 (lambda ()
2512 (remove-hook 'rfn-eshadow-update-overlay-hook
2513 'tramp-rfn-eshadow-update-overlay))))
2514
2515
2516 ;;; Integration of eshell.el:
2517
2518 (eval-when-compile
2519 (defvar eshell-path-env))
2520
2521 ;; eshell.el keeps the path in `eshell-path-env'. We must change it
2522 ;; when `default-directory' points to another host.
2523 (defun tramp-eshell-directory-change ()
2524 "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
2525 (setq eshell-path-env
2526 (if (file-remote-p default-directory)
2527 (with-parsed-tramp-file-name default-directory nil
2528 (mapconcat
2529 'identity
2530 (tramp-get-remote-path v)
2531 ":"))
2532 (getenv "PATH"))))
2533
2534 (eval-after-load "esh-util"
2535 '(progn
2536 (tramp-eshell-directory-change)
2537 (add-hook 'eshell-directory-change-hook
2538 'tramp-eshell-directory-change)
2539 (add-hook 'tramp-unload-hook
2540 (lambda ()
2541 (remove-hook 'eshell-directory-change-hook
2542 'tramp-eshell-directory-change)))))
2543
2544
2545 ;;; File Name Handler Functions:
2546
2547 (defun tramp-handle-make-symbolic-link
2548 (filename linkname &optional ok-if-already-exists)
2549 "Like `make-symbolic-link' for Tramp files.
2550 If LINKNAME is a non-Tramp file, it is used verbatim as the target of
2551 the symlink. If LINKNAME is a Tramp file, only the localname component is
2552 used as the target of the symlink.
2553
2554 If LINKNAME is a Tramp file and the localname component is relative, then
2555 it is expanded first, before the localname component is taken. Note that
2556 this can give surprising results if the user/host for the source and
2557 target of the symlink differ."
2558 (with-parsed-tramp-file-name linkname l
2559 (let ((ln (tramp-get-remote-ln l))
2560 (cwd (tramp-run-real-handler
2561 'file-name-directory (list l-localname))))
2562 (unless ln
2563 (tramp-error
2564 l 'file-error
2565 "Making a symbolic link. ln(1) does not exist on the remote host."))
2566
2567 ;; Do the 'confirm if exists' thing.
2568 (when (file-exists-p linkname)
2569 ;; What to do?
2570 (if (or (null ok-if-already-exists) ; not allowed to exist
2571 (and (numberp ok-if-already-exists)
2572 (not (yes-or-no-p
2573 (format
2574 "File %s already exists; make it a link anyway? "
2575 l-localname)))))
2576 (tramp-error
2577 l 'file-already-exists "File %s already exists" l-localname)
2578 (delete-file linkname)))
2579
2580 ;; If FILENAME is a Tramp name, use just the localname component.
2581 (when (tramp-tramp-file-p filename)
2582 (setq filename
2583 (tramp-file-name-localname
2584 (tramp-dissect-file-name (expand-file-name filename)))))
2585
2586 (tramp-flush-file-property l (file-name-directory l-localname))
2587 (tramp-flush-file-property l l-localname)
2588
2589 ;; Right, they are on the same host, regardless of user, method, etc.
2590 ;; We now make the link on the remote machine. This will occur as the user
2591 ;; that FILENAME belongs to.
2592 (zerop
2593 (tramp-send-command-and-check
2594 l
2595 (format
2596 "cd %s && %s -sf %s %s"
2597 (tramp-shell-quote-argument cwd)
2598 ln
2599 (tramp-shell-quote-argument filename)
2600 (tramp-shell-quote-argument l-localname))
2601 t)))))
2602
2603 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
2604 "Like `load' for Tramp files."
2605 (with-parsed-tramp-file-name (expand-file-name file) nil
2606 (unless nosuffix
2607 (cond ((file-exists-p (concat file ".elc"))
2608 (setq file (concat file ".elc")))
2609 ((file-exists-p (concat file ".el"))
2610 (setq file (concat file ".el")))))
2611 (when must-suffix
2612 ;; The first condition is always true for absolute file names.
2613 ;; Included for safety's sake.
2614 (unless (or (file-name-directory file)
2615 (string-match "\\.elc?\\'" file))
2616 (tramp-error
2617 v 'file-error
2618 "File `%s' does not include a `.el' or `.elc' suffix" file)))
2619 (unless noerror
2620 (when (not (file-exists-p file))
2621 (tramp-error v 'file-error "Cannot load nonexistent file `%s'" file)))
2622 (if (not (file-exists-p file))
2623 nil
2624 (let ((tramp-message-show-message (not nomessage)))
2625 (with-progress-reporter v 0 (format "Loading %s" file)
2626 (let ((local-copy (file-local-copy file)))
2627 ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
2628 (unwind-protect
2629 (load local-copy noerror t t)
2630 (delete-file local-copy)))))
2631 t)))
2632
2633 ;; Localname manipulation functions that grok Tramp localnames...
2634 (defun tramp-handle-file-name-as-directory (file)
2635 "Like `file-name-as-directory' but aware of Tramp files."
2636 ;; `file-name-as-directory' would be sufficient except localname is
2637 ;; the empty string.
2638 (let ((v (tramp-dissect-file-name file t)))
2639 ;; Run the command on the localname portion only.
2640 (tramp-make-tramp-file-name
2641 (tramp-file-name-method v)
2642 (tramp-file-name-user v)
2643 (tramp-file-name-host v)
2644 (tramp-run-real-handler
2645 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
2646
2647 (defun tramp-handle-file-name-directory (file)
2648 "Like `file-name-directory' but aware of Tramp files."
2649 ;; Everything except the last filename thing is the directory. We
2650 ;; cannot apply `with-parsed-tramp-file-name', because this expands
2651 ;; the remote file name parts. This is a problem when we are in
2652 ;; file name completion.
2653 (let ((v (tramp-dissect-file-name file t)))
2654 ;; Run the command on the localname portion only.
2655 (tramp-make-tramp-file-name
2656 (tramp-file-name-method v)
2657 (tramp-file-name-user v)
2658 (tramp-file-name-host v)
2659 (tramp-run-real-handler
2660 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
2661
2662 (defun tramp-handle-file-name-nondirectory (file)
2663 "Like `file-name-nondirectory' but aware of Tramp files."
2664 (with-parsed-tramp-file-name file nil
2665 (tramp-run-real-handler 'file-name-nondirectory (list localname))))
2666
2667 (defun tramp-handle-file-truename (filename &optional counter prev-dirs)
2668 "Like `file-truename' for Tramp files."
2669 (with-parsed-tramp-file-name (expand-file-name filename) nil
2670 (with-file-property v localname "file-truename"
2671 (let ((result nil)) ; result steps in reverse order
2672 (tramp-message v 4 "Finding true name for `%s'" filename)
2673 (cond
2674 ;; Use GNU readlink --canonicalize-missing where available.
2675 ((tramp-get-remote-readlink v)
2676 (setq result
2677 (tramp-send-command-and-read
2678 v
2679 (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
2680 (tramp-get-remote-readlink v)
2681 (tramp-shell-quote-argument localname)))))
2682
2683 ;; Use Perl implementation.
2684 ((and (tramp-get-remote-perl v)
2685 (tramp-get-connection-property v "perl-file-spec" nil)
2686 (tramp-get-connection-property v "perl-cwd-realpath" nil))
2687 (tramp-maybe-send-script
2688 v tramp-perl-file-truename "tramp_perl_file_truename")
2689 (setq result
2690 (tramp-send-command-and-read
2691 v
2692 (format "tramp_perl_file_truename %s"
2693 (tramp-shell-quote-argument localname)))))
2694
2695 ;; Do it yourself. We bind `directory-sep-char' here for
2696 ;; XEmacs on Windows, which would otherwise use backslash.
2697 (t (let* ((directory-sep-char ?/)
2698 (steps (tramp-compat-split-string localname "/"))
2699 (localnamedir (tramp-run-real-handler
2700 'file-name-as-directory (list localname)))
2701 (is-dir (string= localname localnamedir))
2702 (thisstep nil)
2703 (numchase 0)
2704 ;; Don't make the following value larger than
2705 ;; necessary. People expect an error message in a
2706 ;; timely fashion when something is wrong;
2707 ;; otherwise they might think that Emacs is hung.
2708 ;; Of course, correctness has to come first.
2709 (numchase-limit 20)
2710 symlink-target)
2711 (while (and steps (< numchase numchase-limit))
2712 (setq thisstep (pop steps))
2713 (tramp-message
2714 v 5 "Check %s"
2715 (mapconcat 'identity
2716 (append '("") (reverse result) (list thisstep))
2717 "/"))
2718 (setq symlink-target
2719 (nth 0 (file-attributes
2720 (tramp-make-tramp-file-name
2721 method user host
2722 (mapconcat 'identity
2723 (append '("")
2724 (reverse result)
2725 (list thisstep))
2726 "/")))))
2727 (cond ((string= "." thisstep)
2728 (tramp-message v 5 "Ignoring step `.'"))
2729 ((string= ".." thisstep)
2730 (tramp-message v 5 "Processing step `..'")
2731 (pop result))
2732 ((stringp symlink-target)
2733 ;; It's a symlink, follow it.
2734 (tramp-message v 5 "Follow symlink to %s" symlink-target)
2735 (setq numchase (1+ numchase))
2736 (when (file-name-absolute-p symlink-target)
2737 (setq result nil))
2738 ;; If the symlink was absolute, we'll get a string like
2739 ;; "/user@host:/some/target"; extract the
2740 ;; "/some/target" part from it.
2741 (when (tramp-tramp-file-p symlink-target)
2742 (unless (tramp-equal-remote filename symlink-target)
2743 (tramp-error
2744 v 'file-error
2745 "Symlink target `%s' on wrong host" symlink-target))
2746 (setq symlink-target localname))
2747 (setq steps
2748 (append (tramp-compat-split-string
2749 symlink-target "/")
2750 steps)))
2751 (t
2752 ;; It's a file.
2753 (setq result (cons thisstep result)))))
2754 (when (>= numchase numchase-limit)
2755 (tramp-error
2756 v 'file-error
2757 "Maximum number (%d) of symlinks exceeded" numchase-limit))
2758 (setq result (reverse result))
2759 ;; Combine list to form string.
2760 (setq result
2761 (if result
2762 (mapconcat 'identity (cons "" result) "/")
2763 "/"))
2764 (when (and is-dir (or (string= "" result)
2765 (not (string= (substring result -1) "/"))))
2766 (setq result (concat result "/"))))))
2767
2768 (tramp-message v 4 "True name of `%s' is `%s'" filename result)
2769 (tramp-make-tramp-file-name method user host result)))))
2770
2771 ;; Basic functions.
2772
2773 (defun tramp-handle-file-exists-p (filename)
2774 "Like `file-exists-p' for Tramp files."
2775 (with-parsed-tramp-file-name filename nil
2776 (with-file-property v localname "file-exists-p"
2777 (or (not (null (tramp-get-file-property
2778 v localname "file-attributes-integer" nil)))
2779 (not (null (tramp-get-file-property
2780 v localname "file-attributes-string" nil)))
2781 (zerop (tramp-send-command-and-check
2782 v
2783 (format
2784 "%s %s"
2785 (tramp-get-file-exists-command v)
2786 (tramp-shell-quote-argument localname))))))))
2787
2788 ;; Inodes don't exist for some file systems. Therefore we must
2789 ;; generate virtual ones. Used in `find-buffer-visiting'. The method
2790 ;; applied might be not so efficient (Ange-FTP uses hashes). But
2791 ;; performance isn't the major issue given that file transfer will
2792 ;; take time.
2793 (defvar tramp-inodes nil
2794 "Keeps virtual inodes numbers.")
2795
2796 ;; Devices must distinguish physical file systems. The device numbers
2797 ;; provided by "lstat" aren't unique, because we operate on different hosts.
2798 ;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
2799 ;; EFS use device number "-1". In order to be different, we use device number
2800 ;; (-1 . x), whereby "x" is unique for a given (method user host).
2801 (defvar tramp-devices nil
2802 "Keeps virtual device numbers.")
2803
2804 ;; CCC: This should check for an error condition and signal failure
2805 ;; when something goes wrong.
2806 ;; Daniel Pittman <daniel@danann.net>
2807 (defun tramp-handle-file-attributes (filename &optional id-format)
2808 "Like `file-attributes' for Tramp files."
2809 (unless id-format (setq id-format 'integer))
2810 ;; Don't modify `last-coding-system-used' by accident.
2811 (let ((last-coding-system-used last-coding-system-used))
2812 (with-parsed-tramp-file-name (expand-file-name filename) nil
2813 (with-file-property v localname (format "file-attributes-%s" id-format)
2814 (save-excursion
2815 (tramp-convert-file-attributes
2816 v
2817 (cond
2818 ((tramp-get-remote-stat v)
2819 (tramp-do-file-attributes-with-stat v localname id-format))
2820 ((tramp-get-remote-perl v)
2821 (tramp-do-file-attributes-with-perl v localname id-format))
2822 (t
2823 (tramp-do-file-attributes-with-ls v localname id-format)))))))))
2824
2825 (defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
2826 "Implement `file-attributes' for Tramp files using the ls(1) command."
2827 (let (symlinkp dirp
2828 res-inode res-filemodes res-numlinks
2829 res-uid res-gid res-size res-symlink-target)
2830 (tramp-message vec 5 "file attributes with ls: %s" localname)
2831 (tramp-send-command
2832 vec
2833 (format "(%s %s || %s -h %s) && %s %s %s"
2834 (tramp-get-file-exists-command vec)
2835 (tramp-shell-quote-argument localname)
2836 (tramp-get-test-command vec)
2837 (tramp-shell-quote-argument localname)
2838 (tramp-get-ls-command vec)
2839 (if (eq id-format 'integer) "-ildn" "-ild")
2840 (tramp-shell-quote-argument localname)))
2841 ;; parse `ls -l' output ...
2842 (with-current-buffer (tramp-get-buffer vec)
2843 (when (> (buffer-size) 0)
2844 (goto-char (point-min))
2845 ;; ... inode
2846 (setq res-inode
2847 (condition-case err
2848 (read (current-buffer))
2849 (invalid-read-syntax
2850 (when (and (equal (cadr err)
2851 "Integer constant overflow in reader")
2852 (string-match
2853 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
2854 (car (cddr err))))
2855 (let* ((big (read (substring (car (cddr err)) 0
2856 (match-beginning 1))))
2857 (small (read (match-string 1 (car (cddr err)))))
2858 (twiddle (/ small 65536)))
2859 (cons (+ big twiddle)
2860 (- small (* twiddle 65536))))))))
2861 ;; ... file mode flags
2862 (setq res-filemodes (symbol-name (read (current-buffer))))
2863 ;; ... number links
2864 (setq res-numlinks (read (current-buffer)))
2865 ;; ... uid and gid
2866 (setq res-uid (read (current-buffer)))
2867 (setq res-gid (read (current-buffer)))
2868 (if (eq id-format 'integer)
2869 (progn
2870 (unless (numberp res-uid) (setq res-uid -1))
2871 (unless (numberp res-gid) (setq res-gid -1)))
2872 (progn
2873 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
2874 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
2875 ;; ... size
2876 (setq res-size (read (current-buffer)))
2877 ;; From the file modes, figure out other stuff.
2878 (setq symlinkp (eq ?l (aref res-filemodes 0)))
2879 (setq dirp (eq ?d (aref res-filemodes 0)))
2880 ;; if symlink, find out file name pointed to
2881 (when symlinkp
2882 (search-forward "-> ")
2883 (setq res-symlink-target
2884 (buffer-substring (point) (tramp-compat-line-end-position))))
2885 ;; return data gathered
2886 (list
2887 ;; 0. t for directory, string (name linked to) for symbolic
2888 ;; link, or nil.
2889 (or dirp res-symlink-target)
2890 ;; 1. Number of links to file.
2891 res-numlinks
2892 ;; 2. File uid.
2893 res-uid
2894 ;; 3. File gid.
2895 res-gid
2896 ;; 4. Last access time, as a list of two integers. First
2897 ;; integer has high-order 16 bits of time, second has low 16
2898 ;; bits.
2899 ;; 5. Last modification time, likewise.
2900 ;; 6. Last status change time, likewise.
2901 '(0 0) '(0 0) '(0 0) ;CCC how to find out?
2902 ;; 7. Size in bytes (-1, if number is out of range).
2903 res-size
2904 ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
2905 res-filemodes
2906 ;; 9. t if file's gid would change if file were deleted and
2907 ;; recreated. Will be set in `tramp-convert-file-attributes'
2908 t
2909 ;; 10. inode number.
2910 res-inode
2911 ;; 11. Device number. Will be replaced by a virtual device number.
2912 -1
2913 )))))
2914
2915 (defun tramp-do-file-attributes-with-perl
2916 (vec localname &optional id-format)
2917 "Implement `file-attributes' for Tramp files using a Perl script."
2918 (tramp-message vec 5 "file attributes with perl: %s" localname)
2919 (tramp-maybe-send-script
2920 vec tramp-perl-file-attributes "tramp_perl_file_attributes")
2921 (tramp-send-command-and-read
2922 vec
2923 (format "tramp_perl_file_attributes %s %s"
2924 (tramp-shell-quote-argument localname) id-format)))
2925
2926 (defun tramp-do-file-attributes-with-stat
2927 (vec localname &optional id-format)
2928 "Implement `file-attributes' for Tramp files using stat(1) command."
2929 (tramp-message vec 5 "file attributes with stat: %s" localname)
2930 (tramp-send-command-and-read
2931 vec
2932 (format
2933 ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
2934 ;; parse correctly the sequence "((". Therefore, we add a space.
2935 "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)' %s || echo nil)"
2936 (tramp-get-file-exists-command vec)
2937 (tramp-shell-quote-argument localname)
2938 (tramp-get-test-command vec)
2939 (tramp-shell-quote-argument localname)
2940 (tramp-get-remote-stat vec)
2941 (if (eq id-format 'integer) "%u" "\"%U\"")
2942 (if (eq id-format 'integer) "%g" "\"%G\"")
2943 (tramp-shell-quote-argument localname))))
2944
2945 (defun tramp-handle-set-visited-file-modtime (&optional time-list)
2946 "Like `set-visited-file-modtime' for Tramp files."
2947 (unless (buffer-file-name)
2948 (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
2949 (buffer-name)))
2950 (if time-list
2951 (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2952 (let ((f (buffer-file-name))
2953 coding-system-used)
2954 (with-parsed-tramp-file-name f nil
2955 (let* ((attr (file-attributes f))
2956 ;; '(-1 65535) means file doesn't exists yet.
2957 (modtime (or (nth 5 attr) '(-1 65535))))
2958 (when (boundp 'last-coding-system-used)
2959 (setq coding-system-used (symbol-value 'last-coding-system-used)))
2960 ;; We use '(0 0) as a don't-know value. See also
2961 ;; `tramp-do-file-attributes-with-ls'.
2962 (if (not (equal modtime '(0 0)))
2963 (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2964 (progn
2965 (tramp-send-command
2966 v
2967 (format "%s -ild %s"
2968 (tramp-get-ls-command v)
2969 (tramp-shell-quote-argument localname)))
2970 (setq attr (buffer-substring (point)
2971 (progn (end-of-line) (point)))))
2972 (tramp-set-file-property
2973 v localname "visited-file-modtime-ild" attr))
2974 (when (boundp 'last-coding-system-used)
2975 (set 'last-coding-system-used coding-system-used))
2976 nil)))))
2977
2978 ;; This function makes the same assumption as
2979 ;; `tramp-handle-set-visited-file-modtime'.
2980 (defun tramp-handle-verify-visited-file-modtime (buf)
2981 "Like `verify-visited-file-modtime' for Tramp files.
2982 At the time `verify-visited-file-modtime' calls this function, we
2983 already know that the buffer is visiting a file and that
2984 `visited-file-modtime' does not return 0. Do not call this
2985 function directly, unless those two cases are already taken care
2986 of."
2987 (with-current-buffer buf
2988 (let ((f (buffer-file-name)))
2989 ;; There is no file visiting the buffer, or the buffer has no
2990 ;; recorded last modification time, or there is no established
2991 ;; connection.
2992 (if (or (not f)
2993 (eq (visited-file-modtime) 0)
2994 (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
2995 t
2996 (with-parsed-tramp-file-name f nil
2997 (tramp-flush-file-property v localname)
2998 (let* ((attr (file-attributes f))
2999 (modtime (nth 5 attr))
3000 (mt (visited-file-modtime)))
3001
3002 (cond
3003 ;; File exists, and has a known modtime.
3004 ((and attr (not (equal modtime '(0 0))))
3005 (< (abs (tramp-time-diff
3006 modtime
3007 ;; For compatibility, deal with both the old
3008 ;; (HIGH . LOW) and the new (HIGH LOW) return
3009 ;; values of `visited-file-modtime'.
3010 (if (atom (cdr mt))
3011 (list (car mt) (cdr mt))
3012 mt)))
3013 2))
3014 ;; Modtime has the don't know value.
3015 (attr
3016 (tramp-send-command
3017 v
3018 (format "%s -ild %s"
3019 (tramp-get-ls-command v)
3020 (tramp-shell-quote-argument localname)))
3021 (with-current-buffer (tramp-get-buffer v)
3022 (setq attr (buffer-substring
3023 (point) (progn (end-of-line) (point)))))
3024 (equal
3025 attr
3026 (tramp-get-file-property
3027 v localname "visited-file-modtime-ild" "")))
3028 ;; If file does not exist, say it is not modified if and
3029 ;; only if that agrees with the buffer's record.
3030 (t (equal mt '(-1 65535))))))))))
3031
3032 (defun tramp-handle-set-file-modes (filename mode)
3033 "Like `set-file-modes' for Tramp files."
3034 (with-parsed-tramp-file-name filename nil
3035 (tramp-flush-file-property v localname)
3036 (unless (zerop (tramp-send-command-and-check
3037 v
3038 (format "chmod %s %s"
3039 (tramp-decimal-to-octal mode)
3040 (tramp-shell-quote-argument localname))))
3041 ;; FIXME: extract the proper text from chmod's stderr.
3042 (tramp-error
3043 v 'file-error "Error while changing file's mode %s" filename))))
3044
3045 (defun tramp-handle-set-file-times (filename &optional time)
3046 "Like `set-file-times' for Tramp files."
3047 (zerop
3048 (if (file-remote-p filename)
3049 (with-parsed-tramp-file-name filename nil
3050 (tramp-flush-file-property v localname)
3051 (let ((time (if (or (null time) (equal time '(0 0)))
3052 (current-time)
3053 time))
3054 ;; With GNU Emacs, `format-time-string' has an optional
3055 ;; parameter UNIVERSAL. This is preferred, because we
3056 ;; could handle the case when the remote host is
3057 ;; located in a different time zone as the local host.
3058 (utc (not (featurep 'xemacs))))
3059 (tramp-send-command-and-check
3060 v (format "%s touch -t %s %s"
3061 (if utc "TZ=UTC; export TZ;" "")
3062 (if utc
3063 (format-time-string "%Y%m%d%H%M.%S" time t)
3064 (format-time-string "%Y%m%d%H%M.%S" time))
3065 (tramp-shell-quote-argument localname)))))
3066
3067 ;; We handle also the local part, because in older Emacsen,
3068 ;; without `set-file-times', this function is an alias for this.
3069 ;; We are local, so we don't need the UTC settings.
3070 (tramp-local-call-process
3071 "touch" nil nil nil "-t"
3072 (format-time-string "%Y%m%d%H%M.%S" time)
3073 (tramp-shell-quote-argument filename)))))
3074
3075 (defun tramp-set-file-uid-gid (filename &optional uid gid)
3076 "Set the ownership for FILENAME.
3077 If UID and GID are provided, these values are used; otherwise uid
3078 and gid of the corresponding user is taken. Both parameters must be integers."
3079 ;; Modern Unices allow chown only for root. So we might need
3080 ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
3081 ;; working with su(do)? when it is needed, so it shall succeed in
3082 ;; the majority of cases.
3083 ;; Don't modify `last-coding-system-used' by accident.
3084 (let ((last-coding-system-used last-coding-system-used))
3085 (if (file-remote-p filename)
3086 (with-parsed-tramp-file-name filename nil
3087 (if (and (zerop (user-uid)) (tramp-local-host-p v))
3088 ;; If we are root on the local host, we can do it directly.
3089 (tramp-set-file-uid-gid localname uid gid)
3090 (let ((uid (or (and (integerp uid) uid)
3091 (tramp-get-remote-uid v 'integer)))
3092 (gid (or (and (integerp gid) gid)
3093 (tramp-get-remote-gid v 'integer))))
3094 (tramp-send-command
3095 v (format
3096 "chown %d:%d %s" uid gid
3097 (tramp-shell-quote-argument localname))))))
3098
3099 ;; We handle also the local part, because there doesn't exist
3100 ;; `set-file-uid-gid'. On W32 "chown" might not work.
3101 (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
3102 (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
3103 (tramp-local-call-process
3104 "chown" nil nil nil
3105 (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
3106
3107 (defun tramp-remote-selinux-p (vec)
3108 "Check, whether SELINUX is enabled on the remote host."
3109 (with-connection-property (tramp-get-connection-process vec) "selinux-p"
3110 (let ((result (tramp-find-executable
3111 vec "getenforce" (tramp-get-remote-path vec) t t)))
3112 (and result
3113 (string-equal
3114 (tramp-send-command-and-read
3115 vec (format "echo \\\"`%S`\\\"" result))
3116 "Enforcing")))))
3117
3118 (defun tramp-handle-file-selinux-context (filename)
3119 "Like `file-selinux-context' for Tramp files."
3120 (with-parsed-tramp-file-name filename nil
3121 (with-file-property v localname "file-selinux-context"
3122 (let ((context '(nil nil nil nil))
3123 (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
3124 "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))
3125 (when (and (tramp-remote-selinux-p v)
3126 (zerop (tramp-send-command-and-check
3127 v (format
3128 "%s -d -Z %s"
3129 (tramp-get-ls-command v)
3130 (tramp-shell-quote-argument localname)))))
3131 (with-current-buffer (tramp-get-connection-buffer v)
3132 (goto-char (point-min))
3133 (when (re-search-forward regexp (tramp-compat-line-end-position) t)
3134 (setq context (list (match-string 1) (match-string 2)
3135 (match-string 3) (match-string 4))))))
3136 ;; Return the context.
3137 context))))
3138
3139 (defun tramp-handle-set-file-selinux-context (filename context)
3140 "Like `set-file-selinux-context' for Tramp files."
3141 (with-parsed-tramp-file-name filename nil
3142 (if (and (consp context)
3143 (tramp-remote-selinux-p v)
3144 (zerop (tramp-send-command-and-check
3145 v (format "chcon %s %s %s %s %s"
3146 (if (stringp (nth 0 context))
3147 (format "--user=%s" (nth 0 context)) "")
3148 (if (stringp (nth 1 context))
3149 (format "--role=%s" (nth 1 context)) "")
3150 (if (stringp (nth 2 context))
3151 (format "--type=%s" (nth 2 context)) "")
3152 (if (stringp (nth 3 context))
3153 (format "--range=%s" (nth 3 context)) "")
3154 (tramp-shell-quote-argument localname)))))
3155 (tramp-set-file-property v localname "file-selinux-context" context)
3156 (tramp-set-file-property v localname "file-selinux-context" 'undef)))
3157 ;; We always return nil.
3158 nil)
3159
3160 ;; Simple functions using the `test' command.
3161
3162 (defun tramp-handle-file-executable-p (filename)
3163 "Like `file-executable-p' for Tramp files."
3164 (with-parsed-tramp-file-name filename nil
3165 (with-file-property v localname "file-executable-p"
3166 ;; Examine `file-attributes' cache to see if request can be
3167 ;; satisfied without remote operation.
3168 (or (tramp-check-cached-permissions v ?x)
3169 (zerop (tramp-run-test "-x" filename))))))
3170
3171 (defun tramp-handle-file-readable-p (filename)
3172 "Like `file-readable-p' for Tramp files."
3173 (with-parsed-tramp-file-name filename nil
3174 (with-file-property v localname "file-readable-p"
3175 ;; Examine `file-attributes' cache to see if request can be
3176 ;; satisfied without remote operation.
3177 (or (tramp-check-cached-permissions v ?r)
3178 (zerop (tramp-run-test "-r" filename))))))
3179
3180 ;; When the remote shell is started, it looks for a shell which groks
3181 ;; tilde expansion. Here, we assume that all shells which grok tilde
3182 ;; expansion will also provide a `test' command which groks `-nt' (for
3183 ;; newer than). If this breaks, tell me about it and I'll try to do
3184 ;; something smarter about it.
3185 (defun tramp-handle-file-newer-than-file-p (file1 file2)
3186 "Like `file-newer-than-file-p' for Tramp files."
3187 (cond ((not (file-exists-p file1))
3188 nil)
3189 ((not (file-exists-p file2))
3190 t)
3191 ;; We are sure both files exist at this point.
3192 (t
3193 (save-excursion
3194 ;; We try to get the mtime of both files. If they are not
3195 ;; equal to the "dont-know" value, then we subtract the times
3196 ;; and obtain the result.
3197 (let ((fa1 (file-attributes file1))
3198 (fa2 (file-attributes file2)))
3199 (if (and (not (equal (nth 5 fa1) '(0 0)))
3200 (not (equal (nth 5 fa2) '(0 0))))
3201 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
3202 ;; If one of them is the dont-know value, then we can
3203 ;; still try to run a shell command on the remote host.
3204 ;; However, this only works if both files are Tramp
3205 ;; files and both have the same method, same user, same
3206 ;; host.
3207 (unless (tramp-equal-remote file1 file2)
3208 (with-parsed-tramp-file-name
3209 (if (tramp-tramp-file-p file1) file1 file2) nil
3210 (tramp-error
3211 v 'file-error
3212 "Files %s and %s must have same method, user, host"
3213 file1 file2)))
3214 (with-parsed-tramp-file-name file1 nil
3215 (zerop (tramp-run-test2
3216 (tramp-get-test-nt-command v) file1 file2)))))))))
3217
3218 ;; Functions implemented using the basic functions above.
3219
3220 (defun tramp-handle-file-modes (filename)
3221 "Like `file-modes' for Tramp files."
3222 (let ((truename (or (file-truename filename) filename)))
3223 (when (file-exists-p truename)
3224 (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
3225
3226 (defun tramp-default-file-modes (filename)
3227 "Return file modes of FILENAME as integer.
3228 If the file modes of FILENAME cannot be determined, return the
3229 value of `default-file-modes', without execute permissions."
3230 (or (file-modes filename)
3231 (logand (default-file-modes) (tramp-octal-to-decimal "0666"))))
3232
3233 (defun tramp-handle-file-directory-p (filename)
3234 "Like `file-directory-p' for Tramp files."
3235 ;; Care must be taken that this function returns `t' for symlinks
3236 ;; pointing to directories. Surely the most obvious implementation
3237 ;; would be `test -d', but that returns false for such symlinks.
3238 ;; CCC: Stefan Monnier says that `test -d' follows symlinks. And
3239 ;; I now think he's right. So we could be using `test -d', couldn't
3240 ;; we?
3241 ;;
3242 ;; Alternatives: `cd %s', `test -d %s'
3243 (with-parsed-tramp-file-name filename nil
3244 (with-file-property v localname "file-directory-p"
3245 (zerop (tramp-run-test "-d" filename)))))
3246
3247 (defun tramp-handle-file-regular-p (filename)
3248 "Like `file-regular-p' for Tramp files."
3249 (and (file-exists-p filename)
3250 (eq ?- (aref (nth 8 (file-attributes filename)) 0))))
3251
3252 (defun tramp-handle-file-symlink-p (filename)
3253 "Like `file-symlink-p' for Tramp files."
3254 (with-parsed-tramp-file-name filename nil
3255 (let ((x (car (file-attributes filename))))
3256 (when (stringp x)
3257 ;; When Tramp is running on VMS, then `file-name-absolute-p'
3258 ;; might do weird things.
3259 (if (file-name-absolute-p x)
3260 (tramp-make-tramp-file-name method user host x)
3261 x)))))
3262
3263 (defun tramp-handle-file-writable-p (filename)
3264 "Like `file-writable-p' for Tramp files."
3265 (with-parsed-tramp-file-name filename nil
3266 (with-file-property v localname "file-writable-p"
3267 (if (file-exists-p filename)
3268 ;; Examine `file-attributes' cache to see if request can be
3269 ;; satisfied without remote operation.
3270 (or (tramp-check-cached-permissions v ?w)
3271 (zerop (tramp-run-test "-w" filename)))
3272 ;; If file doesn't exist, check if directory is writable.
3273 (and (zerop (tramp-run-test
3274 "-d" (file-name-directory filename)))
3275 (zerop (tramp-run-test
3276 "-w" (file-name-directory filename))))))))
3277
3278 (defun tramp-handle-file-ownership-preserved-p (filename)
3279 "Like `file-ownership-preserved-p' for Tramp files."
3280 (with-parsed-tramp-file-name filename nil
3281 (with-file-property v localname "file-ownership-preserved-p"
3282 (let ((attributes (file-attributes filename)))
3283 ;; Return t if the file doesn't exist, since it's true that no
3284 ;; information would be lost by an (attempted) delete and create.
3285 (or (null attributes)
3286 (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
3287
3288 ;; Other file name ops.
3289
3290 (defun tramp-handle-directory-file-name (directory)
3291 "Like `directory-file-name' for Tramp files."
3292 ;; If localname component of filename is "/", leave it unchanged.
3293 ;; Otherwise, remove any trailing slash from localname component.
3294 ;; Method, host, etc, are unchanged. Does it make sense to try
3295 ;; to avoid parsing the filename?
3296 (with-parsed-tramp-file-name directory nil
3297 (if (and (not (zerop (length localname)))
3298 (eq (aref localname (1- (length localname))) ?/)
3299 (not (string= localname "/")))
3300 (substring directory 0 -1)
3301 directory)))
3302
3303 ;; Directory listings.
3304
3305 (defun tramp-handle-directory-files
3306 (directory &optional full match nosort files-only)
3307 "Like `directory-files' for Tramp files."
3308 ;; FILES-ONLY is valid for XEmacs only.
3309 (when (file-directory-p directory)
3310 (setq directory (file-name-as-directory (expand-file-name directory)))
3311 (let ((temp (nreverse (file-name-all-completions "" directory)))
3312 result item)
3313
3314 (while temp
3315 (setq item (directory-file-name (pop temp)))
3316 (when (and (or (null match) (string-match match item))
3317 (or (null files-only)
3318 ;; Files only.
3319 (and (equal files-only t) (file-regular-p item))
3320 ;; Directories only.
3321 (file-directory-p item)))
3322 (push (if full (concat directory item) item)
3323 result)))
3324 (if nosort result (sort result 'string<)))))
3325
3326 (defun tramp-handle-directory-files-and-attributes
3327 (directory &optional full match nosort id-format)
3328 "Like `directory-files-and-attributes' for Tramp files."
3329 (unless id-format (setq id-format 'integer))
3330 (when (file-directory-p directory)
3331 (setq directory (expand-file-name directory))
3332 (let* ((temp
3333 (copy-tree
3334 (with-parsed-tramp-file-name directory nil
3335 (with-file-property
3336 v localname
3337 (format "directory-files-and-attributes-%s" id-format)
3338 (save-excursion
3339 (mapcar
3340 (lambda (x)
3341 (cons (car x)
3342 (tramp-convert-file-attributes v (cdr x))))
3343 (cond
3344 ((tramp-get-remote-stat v)
3345 (tramp-do-directory-files-and-attributes-with-stat
3346 v localname id-format))
3347 ((tramp-get-remote-perl v)
3348 (tramp-do-directory-files-and-attributes-with-perl
3349 v localname id-format)))))))))
3350 result item)
3351
3352 (while temp
3353 (setq item (pop temp))
3354 (when (or (null match) (string-match match (car item)))
3355 (when full
3356 (setcar item (expand-file-name (car item) directory)))
3357 (push item result)))
3358
3359 (if nosort
3360 result
3361 (sort result (lambda (x y) (string< (car x) (car y))))))))
3362
3363 (defun tramp-do-directory-files-and-attributes-with-perl
3364 (vec localname &optional id-format)
3365 "Implement `directory-files-and-attributes' for Tramp files using a Perl script."
3366 (tramp-message vec 5 "directory-files-and-attributes with perl: %s" localname)
3367 (tramp-maybe-send-script
3368 vec tramp-perl-directory-files-and-attributes
3369 "tramp_perl_directory_files_and_attributes")
3370 (let ((object
3371 (tramp-send-command-and-read
3372 vec
3373 (format "tramp_perl_directory_files_and_attributes %s %s"
3374 (tramp-shell-quote-argument localname) id-format))))
3375 (when (stringp object) (tramp-error vec 'file-error object))
3376 object))
3377
3378 (defun tramp-do-directory-files-and-attributes-with-stat
3379 (vec localname &optional id-format)
3380 "Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
3381 (tramp-message vec 5 "directory-files-and-attributes with stat: %s" localname)
3382 (tramp-send-command-and-read
3383 vec
3384 (format
3385 (concat
3386 ;; We must care about filenames with spaces, or starting with
3387 ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
3388 ;; but it does not work on all remote systems. Therefore, we
3389 ;; quote the filenames via sed.
3390 "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs "
3391 "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'); "
3392 "echo \")\"")
3393 (tramp-shell-quote-argument localname)
3394 (tramp-get-ls-command vec)
3395 (tramp-get-remote-stat vec)
3396 (if (eq id-format 'integer) "%u" "\"%U\"")
3397 (if (eq id-format 'integer) "%g" "\"%G\""))))
3398
3399 ;; This function should return "foo/" for directories and "bar" for
3400 ;; files.
3401 (defun tramp-handle-file-name-all-completions (filename directory)
3402 "Like `file-name-all-completions' for Tramp files."
3403 (unless (save-match-data (string-match "/" filename))
3404 (with-parsed-tramp-file-name (expand-file-name directory) nil
3405
3406 (all-completions
3407 filename
3408 (mapcar
3409 'list
3410 (or
3411 ;; Try cache first
3412 (and
3413 ;; Ignore if expired
3414 (or (not (integerp tramp-completion-reread-directory-timeout))
3415 (<= (tramp-time-diff
3416 (current-time)
3417 (tramp-get-file-property
3418 v localname "last-completion" '(0 0 0)))
3419 tramp-completion-reread-directory-timeout))
3420
3421 ;; Try cache entries for filename, filename with last
3422 ;; character removed, filename with last two characters
3423 ;; removed, ..., and finally the empty string - all
3424 ;; concatenated to the local directory name
3425
3426 ;; This is inefficient for very long filenames, pity
3427 ;; `reduce' is not available...
3428 (car
3429 (apply
3430 'append
3431 (mapcar
3432 (lambda (x)
3433 (let ((cache-hit
3434 (tramp-get-file-property
3435 v
3436 (concat localname (substring filename 0 x))
3437 "file-name-all-completions"
3438 nil)))
3439 (when cache-hit (list cache-hit))))
3440 (tramp-compat-number-sequence (length filename) 0 -1)))))
3441
3442 ;; Cache expired or no matching cache entry found so we need
3443 ;; to perform a remote operation
3444 (let (result)
3445 ;; Get a list of directories and files, including reliably
3446 ;; tagging the directories with a trailing '/'. Because I
3447 ;; rock. --daniel@danann.net
3448
3449 ;; Changed to perform `cd' in the same remote op and only
3450 ;; get entries starting with `filename'. Capture any `cd'
3451 ;; error messages. Ensure any `cd' and `echo' aliases are
3452 ;; ignored.
3453 (tramp-send-command
3454 v
3455 (if (tramp-get-remote-perl v)
3456 (progn
3457 (tramp-maybe-send-script
3458 v tramp-perl-file-name-all-completions
3459 "tramp_perl_file_name_all_completions")
3460 (format "tramp_perl_file_name_all_completions %s %s %d"
3461 (tramp-shell-quote-argument localname)
3462 (tramp-shell-quote-argument filename)
3463 (if (symbol-value
3464 ;; `read-file-name-completion-ignore-case'
3465 ;; is introduced with Emacs 22.1.
3466 (if (boundp
3467 'read-file-name-completion-ignore-case)
3468 'read-file-name-completion-ignore-case
3469 'completion-ignore-case))
3470 1 0)))
3471
3472 (format (concat
3473 "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
3474 ;; `ls' with wildcard might fail with `Argument
3475 ;; list too long' error in some corner cases; if
3476 ;; `ls' fails after `cd' succeeded, chances are
3477 ;; that's the case, so let's retry without
3478 ;; wildcard. This will return "too many" entries
3479 ;; but that isn't harmful.
3480 " || %s -a 2>/dev/null)"
3481 " | while read f; do"
3482 " if %s -d \"$f\" 2>/dev/null;"
3483 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
3484 " && \\echo ok) || \\echo fail")
3485 (tramp-shell-quote-argument localname)
3486 (tramp-get-ls-command v)
3487 ;; When `filename' is empty, just `ls' without
3488 ;; filename argument is more efficient than `ls *'
3489 ;; for very large directories and might avoid the
3490 ;; `Argument list too long' error.
3491 ;;
3492 ;; With and only with wildcard, we need to add
3493 ;; `-d' to prevent `ls' from descending into
3494 ;; sub-directories.
3495 (if (zerop (length filename))
3496 "."
3497 (concat (tramp-shell-quote-argument filename) "* -d"))
3498 (tramp-get-ls-command v)
3499 (tramp-get-test-command v))))
3500
3501 ;; Now grab the output.
3502 (with-current-buffer (tramp-get-buffer v)
3503 (goto-char (point-max))
3504
3505 ;; Check result code, found in last line of output
3506 (forward-line -1)
3507 (if (looking-at "^fail$")
3508 (progn
3509 ;; Grab error message from line before last line
3510 ;; (it was put there by `cd 2>&1')
3511 (forward-line -1)
3512 (tramp-error
3513 v 'file-error
3514 "tramp-handle-file-name-all-completions: %s"
3515 (buffer-substring
3516 (point) (tramp-compat-line-end-position))))
3517 ;; For peace of mind, if buffer doesn't end in `fail'
3518 ;; then it should end in `ok'. If neither are in the
3519 ;; buffer something went seriously wrong on the remote
3520 ;; side.
3521 (unless (looking-at "^ok$")
3522 (tramp-error
3523 v 'file-error
3524 "\
3525 tramp-handle-file-name-all-completions: internal error accessing `%s': `%s'"
3526 (tramp-shell-quote-argument localname) (buffer-string))))
3527
3528 (while (zerop (forward-line -1))
3529 (push (buffer-substring
3530 (point) (tramp-compat-line-end-position))
3531 result)))
3532
3533 ;; Because the remote op went through OK we know the
3534 ;; directory we `cd'-ed to exists
3535 (tramp-set-file-property
3536 v localname "file-exists-p" t)
3537
3538 ;; Because the remote op went through OK we know every
3539 ;; file listed by `ls' exists.
3540 (mapc (lambda (entry)
3541 (tramp-set-file-property
3542 v (concat localname entry) "file-exists-p" t))
3543 result)
3544
3545 (tramp-set-file-property
3546 v localname "last-completion" (current-time))
3547
3548 ;; Store result in the cache
3549 (tramp-set-file-property
3550 v (concat localname filename)
3551 "file-name-all-completions"
3552 result))))))))
3553
3554 (defun tramp-handle-file-name-completion
3555 (filename directory &optional predicate)
3556 "Like `file-name-completion' for Tramp files."
3557 (unless (tramp-tramp-file-p directory)
3558 (error
3559 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
3560 directory))
3561 (try-completion
3562 filename
3563 (mapcar 'list (file-name-all-completions filename directory))
3564 (when predicate
3565 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
3566
3567 ;; cp, mv and ln
3568
3569 (defun tramp-handle-add-name-to-file
3570 (filename newname &optional ok-if-already-exists)
3571 "Like `add-name-to-file' for Tramp files."
3572 (unless (tramp-equal-remote filename newname)
3573 (with-parsed-tramp-file-name
3574 (if (tramp-tramp-file-p filename) filename newname) nil
3575 (tramp-error
3576 v 'file-error
3577 "add-name-to-file: %s"
3578 "only implemented for same method, same user, same host")))
3579 (with-parsed-tramp-file-name filename v1
3580 (with-parsed-tramp-file-name newname v2
3581 (let ((ln (when v1 (tramp-get-remote-ln v1))))
3582 (when (and (not ok-if-already-exists)
3583 (file-exists-p newname)
3584 (not (numberp ok-if-already-exists))
3585 (y-or-n-p
3586 (format
3587 "File %s already exists; make it a new name anyway? "
3588 newname)))
3589 (tramp-error
3590 v2 'file-error
3591 "add-name-to-file: file %s already exists" newname))
3592 (tramp-flush-file-property v2 (file-name-directory v2-localname))
3593 (tramp-flush-file-property v2 v2-localname)
3594 (tramp-barf-unless-okay
3595 v1
3596 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
3597 (tramp-shell-quote-argument v2-localname))
3598 "error with add-name-to-file, see buffer `%s' for details"
3599 (buffer-name))))))
3600
3601 (defun tramp-handle-copy-file
3602 (filename newname &optional ok-if-already-exists keep-date
3603 preserve-uid-gid preserve-selinux-context)
3604 "Like `copy-file' for Tramp files."
3605 (setq filename (expand-file-name filename))
3606 (setq newname (expand-file-name newname))
3607 (cond
3608 ;; At least one file a Tramp file?
3609 ((or (tramp-tramp-file-p filename)
3610 (tramp-tramp-file-p newname))
3611 (tramp-do-copy-or-rename-file
3612 'copy filename newname ok-if-already-exists keep-date
3613 preserve-uid-gid preserve-selinux-context))
3614 ;; Compat section.
3615 (preserve-selinux-context
3616 (tramp-run-real-handler
3617 'copy-file
3618 (list filename newname ok-if-already-exists keep-date
3619 preserve-uid-gid preserve-selinux-context)))
3620 (preserve-uid-gid
3621 (tramp-run-real-handler
3622 'copy-file
3623 (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
3624 (t
3625 (tramp-run-real-handler
3626 'copy-file (list filename newname ok-if-already-exists keep-date)))))
3627
3628 (defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
3629 "Like `copy-directory' for Tramp files."
3630 (let ((t1 (tramp-tramp-file-p dirname))
3631 (t2 (tramp-tramp-file-p newname)))
3632 (with-parsed-tramp-file-name (if t1 dirname newname) nil
3633 (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
3634 ;; When DIRNAME and NEWNAME are remote, they must have
3635 ;; the same method.
3636 (or (null t1) (null t2)
3637 (string-equal
3638 (tramp-file-name-method (tramp-dissect-file-name dirname))
3639 (tramp-file-name-method (tramp-dissect-file-name newname)))))
3640 ;; scp or rsync DTRT.
3641 (progn
3642 (setq dirname (directory-file-name (expand-file-name dirname))
3643 newname (directory-file-name (expand-file-name newname)))
3644 (if (and (file-directory-p newname)
3645 (not (string-equal (file-name-nondirectory dirname)
3646 (file-name-nondirectory newname))))
3647 (setq newname
3648 (expand-file-name
3649 (file-name-nondirectory dirname) newname)))
3650 (if (not (file-directory-p (file-name-directory newname)))
3651 (make-directory (file-name-directory newname) parents))
3652 (tramp-do-copy-or-rename-file-out-of-band
3653 'copy dirname newname keep-date))
3654 ;; We must do it file-wise.
3655 (tramp-run-real-handler
3656 'copy-directory (list dirname newname keep-date parents)))
3657
3658 ;; When newname did exist, we have wrong cached values.
3659 (when t2
3660 (with-parsed-tramp-file-name newname nil
3661 (tramp-flush-file-property v (file-name-directory localname))
3662 (tramp-flush-file-property v localname))))))
3663
3664 (defun tramp-handle-rename-file
3665 (filename newname &optional ok-if-already-exists)
3666 "Like `rename-file' for Tramp files."
3667 ;; Check if both files are local -- invoke normal rename-file.
3668 ;; Otherwise, use Tramp from local system.
3669 (setq filename (expand-file-name filename))
3670 (setq newname (expand-file-name newname))
3671 ;; At least one file a Tramp file?
3672 (if (or (tramp-tramp-file-p filename)
3673 (tramp-tramp-file-p newname))
3674 (tramp-do-copy-or-rename-file
3675 'rename filename newname ok-if-already-exists t t)
3676 (tramp-run-real-handler
3677 'rename-file (list filename newname ok-if-already-exists))))
3678
3679 (defun tramp-do-copy-or-rename-file
3680 (op filename newname &optional ok-if-already-exists keep-date
3681 preserve-uid-gid preserve-selinux-context)
3682 "Copy or rename a remote file.
3683 OP must be `copy' or `rename' and indicates the operation to perform.
3684 FILENAME specifies the file to copy or rename, NEWNAME is the name of
3685 the new file (for copy) or the new name of the file (for rename).
3686 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
3687 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3688 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3689 the uid and gid if both files are on the same host.
3690 PRESERVE-SELINUX-CONTEXT activates selinux commands.
3691
3692 This function is invoked by `tramp-handle-copy-file' and
3693 `tramp-handle-rename-file'. It is an error if OP is neither of `copy'
3694 and `rename'. FILENAME and NEWNAME must be absolute file names."
3695 (unless (memq op '(copy rename))
3696 (error "Unknown operation `%s', must be `copy' or `rename'" op))
3697 (let ((t1 (tramp-tramp-file-p filename))
3698 (t2 (tramp-tramp-file-p newname))
3699 (context (and preserve-selinux-context
3700 (apply 'file-selinux-context (list filename))))
3701 pr tm)
3702
3703 (with-parsed-tramp-file-name (if t1 filename newname) nil
3704 (when (and (not ok-if-already-exists) (file-exists-p newname))
3705 (tramp-error
3706 v 'file-already-exists "File %s already exists" newname))
3707
3708 (with-progress-reporter
3709 v 0 (format "%s %s to %s"
3710 (if (eq op 'copy) "Copying" "Renaming")
3711 filename newname)
3712
3713 (cond
3714 ;; Both are Tramp files.
3715 ((and t1 t2)
3716 (with-parsed-tramp-file-name filename v1
3717 (with-parsed-tramp-file-name newname v2
3718 (cond
3719 ;; Shortcut: if method, host, user are the same for
3720 ;; both files, we invoke `cp' or `mv' on the remote
3721 ;; host directly.
3722 ((tramp-equal-remote filename newname)
3723 (tramp-do-copy-or-rename-file-directly
3724 op filename newname
3725 ok-if-already-exists keep-date preserve-uid-gid))
3726
3727 ;; Try out-of-band operation.
3728 ((tramp-method-out-of-band-p
3729 v1 (nth 7 (file-attributes filename)))
3730 (tramp-do-copy-or-rename-file-out-of-band
3731 op filename newname keep-date))
3732
3733 ;; No shortcut was possible. So we copy the file
3734 ;; first. If the operation was `rename', we go back
3735 ;; and delete the original file (if the copy was
3736 ;; successful). The approach is simple-minded: we
3737 ;; create a new buffer, insert the contents of the
3738 ;; source file into it, then write out the buffer to
3739 ;; the target file. The advantage is that it doesn't
3740 ;; matter which filename handlers are used for the
3741 ;; source and target file.
3742 (t
3743 (tramp-do-copy-or-rename-file-via-buffer
3744 op filename newname keep-date))))))
3745
3746 ;; One file is a Tramp file, the other one is local.
3747 ((or t1 t2)
3748 (cond
3749 ;; Fast track on local machine.
3750 ((tramp-local-host-p v)
3751 (tramp-do-copy-or-rename-file-directly
3752 op filename newname
3753 ok-if-already-exists keep-date preserve-uid-gid))
3754
3755 ;; If the Tramp file has an out-of-band method, the
3756 ;; corresponding copy-program can be invoked.
3757 ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
3758 (tramp-do-copy-or-rename-file-out-of-band
3759 op filename newname keep-date))
3760
3761 ;; Use the inline method via a Tramp buffer.
3762 (t (tramp-do-copy-or-rename-file-via-buffer
3763 op filename newname keep-date))))
3764
3765 (t
3766 ;; One of them must be a Tramp file.
3767 (error "Tramp implementation says this cannot happen")))
3768
3769 ;; Handle `preserve-selinux-context'.
3770 (when context (apply 'set-file-selinux-context (list newname context)))
3771
3772 ;; In case of `rename', we must flush the cache of the source file.
3773 (when (and t1 (eq op 'rename))
3774 (with-parsed-tramp-file-name filename v1
3775 (tramp-flush-file-property v1 (file-name-directory localname))
3776 (tramp-flush-file-property v1 localname)))
3777
3778 ;; When newname did exist, we have wrong cached values.
3779 (when t2
3780 (with-parsed-tramp-file-name newname v2
3781 (tramp-flush-file-property v2 (file-name-directory localname))
3782 (tramp-flush-file-property v2 localname)))))))
3783
3784 (defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
3785 "Use an Emacs buffer to copy or rename a file.
3786 First arg OP is either `copy' or `rename' and indicates the operation.
3787 FILENAME is the source file, NEWNAME the target file.
3788 KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
3789 (with-temp-buffer
3790 ;; We must disable multibyte, because binary data shall not be
3791 ;; converted.
3792 (set-buffer-multibyte nil)
3793 (let ((coding-system-for-read 'binary)
3794 (jka-compr-inhibit t))
3795 (insert-file-contents-literally filename))
3796 ;; We don't want the target file to be compressed, so we let-bind
3797 ;; `jka-compr-inhibit' to t.
3798 (let ((coding-system-for-write 'binary)
3799 (jka-compr-inhibit t))
3800 (write-region (point-min) (point-max) newname)))
3801 ;; KEEP-DATE handling.
3802 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
3803 ;; Set the mode.
3804 (set-file-modes newname (tramp-default-file-modes filename))
3805 ;; If the operation was `rename', delete the original file.
3806 (unless (eq op 'copy) (delete-file filename)))
3807
3808 (defun tramp-do-copy-or-rename-file-directly
3809 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
3810 "Invokes `cp' or `mv' on the remote system.
3811 OP must be one of `copy' or `rename', indicating `cp' or `mv',
3812 respectively. FILENAME specifies the file to copy or rename,
3813 NEWNAME is the name of the new file (for copy) or the new name of
3814 the file (for rename). Both files must reside on the same host.
3815 KEEP-DATE means to make sure that NEWNAME has the same timestamp
3816 as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
3817 the uid and gid from FILENAME."
3818 (let ((t1 (tramp-tramp-file-p filename))
3819 (t2 (tramp-tramp-file-p newname))
3820 (file-times (nth 5 (file-attributes filename)))
3821 (file-modes (tramp-default-file-modes filename)))
3822 (with-parsed-tramp-file-name (if t1 filename newname) nil
3823 (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
3824 ((eq op 'copy) "cp -f")
3825 ((eq op 'rename) "mv -f")
3826 (t (tramp-error
3827 v 'file-error
3828 "Unknown operation `%s', must be `copy' or `rename'"
3829 op))))
3830 (localname1
3831 (if t1
3832 (tramp-file-name-handler 'file-remote-p filename 'localname)
3833 filename))
3834 (localname2
3835 (if t2
3836 (tramp-file-name-handler 'file-remote-p newname 'localname)
3837 newname))
3838 (prefix (file-remote-p (if t1 filename newname)))
3839 cmd-result)
3840
3841 (cond
3842 ;; Both files are on a remote host, with same user.
3843 ((and t1 t2)
3844 (setq cmd-result
3845 (tramp-send-command-and-check
3846 v
3847 (format "%s %s %s" cmd
3848 (tramp-shell-quote-argument localname1)
3849 (tramp-shell-quote-argument localname2))))
3850 (with-current-buffer (tramp-get-buffer v)
3851 (goto-char (point-min))
3852 (unless
3853 (or
3854 (and keep-date
3855 ;; Mask cp -f error.
3856 (re-search-forward
3857 tramp-operation-not-permitted-regexp nil t))
3858 (zerop cmd-result))
3859 (tramp-error-with-buffer
3860 nil v 'file-error
3861 "Copying directly failed, see buffer `%s' for details."
3862 (buffer-name)))))
3863
3864 ;; We are on the local host.
3865 ((or t1 t2)
3866 (cond
3867 ;; We can do it directly.
3868 ((let (file-name-handler-alist)
3869 (and (file-readable-p localname1)
3870 (file-writable-p (file-name-directory localname2))
3871 (or (file-directory-p localname2)
3872 (file-writable-p localname2))))
3873 (if (eq op 'copy)
3874 (tramp-compat-copy-file
3875 localname1 localname2 ok-if-already-exists
3876 keep-date preserve-uid-gid)
3877 (tramp-run-real-handler
3878 'rename-file (list localname1 localname2 ok-if-already-exists))))
3879
3880 ;; We can do it directly with `tramp-send-command'
3881 ((and (file-readable-p (concat prefix localname1))
3882 (file-writable-p
3883 (file-name-directory (concat prefix localname2)))
3884 (or (file-directory-p (concat prefix localname2))
3885 (file-writable-p (concat prefix localname2))))
3886 (tramp-do-copy-or-rename-file-directly
3887 op (concat prefix localname1) (concat prefix localname2)
3888 ok-if-already-exists keep-date t)
3889 ;; We must change the ownership to the local user.
3890 (tramp-set-file-uid-gid
3891 (concat prefix localname2)
3892 (tramp-get-local-uid 'integer)
3893 (tramp-get-local-gid 'integer)))
3894
3895 ;; We need a temporary file in between.
3896 (t
3897 ;; Create the temporary file.
3898 (let ((tmpfile (tramp-compat-make-temp-file localname1)))
3899 (unwind-protect
3900 (progn
3901 (cond
3902 (t1
3903 (or
3904 (zerop
3905 (tramp-send-command-and-check
3906 v (format
3907 "%s %s %s" cmd
3908 (tramp-shell-quote-argument localname1)
3909 (tramp-shell-quote-argument tmpfile))))
3910 (tramp-error-with-buffer
3911 nil v 'file-error
3912 "Copying directly failed, see buffer `%s' for details."
3913 (tramp-get-buffer v)))
3914 ;; We must change the ownership as remote user.
3915 ;; Since this does not work reliable, we also
3916 ;; give read permissions.
3917 (set-file-modes
3918 (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
3919 (tramp-set-file-uid-gid
3920 (concat prefix tmpfile)
3921 (tramp-get-local-uid 'integer)
3922 (tramp-get-local-gid 'integer)))
3923 (t2
3924 (if (eq op 'copy)
3925 (tramp-compat-copy-file
3926 localname1 tmpfile t
3927 keep-date preserve-uid-gid)
3928 (tramp-run-real-handler
3929 'rename-file
3930 (list localname1 tmpfile t)))
3931 ;; We must change the ownership as local user.
3932 ;; Since this does not work reliable, we also
3933 ;; give read permissions.
3934 (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
3935 (tramp-set-file-uid-gid
3936 tmpfile
3937 (tramp-get-remote-uid v 'integer)
3938 (tramp-get-remote-gid v 'integer))))
3939
3940 ;; Move the temporary file to its destination.
3941 (cond
3942 (t2
3943 (or
3944 (zerop
3945 (tramp-send-command-and-check
3946 v (format
3947 "cp -f -p %s %s"
3948 (tramp-shell-quote-argument tmpfile)
3949 (tramp-shell-quote-argument localname2))))
3950 (tramp-error-with-buffer
3951 nil v 'file-error
3952 "Copying directly failed, see buffer `%s' for details."
3953 (tramp-get-buffer v))))
3954 (t1
3955 (tramp-run-real-handler
3956 'rename-file
3957 (list tmpfile localname2 ok-if-already-exists)))))
3958
3959 ;; Save exit.
3960 (condition-case nil
3961 (delete-file tmpfile)
3962 (error)))))))))
3963
3964 ;; Set the time and mode. Mask possible errors.
3965 (condition-case nil
3966 (when keep-date
3967 (set-file-times newname file-times)
3968 (set-file-modes newname file-modes))
3969 (error)))))
3970
3971 (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
3972 "Invoke rcp program to copy.
3973 The method used must be an out-of-band method."
3974 (let ((t1 (tramp-tramp-file-p filename))
3975 (t2 (tramp-tramp-file-p newname))
3976 copy-program copy-args copy-env copy-keep-date port spec
3977 source target)
3978
3979 (with-parsed-tramp-file-name (if t1 filename newname) nil
3980 (if (and t1 t2)
3981
3982 ;; Both are Tramp files. We shall optimize it, when the
3983 ;; methods for filename and newname are the same.
3984 (let* ((dir-flag (file-directory-p filename))
3985 (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
3986 (if dir-flag
3987 (setq tmpfile
3988 (expand-file-name
3989 (file-name-nondirectory newname) tmpfile)))
3990 (unwind-protect
3991 (progn
3992 (tramp-do-copy-or-rename-file-out-of-band
3993 op filename tmpfile keep-date)
3994 (tramp-do-copy-or-rename-file-out-of-band
3995 'rename tmpfile newname keep-date))
3996 ;; Save exit.
3997 (condition-case nil
3998 (if dir-flag
3999 (tramp-compat-delete-directory
4000 (expand-file-name ".." tmpfile) 'recursive)
4001 (delete-file tmpfile))
4002 (error))))
4003
4004 ;; Expand hops. Might be necessary for gateway methods.
4005 (setq v (car (tramp-compute-multi-hops v)))
4006 (aset v 3 localname)
4007
4008 ;; Check which ones of source and target are Tramp files.
4009 (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
4010 target (funcall
4011 (if (and (file-directory-p filename)
4012 (string-equal
4013 (file-name-nondirectory filename)
4014 (file-name-nondirectory newname)))
4015 'file-name-directory
4016 'identity)
4017 (if t2 (tramp-make-copy-program-file-name v) newname)))
4018
4019 ;; Check for port number. Until now, there's no need for handling
4020 ;; like method, user, host.
4021 (setq host (tramp-file-name-real-host v)
4022 port (tramp-file-name-port v)
4023 port (or (and port (number-to-string port)) ""))
4024
4025 ;; Compose copy command.
4026 (setq spec (format-spec-make
4027 ?h host ?u user ?p port
4028 ?t (tramp-get-connection-property
4029 (tramp-get-connection-process v) "temp-file" "")
4030 ?k (if keep-date " " ""))
4031 copy-program (tramp-get-method-parameter
4032 method 'tramp-copy-program)
4033 copy-keep-date (tramp-get-method-parameter
4034 method 'tramp-copy-keep-date)
4035 copy-args
4036 (delq
4037 nil
4038 (mapcar
4039 (lambda (x)
4040 (setq
4041 x
4042 ;; " " is indication for keep-date argument.
4043 (delete " " (mapcar (lambda (y) (format-spec y spec)) x)))
4044 (unless (member "" x) (mapconcat 'identity x " ")))
4045 (tramp-get-method-parameter method 'tramp-copy-args)))
4046 copy-env
4047 (delq
4048 nil
4049 (mapcar
4050 (lambda (x)
4051 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
4052 (unless (member "" x) (mapconcat 'identity x " ")))
4053 (tramp-get-method-parameter method 'tramp-copy-env))))
4054
4055 ;; Check for program.
4056 (when (and (fboundp 'executable-find)
4057 (not (let ((default-directory
4058 (tramp-compat-temporary-file-directory)))
4059 (executable-find copy-program))))
4060 (tramp-error
4061 v 'file-error "Cannot find copy program: %s" copy-program))
4062
4063 ;; Set variables for computing the prompt for reading
4064 ;; password.
4065 (setq tramp-current-method (tramp-file-name-method v)
4066 tramp-current-user (tramp-file-name-user v)
4067 tramp-current-host (tramp-file-name-host v))
4068
4069 (unwind-protect
4070 (with-temp-buffer
4071 ;; The default directory must be remote.
4072 (let ((default-directory
4073 (file-name-directory (if t1 filename newname)))
4074 (process-environment (copy-sequence process-environment)))
4075 ;; Set the transfer process properties.
4076 (tramp-set-connection-property
4077 v "process-name" (buffer-name (current-buffer)))
4078 (tramp-set-connection-property
4079 v "process-buffer" (current-buffer))
4080 (while copy-env
4081 (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
4082 (setenv (pop copy-env) (pop copy-env)))
4083
4084 ;; Use an asynchronous process. By this, password can
4085 ;; be handled. The default directory must be local, in
4086 ;; order to apply the correct `copy-program'. We don't
4087 ;; set a timeout, because the copying of large files can
4088 ;; last longer than 60 secs.
4089 (let ((p (let ((default-directory
4090 (tramp-compat-temporary-file-directory)))
4091 (apply 'start-process
4092 (tramp-get-connection-property
4093 v "process-name" nil)
4094 (tramp-get-connection-property
4095 v "process-buffer" nil)
4096 copy-program
4097 (append copy-args (list source target))))))
4098 (tramp-message
4099 v 6 "%s" (mapconcat 'identity (process-command p) " "))
4100 (tramp-set-process-query-on-exit-flag p nil)
4101 (tramp-process-actions
4102 p v nil tramp-actions-copy-out-of-band))))
4103
4104 ;; Reset the transfer process properties.
4105 (tramp-set-connection-property v "process-name" nil)
4106 (tramp-set-connection-property v "process-buffer" nil))
4107
4108 ;; Handle KEEP-DATE argument.
4109 (when (and keep-date (not copy-keep-date))
4110 (set-file-times newname (nth 5 (file-attributes filename))))
4111
4112 ;; Set the mode.
4113 (unless (and keep-date copy-keep-date)
4114 (ignore-errors
4115 (set-file-modes newname (tramp-default-file-modes filename)))))
4116
4117 ;; If the operation was `rename', delete the original file.
4118 (unless (eq op 'copy)
4119 (if (file-regular-p filename)
4120 (delete-file filename)
4121 (tramp-compat-delete-directory filename 'recursive))))))
4122
4123 (defun tramp-handle-make-directory (dir &optional parents)
4124 "Like `make-directory' for Tramp files."
4125 (setq dir (expand-file-name dir))
4126 (with-parsed-tramp-file-name dir nil
4127 (tramp-flush-directory-property v (file-name-directory localname))
4128 (save-excursion
4129 (tramp-barf-unless-okay
4130 v
4131 (format "%s %s"
4132 (if parents "mkdir -p" "mkdir")
4133 (tramp-shell-quote-argument localname))
4134 "Couldn't make directory %s" dir))))
4135
4136 (defun tramp-handle-delete-directory (directory &optional recursive)
4137 "Like `delete-directory' for Tramp files."
4138 (setq directory (expand-file-name directory))
4139 (with-parsed-tramp-file-name directory nil
4140 (tramp-flush-file-property v (file-name-directory localname))
4141 (tramp-flush-directory-property v localname)
4142 (unless (zerop (tramp-send-command-and-check
4143 v
4144 (format
4145 "%s %s"
4146 (if recursive "rm -rf" "rmdir")
4147 (tramp-shell-quote-argument localname))))
4148 (tramp-error v 'file-error "Couldn't delete %s" directory))))
4149
4150 (defun tramp-handle-delete-file (filename &optional trash)
4151 "Like `delete-file' for Tramp files."
4152 (setq filename (expand-file-name filename))
4153 (with-parsed-tramp-file-name filename nil
4154 (tramp-flush-file-property v (file-name-directory localname))
4155 (tramp-flush-file-property v localname)
4156 (unless
4157 (zerop
4158 (tramp-send-command-and-check
4159 v (format "%s %s"
4160 (or (and trash (tramp-get-remote-trash v)) "rm -f")
4161 (tramp-shell-quote-argument localname))))
4162 (tramp-error v 'file-error "Couldn't delete %s" filename))))
4163
4164 ;; Dired.
4165
4166 ;; CCC: This does not seem to be enough. Something dies when
4167 ;; we try and delete two directories under Tramp :/
4168 (defun tramp-handle-dired-recursive-delete-directory (filename)
4169 "Recursively delete the directory given.
4170 This is like `dired-recursive-delete-directory' for Tramp files."
4171 (with-parsed-tramp-file-name filename nil
4172 ;; Run a shell command 'rm -r <localname>'
4173 ;; Code shamelessly stolen from the dired implementation and, um, hacked :)
4174 (unless (file-exists-p filename)
4175 (tramp-error v 'file-error "No such directory: %s" filename))
4176 ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
4177 (tramp-send-command
4178 v
4179 (format "rm -rf %s" (tramp-shell-quote-argument localname))
4180 ;; Don't read the output, do it explicitely.
4181 nil t)
4182 ;; Wait for the remote system to return to us...
4183 ;; This might take a while, allow it plenty of time.
4184 (tramp-wait-for-output (tramp-get-connection-process v) 120)
4185 ;; Make sure that it worked...
4186 (tramp-flush-file-property v (file-name-directory localname))
4187 (tramp-flush-directory-property v localname)
4188 (and (file-exists-p filename)
4189 (tramp-error
4190 v 'file-error "Failed to recursively delete %s" filename))))
4191
4192 (defun tramp-handle-dired-compress-file (file &rest ok-flag)
4193 "Like `dired-compress-file' for Tramp files."
4194 ;; OK-FLAG is valid for XEmacs only, but not implemented.
4195 ;; Code stolen mainly from dired-aux.el.
4196 (with-parsed-tramp-file-name file nil
4197 (tramp-flush-file-property v localname)
4198 (save-excursion
4199 (let ((suffixes
4200 (if (not (featurep 'xemacs))
4201 ;; Emacs case
4202 (symbol-value 'dired-compress-file-suffixes)
4203 ;; XEmacs has `dired-compression-method-alist', which is
4204 ;; transformed into `dired-compress-file-suffixes' structure.
4205 (mapcar
4206 (lambda (x)
4207 (list (concat (regexp-quote (nth 1 x)) "\\'")
4208 nil
4209 (mapconcat 'identity (nth 3 x) " ")))
4210 (symbol-value 'dired-compression-method-alist))))
4211 suffix)
4212 ;; See if any suffix rule matches this file name.
4213 (while suffixes
4214 (let (case-fold-search)
4215 (if (string-match (car (car suffixes)) localname)
4216 (setq suffix (car suffixes) suffixes nil))
4217 (setq suffixes (cdr suffixes))))
4218
4219 (cond ((file-symlink-p file)
4220 nil)
4221 ((and suffix (nth 2 suffix))
4222 ;; We found an uncompression rule.
4223 (with-progress-reporter v 0 (format "Uncompressing %s" file)
4224 (when (zerop
4225 (tramp-send-command-and-check
4226 v (concat (nth 2 suffix) " "
4227 (tramp-shell-quote-argument localname))))
4228 ;; `dired-remove-file' is not defined in XEmacs.
4229 (tramp-compat-funcall 'dired-remove-file file)
4230 (string-match (car suffix) file)
4231 (concat (substring file 0 (match-beginning 0))))))
4232 (t
4233 ;; We don't recognize the file as compressed, so compress it.
4234 ;; Try gzip.
4235 (with-progress-reporter v 0 (format "Compressing %s" file)
4236 (when (zerop
4237 (tramp-send-command-and-check
4238 v (concat "gzip -f "
4239 (tramp-shell-quote-argument localname))))
4240 ;; `dired-remove-file' is not defined in XEmacs.
4241 (tramp-compat-funcall 'dired-remove-file file)
4242 (cond ((file-exists-p (concat file ".gz"))
4243 (concat file ".gz"))
4244 ((file-exists-p (concat file ".z"))
4245 (concat file ".z"))
4246 (t nil))))))))))
4247
4248 (defun tramp-handle-dired-uncache (dir &optional dir-p)
4249 "Like `dired-uncache' for Tramp files."
4250 ;; DIR-P is valid for XEmacs only.
4251 (with-parsed-tramp-file-name
4252 (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
4253 (tramp-flush-directory-property v localname)))
4254
4255 ;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
4256 ;; not sure at all that this is the right way to do it, but let's hope
4257 ;; it works for now, and wait for a guru to point out the Right Way to
4258 ;; achieve this.
4259 ;;(eval-when-compile
4260 ;; (unless (fboundp 'dired-insert-set-properties)
4261 ;; (fset 'dired-insert-set-properties 'ignore)))
4262 ;; Gerd suggests this:
4263 (eval-when-compile (require 'dired))
4264 ;; Note that dired is required at run-time, too, when it is needed.
4265 ;; It is only needed on XEmacs for the function
4266 ;; `dired-insert-set-properties'.
4267
4268 (defun tramp-handle-insert-directory
4269 (filename switches &optional wildcard full-directory-p)
4270 "Like `insert-directory' for Tramp files."
4271 (setq filename (expand-file-name filename))
4272 (with-parsed-tramp-file-name filename nil
4273 (if (and (featurep 'ls-lisp)
4274 (not (symbol-value 'ls-lisp-use-insert-directory-program)))
4275 (tramp-run-real-handler
4276 'insert-directory (list filename switches wildcard full-directory-p))
4277 (when (stringp switches)
4278 (setq switches (split-string switches)))
4279 (when (and (member "--dired" switches)
4280 (not (tramp-get-ls-command-with-dired v)))
4281 (setq switches (delete "--dired" switches)))
4282 (when wildcard
4283 (setq wildcard (tramp-run-real-handler
4284 'file-name-nondirectory (list localname)))
4285 (setq localname (tramp-run-real-handler
4286 'file-name-directory (list localname))))
4287 (unless full-directory-p
4288 (setq switches (add-to-list 'switches "-d" 'append)))
4289 (setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
4290 (when wildcard
4291 (setq switches (concat switches " " wildcard)))
4292 (tramp-message
4293 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
4294 switches filename (if wildcard "yes" "no")
4295 (if full-directory-p "yes" "no"))
4296 ;; If `full-directory-p', we just say `ls -l FILENAME'.
4297 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
4298 (if full-directory-p
4299 (tramp-send-command
4300 v
4301 (format "%s %s %s 2>/dev/null"
4302 (tramp-get-ls-command v)
4303 switches
4304 (if wildcard
4305 localname
4306 (tramp-shell-quote-argument (concat localname ".")))))
4307 (tramp-barf-unless-okay
4308 v
4309 (format "cd %s" (tramp-shell-quote-argument
4310 (tramp-run-real-handler
4311 'file-name-directory (list localname))))
4312 "Couldn't `cd %s'"
4313 (tramp-shell-quote-argument
4314 (tramp-run-real-handler 'file-name-directory (list localname))))
4315 (tramp-send-command
4316 v
4317 (format "%s %s %s"
4318 (tramp-get-ls-command v)
4319 switches
4320 (if (or wildcard
4321 (zerop (length
4322 (tramp-run-real-handler
4323 'file-name-nondirectory (list localname)))))
4324 ""
4325 (tramp-shell-quote-argument
4326 (tramp-run-real-handler
4327 'file-name-nondirectory (list localname)))))))
4328 (let ((beg (point)))
4329 ;; We cannot use `insert-buffer-substring' because the Tramp
4330 ;; buffer changes its contents before insertion due to calling
4331 ;; `expand-file' and alike.
4332 (insert
4333 (with-current-buffer (tramp-get-buffer v)
4334 (buffer-string)))
4335
4336 ;; Check for "--dired" output.
4337 (forward-line -2)
4338 (when (looking-at "//SUBDIRED//")
4339 (forward-line -1))
4340 (when (looking-at "//DIRED//\\s-+")
4341 (let ((databeg (match-end 0))
4342 (end (tramp-compat-line-end-position)))
4343 ;; Now read the numeric positions of file names.
4344 (goto-char databeg)
4345 (while (< (point) end)
4346 (let ((start (+ beg (read (current-buffer))))
4347 (end (+ beg (read (current-buffer)))))
4348 (if (memq (char-after end) '(?\n ?\ ))
4349 ;; End is followed by \n or by " -> ".
4350 (put-text-property start end 'dired-filename t))))))
4351 ;; Remove trailing lines.
4352 (goto-char (tramp-compat-line-beginning-position))
4353 (while (looking-at "//")
4354 (forward-line 1)
4355 (delete-region (match-beginning 0) (point)))
4356
4357 ;; The inserted file could be from somewhere else.
4358 (when (and (not wildcard) (not full-directory-p))
4359 (goto-char (point-max))
4360 (when (file-symlink-p filename)
4361 (goto-char (search-backward "->" beg 'noerror)))
4362 (search-backward
4363 (if (zerop (length (file-name-nondirectory filename)))
4364 "."
4365 (file-name-nondirectory filename))
4366 beg 'noerror)
4367 (replace-match (file-relative-name filename) t))
4368
4369 (goto-char (point-max))))))
4370
4371 (defun tramp-handle-unhandled-file-name-directory (filename)
4372 "Like `unhandled-file-name-directory' for Tramp files."
4373 ;; With Emacs 23, we could simply return `nil'. But we must keep it
4374 ;; for backward compatibility.
4375 (expand-file-name "~/"))
4376
4377 ;; Canonicalization of file names.
4378
4379 (defun tramp-handle-expand-file-name (name &optional dir)
4380 "Like `expand-file-name' for Tramp files.
4381 If the localname part of the given filename starts with \"/../\" then
4382 the result will be a local, non-Tramp, filename."
4383 ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
4384 (setq dir (or dir default-directory "/"))
4385 ;; Unless NAME is absolute, concat DIR and NAME.
4386 (unless (file-name-absolute-p name)
4387 (setq name (concat (file-name-as-directory dir) name)))
4388 ;; If NAME is not a Tramp file, run the real handler.
4389 (if (not (tramp-connectable-p name))
4390 (tramp-run-real-handler 'expand-file-name (list name nil))
4391 ;; Dissect NAME.
4392 (with-parsed-tramp-file-name name nil
4393 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
4394 (setq localname (concat "~/" localname)))
4395 ;; Tilde expansion if necessary. This needs a shell which
4396 ;; groks tilde expansion! The function `tramp-find-shell' is
4397 ;; supposed to find such a shell on the remote host. Please
4398 ;; tell me about it when this doesn't work on your system.
4399 (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
4400 (let ((uname (match-string 1 localname))
4401 (fname (match-string 2 localname)))
4402 ;; We cannot simply apply "~/", because under sudo "~/" is
4403 ;; expanded to the local user home directory but to the
4404 ;; root home directory. On the other hand, using always
4405 ;; the default user name for tilde expansion is not
4406 ;; appropriate either, because ssh and companions might
4407 ;; use a user name from the config file.
4408 (when (and (string-equal uname "~")
4409 (string-match "\\`su\\(do\\)?\\'" method))
4410 (setq uname (concat uname user)))
4411 (setq uname
4412 (with-connection-property v uname
4413 (tramp-send-command
4414 v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
4415 (with-current-buffer (tramp-get-buffer v)
4416 (goto-char (point-min))
4417 (buffer-substring
4418 (point) (tramp-compat-line-end-position)))))
4419 (setq localname (concat uname fname))))
4420 ;; There might be a double slash, for example when "~/"
4421 ;; expands to "/". Remove this.
4422 (while (string-match "//" localname)
4423 (setq localname (replace-match "/" t t localname)))
4424 ;; No tilde characters in file name, do normal
4425 ;; `expand-file-name' (this does "/./" and "/../"). We bind
4426 ;; `directory-sep-char' here for XEmacs on Windows, which would
4427 ;; otherwise use backslash. `default-directory' is bound,
4428 ;; because on Windows there would be problems with UNC shares or
4429 ;; Cygwin mounts.
4430 (let ((directory-sep-char ?/)
4431 (default-directory (tramp-compat-temporary-file-directory)))
4432 (tramp-make-tramp-file-name
4433 method user host
4434 (tramp-drop-volume-letter
4435 (tramp-run-real-handler
4436 'expand-file-name (list localname))))))))
4437
4438 (defun tramp-replace-environment-variables (filename)
4439 "Replace environment variables in FILENAME.
4440 Return the string with the replaced variables."
4441 (save-match-data
4442 (let ((idx (string-match "$\\(\\w+\\)" filename)))
4443 ;; `$' is coded as `$$'.
4444 (when (and idx
4445 (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
4446 (getenv (match-string 1 filename)))
4447 (setq filename
4448 (replace-match
4449 (substitute-in-file-name (match-string 0 filename))
4450 t nil filename)))
4451 filename)))
4452
4453 (defun tramp-handle-substitute-in-file-name (filename)
4454 "Like `substitute-in-file-name' for Tramp files.
4455 \"//\" and \"/~\" substitute only in the local filename part.
4456 If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
4457 beginning of local filename are not substituted."
4458 ;; First, we must replace environment variables.
4459 (setq filename (tramp-replace-environment-variables filename))
4460 (with-parsed-tramp-file-name filename nil
4461 (if (equal tramp-syntax 'url)
4462 ;; We need to check localname only. The other parts cannot contain
4463 ;; "//" or "/~".
4464 (if (and (> (length localname) 1)
4465 (or (string-match "//" localname)
4466 (string-match "/~" localname 1)))
4467 (tramp-run-real-handler 'substitute-in-file-name (list filename))
4468 (tramp-make-tramp-file-name
4469 (when method (substitute-in-file-name method))
4470 (when user (substitute-in-file-name user))
4471 (when host (substitute-in-file-name host))
4472 (when localname
4473 (tramp-run-real-handler
4474 'substitute-in-file-name (list localname)))))
4475 ;; Ignore in LOCALNAME everything before "//" or "/~".
4476 (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
4477 (setq filename
4478 (concat (file-remote-p filename)
4479 (replace-match "\\1" nil nil localname)))
4480 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
4481 (when (string-match "~$" filename)
4482 (setq filename (concat filename "/"))))
4483 (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
4484
4485 ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
4486 ;; which calls corresponding functions (see minibuf.el).
4487 (when (fboundp 'minibuffer-electric-separator)
4488 (mapc
4489 (lambda (x)
4490 (eval
4491 `(defadvice ,x
4492 (around ,(intern (format "tramp-advice-%s" x)) activate)
4493 "Invoke `substitute-in-file-name' for Tramp files."
4494 (if (and (symbol-value 'minibuffer-electric-file-name-behavior)
4495 (tramp-tramp-file-p (buffer-substring)))
4496 ;; We don't need to handle `last-input-event', because
4497 ;; due to the key map we know it must be ?/ or ?~.
4498 (let ((s (concat (buffer-substring (point-min) (point))
4499 (string last-command-char))))
4500 (delete-region (point-min) (point))
4501 (insert (substitute-in-file-name s))
4502 (setq ad-return-value last-command-char))
4503 ad-do-it)))
4504 (eval
4505 `(add-hook
4506 'tramp-unload-hook
4507 (lambda ()
4508 (ad-remove-advice ',x 'around ',(intern (format "tramp-advice-%s" x)))
4509 (ad-activate ',x)))))
4510
4511 '(minibuffer-electric-separator
4512 minibuffer-electric-tilde)))
4513
4514
4515 ;;; Remote commands:
4516
4517 (defun tramp-handle-executable-find (command)
4518 "Like `executable-find' for Tramp files."
4519 (with-parsed-tramp-file-name default-directory nil
4520 (tramp-find-executable v command (tramp-get-remote-path v) t)))
4521
4522 (defun tramp-process-sentinel (proc event)
4523 "Flush file caches."
4524 (unless (memq (process-status proc) '(run open))
4525 (let ((vec (tramp-get-connection-property proc "vector" nil)))
4526 (when vec
4527 (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event)
4528 (tramp-flush-directory-property vec "")))))
4529
4530 ;; We use BUFFER also as connection buffer during setup. Because of
4531 ;; this, its original contents must be saved, and restored once
4532 ;; connection has been setup.
4533 (defun tramp-handle-start-file-process (name buffer program &rest args)
4534 "Like `start-file-process' for Tramp files."
4535 (with-parsed-tramp-file-name default-directory nil
4536 ;; When PROGRAM is nil, we just provide a tty.
4537 (let ((command
4538 (when (stringp program)
4539 (format "cd %s; exec %s"
4540 (tramp-shell-quote-argument localname)
4541 (mapconcat 'tramp-shell-quote-argument
4542 (cons program args) " "))))
4543 (tramp-process-connection-type
4544 (or (null program) tramp-process-connection-type))
4545 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
4546 (name1 name)
4547 (i 0))
4548 (unwind-protect
4549 (save-excursion
4550 (save-restriction
4551 (unless buffer
4552 ;; BUFFER can be nil. We use a temporary buffer.
4553 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
4554 (while (get-process name1)
4555 ;; NAME must be unique as process name.
4556 (setq i (1+ i)
4557 name1 (format "%s<%d>" name i)))
4558 (setq name name1)
4559 ;; Set the new process properties.
4560 (tramp-set-connection-property v "process-name" name)
4561 (tramp-set-connection-property v "process-buffer" buffer)
4562 ;; Activate narrowing in order to save BUFFER contents.
4563 ;; Clear also the modification time; otherwise we might
4564 ;; be interrupted by `verify-visited-file-modtime'.
4565 (with-current-buffer (tramp-get-connection-buffer v)
4566 (let ((buffer-undo-list t))
4567 (clear-visited-file-modtime)
4568 (narrow-to-region (point-max) (point-max))
4569 (if command
4570 ;; Send the command.
4571 (tramp-send-command v command nil t) ; nooutput
4572 ;; Check, whether a pty is associated.
4573 (tramp-maybe-open-connection v)
4574 (unless (tramp-compat-process-get
4575 (tramp-get-connection-process v) 'remote-tty)
4576 (tramp-error
4577 v 'file-error
4578 "pty association is not supported for `%s'" name)))))
4579 (let ((p (tramp-get-connection-process v)))
4580 ;; Set sentinel and query flag for this process.
4581 (tramp-set-connection-property p "vector" v)
4582 (set-process-sentinel p 'tramp-process-sentinel)
4583 (tramp-set-process-query-on-exit-flag p t)
4584 ;; Return process.
4585 p)))
4586 ;; Save exit.
4587 (with-current-buffer (tramp-get-connection-buffer v)
4588 (if (string-match tramp-temp-buffer-name (buffer-name))
4589 (progn
4590 (set-process-buffer (tramp-get-connection-process v) nil)
4591 (kill-buffer (current-buffer)))
4592 (set-buffer-modified-p bmp)))
4593 (tramp-set-connection-property v "process-name" nil)
4594 (tramp-set-connection-property v "process-buffer" nil)))))
4595
4596 (defun tramp-handle-process-file
4597 (program &optional infile destination display &rest args)
4598 "Like `process-file' for Tramp files."
4599 ;; The implementation is not complete yet.
4600 (when (and (numberp destination) (zerop destination))
4601 (error "Implementation does not handle immediate return"))
4602
4603 (with-parsed-tramp-file-name default-directory nil
4604 (let (command input tmpinput stderr tmpstderr outbuf ret)
4605 ;; Compute command.
4606 (setq command (mapconcat 'tramp-shell-quote-argument
4607 (cons program args) " "))
4608 ;; Determine input.
4609 (if (null infile)
4610 (setq input "/dev/null")
4611 (setq infile (expand-file-name infile))
4612 (if (tramp-equal-remote default-directory infile)
4613 ;; INFILE is on the same remote host.
4614 (setq input (with-parsed-tramp-file-name infile nil localname))
4615 ;; INFILE must be copied to remote host.
4616 (setq input (tramp-make-tramp-temp-file v)
4617 tmpinput (tramp-make-tramp-file-name method user host input))
4618 (copy-file infile tmpinput t)))
4619 (when input (setq command (format "%s <%s" command input)))
4620
4621 ;; Determine output.
4622 (cond
4623 ;; Just a buffer.
4624 ((bufferp destination)
4625 (setq outbuf destination))
4626 ;; A buffer name.
4627 ((stringp destination)
4628 (setq outbuf (get-buffer-create destination)))
4629 ;; (REAL-DESTINATION ERROR-DESTINATION)
4630 ((consp destination)
4631 ;; output.
4632 (cond
4633 ((bufferp (car destination))
4634 (setq outbuf (car destination)))
4635 ((stringp (car destination))
4636 (setq outbuf (get-buffer-create (car destination))))
4637 ((car destination)
4638 (setq outbuf (current-buffer))))
4639 ;; stderr.
4640 (cond
4641 ((stringp (cadr destination))
4642 (setcar (cdr destination) (expand-file-name (cadr destination)))
4643 (if (tramp-equal-remote default-directory (cadr destination))
4644 ;; stderr is on the same remote host.
4645 (setq stderr (with-parsed-tramp-file-name
4646 (cadr destination) nil localname))
4647 ;; stderr must be copied to remote host. The temporary
4648 ;; file must be deleted after execution.
4649 (setq stderr (tramp-make-tramp-temp-file v)
4650 tmpstderr (tramp-make-tramp-file-name
4651 method user host stderr))))
4652 ;; stderr to be discarded.
4653 ((null (cadr destination))
4654 (setq stderr "/dev/null"))))
4655 ;; 't
4656 (destination
4657 (setq outbuf (current-buffer))))
4658 (when stderr (setq command (format "%s 2>%s" command stderr)))
4659
4660 ;; Send the command. It might not return in time, so we protect
4661 ;; it. Call it in a subshell, in order to preserve working
4662 ;; directory.
4663 (condition-case nil
4664 (unwind-protect
4665 (setq ret
4666 (tramp-send-command-and-check
4667 v (format "\\cd %s; %s"
4668 (tramp-shell-quote-argument localname)
4669 command)
4670 t t))
4671 ;; We should show the output anyway.
4672 (when outbuf
4673 (with-current-buffer outbuf
4674 (insert
4675 (with-current-buffer (tramp-get-connection-buffer v)
4676 (buffer-string))))
4677 (when display (display-buffer outbuf))))
4678 ;; When the user did interrupt, we should do it also. We use
4679 ;; return code -1 as marker.
4680 (quit
4681 (kill-buffer (tramp-get-connection-buffer v))
4682 (setq ret -1))
4683 ;; Handle errors.
4684 (error
4685 (kill-buffer (tramp-get-connection-buffer v))
4686 (setq ret 1)))
4687
4688 ;; Provide error file.
4689 (when tmpstderr (rename-file tmpstderr (cadr destination) t))
4690
4691 ;; Cleanup. We remove all file cache values for the connection,
4692 ;; because the remote process could have changed them.
4693 (when tmpinput (delete-file tmpinput))
4694
4695 ;; `process-file-side-effects' has been introduced with GNU
4696 ;; Emacs 23.2. If set to `nil', no remote file will be changed
4697 ;; by `program'. If it doesn't exist, we assume its default
4698 ;; value 't'.
4699 (unless (and (boundp 'process-file-side-effects)
4700 (not (symbol-value 'process-file-side-effects)))
4701 (tramp-flush-directory-property v ""))
4702
4703 ;; Return exit status.
4704 (if (equal ret -1)
4705 (keyboard-quit)
4706 ret))))
4707
4708 (defun tramp-local-call-process
4709 (program &optional infile destination display &rest args)
4710 "Calls `call-process' on the local host.
4711 This is needed because for some Emacs flavors Tramp has
4712 defadviced `call-process' to behave like `process-file'. The
4713 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
4714 (let ((default-directory
4715 (if (file-remote-p default-directory)
4716 (tramp-compat-temporary-file-directory)
4717 default-directory)))
4718 (if (executable-find program)
4719 (apply 'call-process program infile destination display args)
4720 1)))
4721
4722 (defun tramp-handle-call-process-region
4723 (start end program &optional delete buffer display &rest args)
4724 "Like `call-process-region' for Tramp files."
4725 (let ((tmpfile (tramp-compat-make-temp-file "")))
4726 (write-region start end tmpfile)
4727 (when delete (delete-region start end))
4728 (unwind-protect
4729 (apply 'call-process program tmpfile buffer display args)
4730 (delete-file tmpfile))))
4731
4732 (defun tramp-handle-shell-command
4733 (command &optional output-buffer error-buffer)
4734 "Like `shell-command' for Tramp files."
4735 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
4736 ;; We cannot use `shell-file-name' and `shell-command-switch',
4737 ;; they are variables of the local host.
4738 (args (list
4739 (tramp-get-method-parameter
4740 (tramp-file-name-method
4741 (tramp-dissect-file-name default-directory))
4742 'tramp-remote-sh)
4743 "-c" (substring command 0 asynchronous)))
4744 current-buffer-p
4745 (output-buffer
4746 (cond
4747 ((bufferp output-buffer) output-buffer)
4748 ((stringp output-buffer) (get-buffer-create output-buffer))
4749 (output-buffer
4750 (setq current-buffer-p t)
4751 (current-buffer))
4752 (t (get-buffer-create
4753 (if asynchronous
4754 "*Async Shell Command*"
4755 "*Shell Command Output*")))))
4756 (error-buffer
4757 (cond
4758 ((bufferp error-buffer) error-buffer)
4759 ((stringp error-buffer) (get-buffer-create error-buffer))))
4760 (buffer
4761 (if (and (not asynchronous) error-buffer)
4762 (with-parsed-tramp-file-name default-directory nil
4763 (list output-buffer (tramp-make-tramp-temp-file v)))
4764 output-buffer))
4765 (p (get-buffer-process output-buffer)))
4766
4767 ;; Check whether there is another process running. Tramp does not
4768 ;; support 2 (asynchronous) processes in parallel.
4769 (when p
4770 (if (yes-or-no-p "A command is running. Kill it? ")
4771 (condition-case nil
4772 (kill-process p)
4773 (error nil))
4774 (error "Shell command in progress")))
4775
4776 (if current-buffer-p
4777 (progn
4778 (barf-if-buffer-read-only)
4779 (push-mark nil t))
4780 (with-current-buffer output-buffer
4781 (setq buffer-read-only nil)
4782 (erase-buffer)))
4783
4784 (if (and (not current-buffer-p) (integerp asynchronous))
4785 (prog1
4786 ;; Run the process.
4787 (apply 'start-file-process "*Async Shell*" buffer args)
4788 ;; Display output.
4789 (pop-to-buffer output-buffer)
4790 (setq mode-line-process '(":%s"))
4791 (require 'shell) (shell-mode))
4792
4793 (prog1
4794 ;; Run the process.
4795 (apply 'process-file (car args) nil buffer nil (cdr args))
4796 ;; Insert error messages if they were separated.
4797 (when (listp buffer)
4798 (with-current-buffer error-buffer
4799 (insert-file-contents (cadr buffer)))
4800 (delete-file (cadr buffer)))
4801 (if current-buffer-p
4802 ;; This is like exchange-point-and-mark, but doesn't
4803 ;; activate the mark. It is cleaner to avoid activation,
4804 ;; even though the command loop would deactivate the mark
4805 ;; because we inserted text.
4806 (goto-char (prog1 (mark t)
4807 (set-marker (mark-marker) (point)
4808 (current-buffer))))
4809 ;; There's some output, display it.
4810 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
4811 (if (functionp 'display-message-or-buffer)
4812 (tramp-compat-funcall 'display-message-or-buffer output-buffer)
4813 (pop-to-buffer output-buffer))))))))
4814
4815 ;; File Editing.
4816
4817 (defvar tramp-handle-file-local-copy-hook nil
4818 "Normal hook to be run at the end of `tramp-handle-file-local-copy'.")
4819
4820 (defun tramp-handle-file-local-copy (filename)
4821 "Like `file-local-copy' for Tramp files."
4822
4823 (with-parsed-tramp-file-name filename nil
4824 (unless (file-exists-p filename)
4825 (tramp-error
4826 v 'file-error
4827 "Cannot make local copy of non-existing file `%s'" filename))
4828
4829 (let* ((size (nth 7 (file-attributes filename)))
4830 (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
4831 (loc-dec (tramp-get-inline-coding v "local-decoding" size))
4832 (tmpfile (tramp-compat-make-temp-file filename)))
4833
4834 (condition-case err
4835 (cond
4836 ;; `copy-file' handles direct copy and out-of-band methods.
4837 ((or (tramp-local-host-p v)
4838 (tramp-method-out-of-band-p v size))
4839 (copy-file filename tmpfile t t))
4840
4841 ;; Use inline encoding for file transfer.
4842 (rem-enc
4843 (save-excursion
4844 (with-progress-reporter
4845 v 3 (format "Encoding remote file %s" filename)
4846 (tramp-barf-unless-okay
4847 v (format rem-enc (tramp-shell-quote-argument localname))
4848 "Encoding remote file failed"))
4849
4850 (if (functionp loc-dec)
4851 ;; If local decoding is a function, we call it. We
4852 ;; must disable multibyte, because
4853 ;; `uudecode-decode-region' doesn't handle it
4854 ;; correctly.
4855 (with-temp-buffer
4856 (set-buffer-multibyte nil)
4857 (insert-buffer-substring (tramp-get-buffer v))
4858 (with-progress-reporter
4859 v 3 (format "Decoding remote file %s with function %s"
4860 filename loc-dec)
4861 (funcall loc-dec (point-min) (point-max))
4862 ;; Unset `file-name-handler-alist'. Otherwise,
4863 ;; epa-file gets confused.
4864 (let (file-name-handler-alist
4865 (coding-system-for-write 'binary))
4866 (write-region (point-min) (point-max) tmpfile))))
4867
4868 ;; If tramp-decoding-function is not defined for this
4869 ;; method, we invoke tramp-decoding-command instead.
4870 (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
4871 ;; Unset `file-name-handler-alist'. Otherwise,
4872 ;; epa-file gets confused.
4873 (let (file-name-handler-alist
4874 (coding-system-for-write 'binary))
4875 (write-region (point-min) (point-max) tmpfile2))
4876 (with-progress-reporter
4877 v 3 (format "Decoding remote file %s with command %s"
4878 filename loc-dec)
4879 (unwind-protect
4880 (tramp-call-local-coding-command
4881 loc-dec tmpfile2 tmpfile)
4882 (delete-file tmpfile2)))))
4883
4884 ;; Set proper permissions.
4885 (set-file-modes tmpfile (tramp-default-file-modes filename))
4886 ;; Set local user ownership.
4887 (tramp-set-file-uid-gid tmpfile)))
4888
4889 ;; Oops, I don't know what to do.
4890 (t (tramp-error
4891 v 'file-error "Wrong method specification for `%s'" method)))
4892
4893 ;; Error handling.
4894 ((error quit)
4895 (delete-file tmpfile)
4896 (signal (car err) (cdr err))))
4897
4898 (run-hooks 'tramp-handle-file-local-copy-hook)
4899 tmpfile)))
4900
4901 (defun tramp-handle-file-remote-p (filename &optional identification connected)
4902 "Like `file-remote-p' for Tramp files."
4903 (let ((tramp-verbose 3))
4904 (when (tramp-tramp-file-p filename)
4905 (let* ((v (tramp-dissect-file-name filename))
4906 (p (tramp-get-connection-process v))
4907 (c (and p (processp p) (memq (process-status p) '(run open)))))
4908 ;; We expand the file name only, if there is already a connection.
4909 (with-parsed-tramp-file-name
4910 (if c (expand-file-name filename) filename) nil
4911 (and (or (not connected) c)
4912 (cond
4913 ((eq identification 'method) method)
4914 ((eq identification 'user) user)
4915 ((eq identification 'host) host)
4916 ((eq identification 'localname) localname)
4917 (t (tramp-make-tramp-file-name method user host "")))))))))
4918
4919 (defun tramp-find-file-name-coding-system-alist (filename tmpname)
4920 "Like `find-operation-coding-system' for Tramp filenames.
4921 Tramp's `insert-file-contents' and `write-region' work over
4922 temporary file names. If `file-coding-system-alist' contains an
4923 expression, which matches more than the file name suffix, the
4924 coding system might not be determined. This function repairs it."
4925 (let (result)
4926 (dolist (elt file-coding-system-alist result)
4927 (when (and (consp elt) (string-match (car elt) filename))
4928 ;; We found a matching entry in `file-coding-system-alist'.
4929 ;; So we add a similar entry, but with the temporary file name
4930 ;; as regexp.
4931 (add-to-list
4932 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
4933
4934 (defun tramp-handle-insert-file-contents
4935 (filename &optional visit beg end replace)
4936 "Like `insert-file-contents' for Tramp files."
4937 (barf-if-buffer-read-only)
4938 (setq filename (expand-file-name filename))
4939 (let (result local-copy remote-copy)
4940 (with-parsed-tramp-file-name filename nil
4941 (unwind-protect
4942 (if (not (file-exists-p filename))
4943 ;; We don't raise a Tramp error, because it might be
4944 ;; suppressed, like in `find-file-noselect-1'.
4945 (signal 'file-error
4946 (list "File not found on remote host" filename))
4947
4948 (if (and (tramp-local-host-p v)
4949 (let (file-name-handler-alist)
4950 (file-readable-p localname)))
4951 ;; Short track: if we are on the local host, we can
4952 ;; run directly.
4953 (setq result
4954 (tramp-run-real-handler
4955 'insert-file-contents
4956 (list localname visit beg end replace)))
4957
4958 ;; When we shall insert only a part of the file, we copy
4959 ;; this part.
4960 (when (or beg end)
4961 (setq remote-copy (tramp-make-tramp-temp-file v))
4962 (tramp-send-command
4963 v
4964 (cond
4965 ((and beg end)
4966 (format "tail -c +%d %s | head -c +%d >%s"
4967 (1+ beg) (tramp-shell-quote-argument localname)
4968 (- end beg) remote-copy))
4969 (beg
4970 (format "tail -c +%d %s >%s"
4971 (1+ beg) (tramp-shell-quote-argument localname)
4972 remote-copy))
4973 (end
4974 (format "head -c +%d %s >%s"
4975 (1+ end) (tramp-shell-quote-argument localname)
4976 remote-copy)))))
4977
4978 ;; `insert-file-contents-literally' takes care to avoid
4979 ;; calling jka-compr. By let-binding
4980 ;; `inhibit-file-name-operation', we propagate that care
4981 ;; to the `file-local-copy' operation.
4982 (setq local-copy
4983 (let ((inhibit-file-name-operation
4984 (when (eq inhibit-file-name-operation
4985 'insert-file-contents)
4986 'file-local-copy)))
4987 (cond
4988 ((stringp remote-copy)
4989 (file-local-copy
4990 (tramp-make-tramp-file-name
4991 method user host remote-copy)))
4992 ((stringp tramp-temp-buffer-file-name)
4993 (copy-file filename tramp-temp-buffer-file-name 'ok)
4994 tramp-temp-buffer-file-name)
4995 (t (file-local-copy filename)))))
4996
4997 ;; When the file is not readable for the owner, it
4998 ;; cannot be inserted, even it is redable for the group
4999 ;; or for everybody.
5000 (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
5001
5002 (when (and (null remote-copy)
5003 (tramp-get-method-parameter
5004 method 'tramp-copy-keep-tmpfile))
5005 ;; We keep the local file for performance reasons,
5006 ;; useful for "rsync".
5007 (setq tramp-temp-buffer-file-name local-copy)
5008 (put 'tramp-temp-buffer-file-name 'permanent-local t))
5009
5010 (with-progress-reporter
5011 v 3 (format "Inserting local temp file `%s'" local-copy)
5012 ;; We must ensure that `file-coding-system-alist'
5013 ;; matches `local-copy'.
5014 (let ((file-coding-system-alist
5015 (tramp-find-file-name-coding-system-alist
5016 filename local-copy)))
5017 (setq result
5018 (insert-file-contents
5019 local-copy nil nil nil replace))))))
5020
5021 ;; Save exit.
5022 (progn
5023 (when visit
5024 (setq buffer-file-name filename)
5025 (setq buffer-read-only (not (file-writable-p filename)))
5026 (set-visited-file-modtime)
5027 (set-buffer-modified-p nil)
5028 ;; For root, preserve owner and group when editing files.
5029 (when (string-equal
5030 (tramp-file-name-handler 'file-remote-p filename 'user)
5031 "root")
5032 (set (make-local-variable 'backup-by-copying-when-mismatch) t)))
5033 (when (and (stringp local-copy)
5034 (or remote-copy (null tramp-temp-buffer-file-name)))
5035 (delete-file local-copy))
5036 (when (stringp remote-copy)
5037 (delete-file
5038 (tramp-make-tramp-file-name method user host remote-copy))))))
5039
5040 ;; Result.
5041 (list (expand-file-name filename)
5042 (cadr result))))
5043
5044 ;; This is needed for XEmacs only. Code stolen from files.el.
5045 (defun tramp-handle-insert-file-contents-literally
5046 (filename &optional visit beg end replace)
5047 "Like `insert-file-contents-literally' for Tramp files."
5048 (let ((format-alist nil)
5049 (after-insert-file-functions nil)
5050 (coding-system-for-read 'no-conversion)
5051 (coding-system-for-write 'no-conversion)
5052 (find-buffer-file-type-function
5053 (if (fboundp 'find-buffer-file-type)
5054 (symbol-function 'find-buffer-file-type)
5055 nil))
5056 (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
5057 (inhibit-file-name-operation 'insert-file-contents))
5058 (unwind-protect
5059 (progn
5060 (fset 'find-buffer-file-type (lambda (filename) t))
5061 (insert-file-contents filename visit beg end replace))
5062 ;; Save exit.
5063 (if find-buffer-file-type-function
5064 (fset 'find-buffer-file-type find-buffer-file-type-function)
5065 (fmakunbound 'find-buffer-file-type)))))
5066
5067 (defun tramp-handle-find-backup-file-name (filename)
5068 "Like `find-backup-file-name' for Tramp files."
5069 (with-parsed-tramp-file-name filename nil
5070 ;; We set both variables. It doesn't matter whether it is
5071 ;; Emacs or XEmacs.
5072 (let ((backup-directory-alist
5073 ;; Emacs case.
5074 (when (boundp 'backup-directory-alist)
5075 (if (symbol-value 'tramp-backup-directory-alist)
5076 (mapcar
5077 (lambda (x)
5078 (cons
5079 (car x)
5080 (if (and (stringp (cdr x))
5081 (file-name-absolute-p (cdr x))
5082 (not (tramp-file-name-p (cdr x))))
5083 (tramp-make-tramp-file-name method user host (cdr x))
5084 (cdr x))))
5085 (symbol-value 'tramp-backup-directory-alist))
5086 (symbol-value 'backup-directory-alist))))
5087
5088 (bkup-backup-directory-info
5089 ;; XEmacs case.
5090 (when (boundp 'bkup-backup-directory-info)
5091 (if (symbol-value 'tramp-bkup-backup-directory-info)
5092 (mapcar
5093 (lambda (x)
5094 (nconc
5095 (list (car x))
5096 (list
5097 (if (and (stringp (car (cdr x)))
5098 (file-name-absolute-p (car (cdr x)))
5099 (not (tramp-file-name-p (car (cdr x)))))
5100 (tramp-make-tramp-file-name
5101 method user host (car (cdr x)))
5102 (car (cdr x))))
5103 (cdr (cdr x))))
5104 (symbol-value 'tramp-bkup-backup-directory-info))
5105 (symbol-value 'bkup-backup-directory-info)))))
5106
5107 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
5108
5109 (defun tramp-handle-make-auto-save-file-name ()
5110 "Like `make-auto-save-file-name' for Tramp files.
5111 Returns a file name in `tramp-auto-save-directory' for autosaving this file."
5112 (let ((tramp-auto-save-directory tramp-auto-save-directory)
5113 (buffer-file-name
5114 (tramp-subst-strs-in-string
5115 '(("_" . "|")
5116 ("/" . "_a")
5117 (":" . "_b")
5118 ("|" . "__")
5119 ("[" . "_l")
5120 ("]" . "_r"))
5121 (buffer-file-name))))
5122 ;; File name must be unique. This is ensured with Emacs 22 (see
5123 ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
5124 ;; all other cases we must do it ourselves.
5125 (when (boundp 'auto-save-file-name-transforms)
5126 (mapc
5127 (lambda (x)
5128 (when (and (string-match (car x) buffer-file-name)
5129 (not (car (cddr x))))
5130 (setq tramp-auto-save-directory
5131 (or tramp-auto-save-directory
5132 (tramp-compat-temporary-file-directory)))))
5133 (symbol-value 'auto-save-file-name-transforms)))
5134 ;; Create directory.
5135 (when tramp-auto-save-directory
5136 (setq buffer-file-name
5137 (expand-file-name buffer-file-name tramp-auto-save-directory))
5138 (unless (file-exists-p tramp-auto-save-directory)
5139 (make-directory tramp-auto-save-directory t)))
5140 ;; Run plain `make-auto-save-file-name'. There might be an advice when
5141 ;; it is not a magic file name operation (since Emacs 22).
5142 ;; We must deactivate it temporarily.
5143 (if (not (ad-is-active 'make-auto-save-file-name))
5144 (tramp-run-real-handler 'make-auto-save-file-name nil)
5145 ;; else
5146 (ad-deactivate 'make-auto-save-file-name)
5147 (prog1
5148 (tramp-run-real-handler 'make-auto-save-file-name nil)
5149 (ad-activate 'make-auto-save-file-name)))))
5150
5151 (defvar tramp-handle-write-region-hook nil
5152 "Normal hook to be run at the end of `tramp-handle-write-region'.")
5153
5154 ;; CCC grok LOCKNAME
5155 (defun tramp-handle-write-region
5156 (start end filename &optional append visit lockname confirm)
5157 "Like `write-region' for Tramp files."
5158 (setq filename (expand-file-name filename))
5159 (with-parsed-tramp-file-name filename nil
5160 ;; Following part commented out because we don't know what to do about
5161 ;; file locking, and it does not appear to be a problem to ignore it.
5162 ;; Ange-ftp ignores it, too.
5163 ;; (when (and lockname (stringp lockname))
5164 ;; (setq lockname (expand-file-name lockname)))
5165 ;; (unless (or (eq lockname nil)
5166 ;; (string= lockname filename))
5167 ;; (error
5168 ;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
5169
5170 ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
5171 (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
5172 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
5173 (tramp-error v 'file-error "File not overwritten")))
5174
5175 (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
5176 (tramp-get-remote-uid v 'integer)))
5177 (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
5178 (tramp-get-remote-gid v 'integer))))
5179
5180 (if (and (tramp-local-host-p v)
5181 ;; `file-writable-p' calls `file-expand-file-name'. We
5182 ;; cannot use `tramp-run-real-handler' therefore.
5183 (let (file-name-handler-alist)
5184 (and
5185 (file-writable-p (file-name-directory localname))
5186 (or (file-directory-p localname)
5187 (file-writable-p localname)))))
5188 ;; Short track: if we are on the local host, we can run directly.
5189 (tramp-run-real-handler
5190 'write-region
5191 (list start end localname append 'no-message lockname confirm))
5192
5193 (let ((modes (save-excursion (tramp-default-file-modes filename)))
5194 ;; We use this to save the value of
5195 ;; `last-coding-system-used' after writing the tmp
5196 ;; file. At the end of the function, we set
5197 ;; `last-coding-system-used' to this saved value. This
5198 ;; way, any intermediary coding systems used while
5199 ;; talking to the remote shell or suchlike won't hose
5200 ;; this variable. This approach was snarfed from
5201 ;; ange-ftp.el.
5202 coding-system-used
5203 ;; Write region into a tmp file. This isn't really
5204 ;; needed if we use an encoding function, but currently
5205 ;; we use it always because this makes the logic
5206 ;; simpler.
5207 (tmpfile (or tramp-temp-buffer-file-name
5208 (tramp-compat-make-temp-file filename))))
5209
5210 ;; If `append' is non-nil, we copy the file locally, and let
5211 ;; the native `write-region' implementation do the job.
5212 (when append (copy-file filename tmpfile 'ok))
5213
5214 ;; We say `no-message' here because we don't want the
5215 ;; visited file modtime data to be clobbered from the temp
5216 ;; file. We call `set-visited-file-modtime' ourselves later
5217 ;; on. We must ensure that `file-coding-system-alist'
5218 ;; matches `tmpfile'.
5219 (let (file-name-handler-alist
5220 (file-coding-system-alist
5221 (tramp-find-file-name-coding-system-alist filename tmpfile)))
5222 (condition-case err
5223 (tramp-run-real-handler
5224 'write-region
5225 (list start end tmpfile append 'no-message lockname confirm))
5226 ((error quit)
5227 (setq tramp-temp-buffer-file-name nil)
5228 (delete-file tmpfile)
5229 (signal (car err) (cdr err))))
5230
5231 ;; Now, `last-coding-system-used' has the right value. Remember it.
5232 (when (boundp 'last-coding-system-used)
5233 (setq coding-system-used
5234 (symbol-value 'last-coding-system-used))))
5235
5236 ;; The permissions of the temporary file should be set. If
5237 ;; filename does not exist (eq modes nil) it has been
5238 ;; renamed to the backup file. This case `save-buffer'
5239 ;; handles permissions.
5240 ;; Ensure, that it is still readable.
5241 (when modes
5242 (set-file-modes
5243 tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400"))))
5244
5245 ;; This is a bit lengthy due to the different methods
5246 ;; possible for file transfer. First, we check whether the
5247 ;; method uses an rcp program. If so, we call it.
5248 ;; Otherwise, both encoding and decoding command must be
5249 ;; specified. However, if the method _also_ specifies an
5250 ;; encoding function, then that is used for encoding the
5251 ;; contents of the tmp file.
5252 (let* ((size (nth 7 (file-attributes tmpfile)))
5253 (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
5254 (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
5255 (cond
5256 ;; `copy-file' handles direct copy and out-of-band methods.
5257 ((or (tramp-local-host-p v)
5258 (tramp-method-out-of-band-p v size))
5259 (if (and (not (stringp start))
5260 (= (or end (point-max)) (point-max))
5261 (= (or start (point-min)) (point-min))
5262 (tramp-get-method-parameter
5263 method 'tramp-copy-keep-tmpfile))
5264 (progn
5265 (setq tramp-temp-buffer-file-name tmpfile)
5266 (condition-case err
5267 ;; We keep the local file for performance
5268 ;; reasons, useful for "rsync".
5269 (copy-file tmpfile filename t)
5270 ((error quit)
5271 (setq tramp-temp-buffer-file-name nil)
5272 (delete-file tmpfile)
5273 (signal (car err) (cdr err)))))
5274 (setq tramp-temp-buffer-file-name nil)
5275 ;; Don't rename, in order to keep context in SELinux.
5276 (unwind-protect
5277 (copy-file tmpfile filename t)
5278 (delete-file tmpfile))))
5279
5280 ;; Use inline file transfer.
5281 (rem-dec
5282 ;; Encode tmpfile.
5283 (unwind-protect
5284 (with-temp-buffer
5285 (set-buffer-multibyte nil)
5286 ;; Use encoding function or command.
5287 (if (functionp loc-enc)
5288 (with-progress-reporter
5289 v 3 (format "Encoding region using function `%s'"
5290 loc-enc)
5291 (let ((coding-system-for-read 'binary))
5292 (insert-file-contents-literally tmpfile))
5293 ;; The following `let' is a workaround for the
5294 ;; base64.el that comes with pgnus-0.84. If
5295 ;; both of the following conditions are
5296 ;; satisfied, it tries to write to a local
5297 ;; file in default-directory, but at this
5298 ;; point, default-directory is remote.
5299 ;; (`call-process-region' can't write to
5300 ;; remote files, it seems.) The file in
5301 ;; question is a tmp file anyway.
5302 (let ((default-directory
5303 (tramp-compat-temporary-file-directory)))
5304 (funcall loc-enc (point-min) (point-max))))
5305
5306 (with-progress-reporter
5307 v 3 (format "Encoding region using command `%s'"
5308 loc-enc)
5309 (unless (zerop (tramp-call-local-coding-command
5310 loc-enc tmpfile t))
5311 (tramp-error
5312 v 'file-error
5313 (concat "Cannot write to `%s', "
5314 "local encoding command `%s' failed")
5315 filename loc-enc))))
5316
5317 ;; Send buffer into remote decoding command which
5318 ;; writes to remote file. Because this happens on
5319 ;; the remote host, we cannot use the function.
5320 (with-progress-reporter
5321 v 3
5322 (format "Decoding region into remote file %s" filename)
5323 (goto-char (point-max))
5324 (unless (bolp) (newline))
5325 (tramp-send-command
5326 v
5327 (format
5328 (concat rem-dec " <<'EOF'\n%sEOF")
5329 (tramp-shell-quote-argument localname)
5330 (buffer-string)))
5331 (tramp-barf-unless-okay
5332 v nil
5333 "Couldn't write region to `%s', decode using `%s' failed"
5334 filename rem-dec)
5335 ;; When `file-precious-flag' is set, the region is
5336 ;; written to a temporary file. Check that the
5337 ;; checksum is equal to that from the local tmpfile.
5338 (when file-precious-flag
5339 (erase-buffer)
5340 (and
5341 ;; cksum runs locally, if possible.
5342 (zerop (tramp-local-call-process "cksum" tmpfile t))
5343 ;; cksum runs remotely.
5344 (zerop
5345 (tramp-send-command-and-check
5346 v
5347 (format
5348 "cksum <%s"
5349 (tramp-shell-quote-argument localname))))
5350 ;; ... they are different.
5351 (not
5352 (string-equal
5353 (buffer-string)
5354 (with-current-buffer (tramp-get-buffer v)
5355 (buffer-string))))
5356 (tramp-error
5357 v 'file-error
5358 (concat "Couldn't write region to `%s',"
5359 " decode using `%s' failed")
5360 filename rem-dec)))))
5361
5362 ;; Save exit.
5363 (delete-file tmpfile)))
5364
5365 ;; That's not expected.
5366 (t
5367 (tramp-error
5368 v 'file-error
5369 (concat "Method `%s' should specify both encoding and "
5370 "decoding command or an rcp program")
5371 method))))
5372
5373 ;; Make `last-coding-system-used' have the right value.
5374 (when coding-system-used
5375 (set 'last-coding-system-used coding-system-used))))
5376
5377 (tramp-flush-file-property v (file-name-directory localname))
5378 (tramp-flush-file-property v localname)
5379
5380 ;; We must protect `last-coding-system-used', now we have set it
5381 ;; to its correct value.
5382 (let (last-coding-system-used (need-chown t))
5383 ;; Set file modification time.
5384 (when (or (eq visit t) (stringp visit))
5385 (let ((file-attr (file-attributes filename)))
5386 (set-visited-file-modtime
5387 ;; We must pass modtime explicitely, because filename can
5388 ;; be different from (buffer-file-name), f.e. if
5389 ;; `file-precious-flag' is set.
5390 (nth 5 file-attr))
5391 (when (and (eq (nth 2 file-attr) uid)
5392 (eq (nth 3 file-attr) gid))
5393 (setq need-chown nil))))
5394
5395 ;; Set the ownership.
5396 (when need-chown
5397 (tramp-set-file-uid-gid filename uid gid))
5398 (when (or (eq visit t) (null visit) (stringp visit))
5399 (tramp-message v 0 "Wrote %s" filename))
5400 (run-hooks 'tramp-handle-write-region-hook)))))
5401
5402 (defvar tramp-vc-registered-file-names nil
5403 "List used to collect file names, which are checked during `vc-registered'.")
5404
5405 ;; VC backends check for the existence of various different special
5406 ;; files. This is very time consuming, because every single check
5407 ;; requires a remote command (the file cache must be invalidated).
5408 ;; Therefore, we apply a kind of optimization. We install the file
5409 ;; name handler `tramp-vc-file-name-handler', which does nothing but
5410 ;; remembers all file names for which `file-exists-p' or
5411 ;; `file-readable-p' has been applied. A first run of `vc-registered'
5412 ;; is performed. Afterwards, a script is applied for all collected
5413 ;; file names, using just one remote command. The result of this
5414 ;; script is used to fill the file cache with actual values. Now we
5415 ;; can reset the file name handlers, and we make a second run of
5416 ;; `vc-registered', which returns the expected result without sending
5417 ;; any other remote command.
5418 (defun tramp-handle-vc-registered (file)
5419 "Like `vc-registered' for Tramp files."
5420 (with-temp-message ""
5421 (with-parsed-tramp-file-name file nil
5422 (with-progress-reporter
5423 v 3 (format "Checking `vc-registered' for %s" file)
5424
5425 ;; There could be new files, created by the vc backend. We
5426 ;; cannot reuse the old cache entries, therefore.
5427 (let (tramp-vc-registered-file-names
5428 (tramp-cache-inhibit-cache (current-time))
5429 (file-name-handler-alist
5430 `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
5431
5432 ;; Here we collect only file names, which need an operation.
5433 (tramp-run-real-handler 'vc-registered (list file))
5434 (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
5435
5436 ;; Send just one command, in order to fill the cache.
5437 (when tramp-vc-registered-file-names
5438 (tramp-maybe-send-script
5439 v
5440 (format tramp-vc-registered-read-file-names
5441 (tramp-get-file-exists-command v)
5442 (format "%s -r" (tramp-get-test-command v)))
5443 "tramp_vc_registered_read_file_names")
5444
5445 (dolist
5446 (elt
5447 (tramp-send-command-and-read
5448 v
5449 (format
5450 "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
5451 (mapconcat 'tramp-shell-quote-argument
5452 tramp-vc-registered-file-names
5453 "\n"))))
5454
5455 (tramp-set-file-property
5456 v (car elt) (cadr elt) (cadr (cdr elt))))))
5457
5458 ;; Second run. Now all `file-exists-p' or `file-readable-p'
5459 ;; calls shall be answered from the file cache. We unset
5460 ;; `process-file-side-effects' in order to keep the cache when
5461 ;; `process-file' calls appear.
5462 (let (process-file-side-effects)
5463 (tramp-run-real-handler 'vc-registered (list file)))))))
5464
5465 ;;;###autoload
5466 (progn (defun tramp-run-real-handler (operation args)
5467 "Invoke normal file name handler for OPERATION.
5468 First arg specifies the OPERATION, second arg is a list of arguments to
5469 pass to the OPERATION."
5470 (let* ((inhibit-file-name-handlers
5471 `(tramp-file-name-handler
5472 tramp-vc-file-name-handler
5473 tramp-completion-file-name-handler
5474 cygwin-mount-name-hook-function
5475 cygwin-mount-map-drive-hook-function
5476 .
5477 ,(and (eq inhibit-file-name-operation operation)
5478 inhibit-file-name-handlers)))
5479 (inhibit-file-name-operation operation))
5480 (apply operation args))))
5481
5482 ;;;###autoload
5483 (progn (defun tramp-completion-run-real-handler (operation args)
5484 "Invoke `tramp-file-name-handler' for OPERATION.
5485 First arg specifies the OPERATION, second arg is a list of arguments to
5486 pass to the OPERATION."
5487 (let* ((inhibit-file-name-handlers
5488 `(tramp-completion-file-name-handler
5489 cygwin-mount-name-hook-function
5490 cygwin-mount-map-drive-hook-function
5491 .
5492 ,(and (eq inhibit-file-name-operation operation)
5493 inhibit-file-name-handlers)))
5494 (inhibit-file-name-operation operation))
5495 (apply operation args))))
5496
5497 ;; We handle here all file primitives. Most of them have the file
5498 ;; name as first parameter; nevertheless we check for them explicitly
5499 ;; in order to be signaled if a new primitive appears. This
5500 ;; scenario is needed because there isn't a way to decide by
5501 ;; syntactical means whether a foreign method must be called. It would
5502 ;; ease the life if `file-name-handler-alist' would support a decision
5503 ;; function as well but regexp only.
5504 (defun tramp-file-name-for-operation (operation &rest args)
5505 "Return file name related to OPERATION file primitive.
5506 ARGS are the arguments OPERATION has been called with."
5507 (cond
5508 ;; FILE resp DIRECTORY.
5509 ((member operation
5510 (list 'access-file 'byte-compiler-base-file-name 'delete-directory
5511 'delete-file 'diff-latest-backup-file 'directory-file-name
5512 'directory-files 'directory-files-and-attributes
5513 'dired-compress-file 'dired-uncache
5514 'file-accessible-directory-p 'file-attributes
5515 'file-directory-p 'file-executable-p 'file-exists-p
5516 'file-local-copy 'file-remote-p 'file-modes
5517 'file-name-as-directory 'file-name-directory
5518 'file-name-nondirectory 'file-name-sans-versions
5519 'file-ownership-preserved-p 'file-readable-p
5520 'file-regular-p 'file-symlink-p 'file-truename
5521 'file-writable-p 'find-backup-file-name 'find-file-noselect
5522 'get-file-buffer 'insert-directory 'insert-file-contents
5523 'load 'make-directory 'make-directory-internal
5524 'set-file-modes 'substitute-in-file-name
5525 'unhandled-file-name-directory 'vc-registered
5526 ;; Emacs 22+ only.
5527 'set-file-times
5528 ;; Emacs 24+ only.
5529 'file-selinux-context 'set-file-selinux-context
5530 ;; XEmacs only.
5531 'abbreviate-file-name 'create-file-buffer
5532 'dired-file-modtime 'dired-make-compressed-filename
5533 'dired-recursive-delete-directory 'dired-set-file-modtime
5534 'dired-shell-unhandle-file-name 'dired-uucode-file
5535 'insert-file-contents-literally 'make-temp-name 'recover-file
5536 'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
5537 (if (file-name-absolute-p (nth 0 args))
5538 (nth 0 args)
5539 (expand-file-name (nth 0 args))))
5540 ;; FILE DIRECTORY resp FILE1 FILE2.
5541 ((member operation
5542 (list 'add-name-to-file 'copy-file 'expand-file-name
5543 'file-name-all-completions 'file-name-completion
5544 'file-newer-than-file-p 'make-symbolic-link 'rename-file
5545 ;; Emacs 23+ only.
5546 'copy-directory
5547 ;; XEmacs only.
5548 'dired-make-relative-symlink
5549 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
5550 (save-match-data
5551 (cond
5552 ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
5553 ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
5554 (t (buffer-file-name (current-buffer))))))
5555 ;; START END FILE.
5556 ((eq operation 'write-region)
5557 (nth 2 args))
5558 ;; BUFFER.
5559 ((member operation
5560 (list 'set-visited-file-modtime 'verify-visited-file-modtime
5561 ;; Emacs 22+ only.
5562 'make-auto-save-file-name
5563 ;; XEmacs only.
5564 'backup-buffer))
5565 (buffer-file-name
5566 (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
5567 ;; COMMAND.
5568 ((member operation
5569 (list ;; not in Emacs 23+.
5570 'dired-call-process
5571 ;; Emacs only.
5572 'shell-command
5573 ;; Emacs 22+ only.
5574 'process-file
5575 ;; Emacs 23+ only.
5576 'start-file-process
5577 ;; XEmacs only.
5578 'dired-print-file 'dired-shell-call-process
5579 ;; nowhere yet.
5580 'executable-find 'start-process
5581 'call-process 'call-process-region))
5582 default-directory)
5583 ;; Unknown file primitive.
5584 (t (error "unknown file I/O primitive: %s" operation))))
5585
5586 (defun tramp-find-foreign-file-name-handler (filename)
5587 "Return foreign file name handler if exists."
5588 (when (tramp-tramp-file-p filename)
5589 (let ((v (tramp-dissect-file-name filename t))
5590 (handler tramp-foreign-file-name-handler-alist)
5591 elt res)
5592 ;; When we are not fully sure that filename completion is safe,
5593 ;; we should not return a handler.
5594 (when (or (tramp-file-name-method v) (tramp-file-name-user v)
5595 (and (tramp-file-name-host v)
5596 (not (member (tramp-file-name-host v)
5597 (mapcar 'car tramp-methods))))
5598 (not (tramp-completion-mode-p)))
5599 (while handler
5600 (setq elt (car handler)
5601 handler (cdr handler))
5602 (when (funcall (car elt) filename)
5603 (setq handler nil
5604 res (cdr elt))))
5605 res))))
5606
5607 ;; Main function.
5608 ;;;###autoload
5609 (defun tramp-file-name-handler (operation &rest args)
5610 "Invoke Tramp file name handler.
5611 Falls back to normal file name handler if no Tramp file name handler exists."
5612 (if tramp-mode
5613 (save-match-data
5614 (let* ((filename
5615 (tramp-replace-environment-variables
5616 (apply 'tramp-file-name-for-operation operation args)))
5617 (completion (tramp-completion-mode-p))
5618 (foreign (tramp-find-foreign-file-name-handler filename)))
5619 (with-parsed-tramp-file-name filename nil
5620 ;; Call the backend function.
5621 (if foreign
5622 (condition-case err
5623 (apply foreign operation args)
5624
5625 ;; Trace that somebody has interrupted the
5626 ;; operation.
5627 (quit
5628 (let (tramp-message-show-message)
5629 (tramp-message
5630 v 1 "Interrupt received in operation %s"
5631 (append (list operation) args)))
5632 ;; Propagate the quit signal.
5633 (signal (car err) (cdr err)))
5634
5635 ;; When we are in completion mode, some failed
5636 ;; operations shall return at least a default value
5637 ;; in order to give the user a chance to correct the
5638 ;; file name in the minibuffer.
5639 (error
5640 (cond
5641 ((and completion (zerop (length localname))
5642 (memq operation '(file-exists-p file-directory-p)))
5643 t)
5644 ((and completion (zerop (length localname))
5645 (memq operation
5646 '(expand-file-name file-name-as-directory)))
5647 filename)
5648 ;; Propagate the error.
5649 (t (signal (car err) (cdr err))))))
5650
5651 ;; Nothing to do for us.
5652 (tramp-run-real-handler operation args)))))
5653
5654 ;; When `tramp-mode' is not enabled, we don't do anything.
5655 (tramp-run-real-handler operation args)))
5656
5657 ;; In Emacs, there is some concurrency due to timers. If a timer
5658 ;; interrupts Tramp and wishes to use the same connection buffer as
5659 ;; the "main" Emacs, then garbage might occur in the connection
5660 ;; buffer. Therefore, we need to make sure that a timer does not use
5661 ;; the same connection buffer as the "main" Emacs. We implement a
5662 ;; cheap global lock, instead of locking each connection buffer
5663 ;; separately. The global lock is based on two variables,
5664 ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
5665 ;; (with setq) to indicate a lock. But Tramp also calls itself during
5666 ;; processing of a single file operation, so we need to allow
5667 ;; recursive calls. That's where the `tramp-locker' variable comes in
5668 ;; -- it is let-bound to t during the execution of the current
5669 ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
5670 ;; then we should just proceed because we have been called
5671 ;; recursively. But if `tramp-locker' is nil, then we are a timer
5672 ;; interrupting the "main" Emacs, and then we signal an error.
5673
5674 (defvar tramp-locked nil
5675 "If non-nil, then Tramp is currently busy.
5676 Together with `tramp-locker', this implements a locking mechanism
5677 preventing reentrant calls of Tramp.")
5678
5679 (defvar tramp-locker nil
5680 "If non-nil, then a caller has locked Tramp.
5681 Together with `tramp-locked', this implements a locking mechanism
5682 preventing reentrant calls of Tramp.")
5683
5684 (defun tramp-sh-file-name-handler (operation &rest args)
5685 "Invoke remote-shell Tramp file name handler.
5686 Fall back to normal file name handler if no Tramp handler exists."
5687 (when (and tramp-locked (not tramp-locker))
5688 (setq tramp-locked nil)
5689 (signal 'file-error (list "Forbidden reentrant call of Tramp")))
5690 (let ((tl tramp-locked))
5691 (unwind-protect
5692 (progn
5693 (setq tramp-locked t)
5694 (let ((tramp-locker t))
5695 (save-match-data
5696 (let ((fn (assoc operation tramp-file-name-handler-alist)))
5697 (if fn
5698 (apply (cdr fn) args)
5699 (tramp-run-real-handler operation args))))))
5700 (setq tramp-locked tl))))
5701
5702 (defun tramp-vc-file-name-handler (operation &rest args)
5703 "Invoke special file name handler, which collects files to be handled."
5704 (save-match-data
5705 (let ((filename
5706 (tramp-replace-environment-variables
5707 (apply 'tramp-file-name-for-operation operation args)))
5708 (fn (assoc operation tramp-file-name-handler-alist)))
5709 (with-parsed-tramp-file-name filename nil
5710 (cond
5711 ;; That's what we want: file names, for which checks are
5712 ;; applied. We assume, that VC uses only `file-exists-p' and
5713 ;; `file-readable-p' checks; otherwise we must extend the
5714 ;; list. We do not perform any action, but return nil, in
5715 ;; order to keep `vc-registered' running.
5716 ((and fn (memq operation '(file-exists-p file-readable-p)))
5717 (add-to-list 'tramp-vc-registered-file-names localname 'append)
5718 nil)
5719 ;; Tramp file name handlers like `expand-file-name'. They
5720 ;; must still work.
5721 (fn
5722 (save-match-data (apply (cdr fn) args)))
5723 ;; Default file name handlers, we don't care.
5724 (t (tramp-run-real-handler operation args)))))))
5725
5726 ;;;###autoload
5727 (progn (defun tramp-completion-file-name-handler (operation &rest args)
5728 "Invoke Tramp file name completion handler.
5729 Falls back to normal file name handler if no Tramp file name handler exists."
5730 ;; We bind `directory-sep-char' here for XEmacs on Windows, which
5731 ;; would otherwise use backslash.
5732 (let ((directory-sep-char ?/)
5733 (fn (assoc operation tramp-completion-file-name-handler-alist)))
5734 (if (and
5735 ;; When `tramp-mode' is not enabled, we don't do anything.
5736 fn tramp-mode
5737 ;; For other syntaxes than `sep', the regexp matches many common
5738 ;; situations where the user doesn't actually want to use Tramp.
5739 ;; So to avoid autoloading Tramp after typing just "/s", we
5740 ;; disable this part of the completion, unless the user implicitly
5741 ;; indicated his interest in using a fancier completion system.
5742 (or (eq tramp-syntax 'sep)
5743 (featurep 'tramp) ;; If it's loaded, we may as well use it.
5744 ;; `partial-completion-mode' does not exist in XEmacs.
5745 ;; It is obsoleted with Emacs 24.1.
5746 (and (boundp 'partial-completion-mode)
5747 (symbol-value 'partial-completion-mode))
5748 ;; FIXME: These may have been loaded even if the user never
5749 ;; intended to use them.
5750 (featurep 'ido)
5751 (featurep 'icicles)))
5752 (save-match-data (apply (cdr fn) args))
5753 (tramp-completion-run-real-handler operation args)))))
5754
5755 ;;;###autoload
5756 (progn (defun tramp-register-file-name-handlers ()
5757 "Add Tramp file name handlers to `file-name-handler-alist'."
5758 ;; Remove autoloaded handlers from file name handler alist. Useful,
5759 ;; if `tramp-syntax' has been changed.
5760 (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
5761 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
5762 (let ((a1 (rassq
5763 'tramp-completion-file-name-handler file-name-handler-alist)))
5764 (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
5765 ;; Add the handlers.
5766 (add-to-list 'file-name-handler-alist
5767 (cons tramp-file-name-regexp 'tramp-file-name-handler))
5768 (put 'tramp-file-name-handler 'safe-magic t)
5769 (add-to-list 'file-name-handler-alist
5770 (cons tramp-completion-file-name-regexp
5771 'tramp-completion-file-name-handler))
5772 (put 'tramp-completion-file-name-handler 'safe-magic t)
5773 ;; If jka-compr or epa-file are already loaded, move them to the
5774 ;; front of `file-name-handler-alist'.
5775 (dolist (fnh '(epa-file-handler jka-compr-handler))
5776 (let ((entry (rassoc fnh file-name-handler-alist)))
5777 (when entry
5778 (setq file-name-handler-alist
5779 (cons entry (delete entry file-name-handler-alist))))))))
5780
5781 ;; `tramp-file-name-handler' must be registered before evaluation of
5782 ;; site-start and init files, because there might exist remote files
5783 ;; already, f.e. files kept via recentf-mode.
5784 ;;;###autoload(tramp-register-file-name-handlers)
5785 (tramp-register-file-name-handlers)
5786
5787 ;;;###autoload
5788 (defun tramp-unload-file-name-handlers ()
5789 (setq file-name-handler-alist
5790 (delete (rassoc 'tramp-file-name-handler
5791 file-name-handler-alist)
5792 (delete (rassoc 'tramp-completion-file-name-handler
5793 file-name-handler-alist)
5794 file-name-handler-alist))))
5795
5796 (add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
5797
5798 ;;; File name handler functions for completion mode:
5799
5800 (defvar tramp-completion-mode nil
5801 "If non-nil, external packages signal that they are in file name completion.
5802
5803 This is necessary, because Tramp uses a heuristic depending on last
5804 input event. This fails when external packages use other characters
5805 but <TAB>, <SPACE> or ?\\? for file name completion. This variable
5806 should never be set globally, the intention is to let-bind it.")
5807
5808 ;; Necessary because `tramp-file-name-regexp-unified' and
5809 ;; `tramp-completion-file-name-regexp-unified' aren't different. If
5810 ;; nil, `tramp-completion-run-real-handler' is called (i.e. forwarding
5811 ;; to `tramp-file-name-handler'). Otherwise, it takes
5812 ;; `tramp-run-real-handler'. Using `last-input-event' is a little bit
5813 ;; risky, because completing a file might require loading other files,
5814 ;; like "~/.netrc", and for them it shouldn't be decided based on that
5815 ;; variable. On the other hand, those files shouldn't have partial
5816 ;; Tramp file name syntax. Maybe another variable should be introduced
5817 ;; overwriting this check in such cases. Or we change Tramp file name
5818 ;; syntax in order to avoid ambiguities, like in XEmacs ...
5819 (defun tramp-completion-mode-p ()
5820 "Check, whether method / user name / host name completion is active."
5821 (or
5822 ;; Signal from outside. `non-essential' has been introduced in Emacs 24.
5823 (and (boundp 'non-essential) (symbol-value 'non-essential))
5824 tramp-completion-mode
5825 ;; Emacs.
5826 (equal last-input-event 'tab)
5827 (and (natnump last-input-event)
5828 (or
5829 ;; ?\t has event-modifier 'control.
5830 (equal last-input-event ?\t)
5831 (and (not (event-modifiers last-input-event))
5832 (or (equal last-input-event ?\?)
5833 (equal last-input-event ?\ )))))
5834 ;; XEmacs.
5835 (and (featurep 'xemacs)
5836 ;; `last-input-event' might be nil.
5837 (not (null last-input-event))
5838 ;; `last-input-event' may have no character approximation.
5839 (tramp-compat-funcall 'event-to-character last-input-event)
5840 (or
5841 ;; ?\t has event-modifier 'control.
5842 (equal
5843 (tramp-compat-funcall 'event-to-character last-input-event) ?\t)
5844 (and (not (event-modifiers last-input-event))
5845 (or (equal
5846 (tramp-compat-funcall 'event-to-character last-input-event)
5847 ?\?)
5848 (equal
5849 (tramp-compat-funcall 'event-to-character last-input-event)
5850 ?\ )))))))
5851
5852 (defun tramp-connectable-p (filename)
5853 "Check, whether it is possible to connect the remote host w/o side-effects.
5854 This is true, if either the remote host is already connected, or if we are
5855 not in completion mode."
5856 (and (tramp-tramp-file-p filename)
5857 (with-parsed-tramp-file-name filename nil
5858 (or (get-buffer (tramp-buffer-name v))
5859 (not (tramp-completion-mode-p))))))
5860
5861 ;; Method, host name and user name completion.
5862 ;; `tramp-completion-dissect-file-name' returns a list of
5863 ;; tramp-file-name structures. For all of them we return possible completions.
5864 ;;;###autoload
5865 (defun tramp-completion-handle-file-name-all-completions (filename directory)
5866 "Like `file-name-all-completions' for partial Tramp files."
5867
5868 (let* ((fullname (tramp-drop-volume-letter
5869 (expand-file-name filename directory)))
5870 ;; Possible completion structures.
5871 (v (tramp-completion-dissect-file-name fullname))
5872 result result1)
5873
5874 (while v
5875 (let* ((car (car v))
5876 (method (tramp-file-name-method car))
5877 (user (tramp-file-name-user car))
5878 (host (tramp-file-name-host car))
5879 (localname (tramp-file-name-localname car))
5880 (m (tramp-find-method method user host))
5881 (tramp-current-user user) ; see `tramp-parse-passwd'
5882 all-user-hosts)
5883
5884 (unless localname ;; Nothing to complete.
5885
5886 (if (or user host)
5887
5888 ;; Method dependent user / host combinations.
5889 (progn
5890 (mapc
5891 (lambda (x)
5892 (setq all-user-hosts
5893 (append all-user-hosts
5894 (funcall (nth 0 x) (nth 1 x)))))
5895 (tramp-get-completion-function m))
5896
5897 (setq result
5898 (append result
5899 (mapcar
5900 (lambda (x)
5901 (tramp-get-completion-user-host
5902 method user host (nth 0 x) (nth 1 x)))
5903 (delq nil all-user-hosts)))))
5904
5905 ;; Possible methods.
5906 (setq result
5907 (append result (tramp-get-completion-methods m)))))
5908
5909 (setq v (cdr v))))
5910
5911 ;; Unify list, remove nil elements.
5912 (while result
5913 (let ((car (car result)))
5914 (when car
5915 (add-to-list
5916 'result1
5917 (substring car (length (tramp-drop-volume-letter directory)))))
5918 (setq result (cdr result))))
5919
5920 ;; Complete local parts.
5921 (append
5922 result1
5923 (condition-case nil
5924 (apply (if (tramp-connectable-p fullname)
5925 'tramp-completion-run-real-handler
5926 'tramp-run-real-handler)
5927 'file-name-all-completions (list (list filename directory)))
5928 (error nil)))))
5929
5930 ;; Method, host name and user name completion for a file.
5931 ;;;###autoload
5932 (defun tramp-completion-handle-file-name-completion
5933 (filename directory &optional predicate)
5934 "Like `file-name-completion' for Tramp files."
5935 (try-completion
5936 filename
5937 (mapcar 'list (file-name-all-completions filename directory))
5938 (when (and predicate
5939 (tramp-connectable-p (expand-file-name filename directory)))
5940 (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
5941
5942 ;; I misuse a little bit the tramp-file-name structure in order to handle
5943 ;; completion possibilities for partial methods / user names / host names.
5944 ;; Return value is a list of tramp-file-name structures according to possible
5945 ;; completions. If "localname" is non-nil it means there
5946 ;; shouldn't be a completion anymore.
5947
5948 ;; Expected results:
5949
5950 ;; "/x" "/[x" "/x@" "/[x@" "/x@y" "/[x@y"
5951 ;; [nil nil "x" nil] [nil "x" nil nil] [nil "x" "y" nil]
5952 ;; [nil "x" nil nil]
5953 ;; ["x" nil nil nil]
5954
5955 ;; "/x:" "/x:y" "/x:y:"
5956 ;; [nil nil "x" ""] [nil nil "x" "y"] ["x" nil "y" ""]
5957 ;; "/[x/" "/[x/y"
5958 ;; ["x" nil "" nil] ["x" nil "y" nil]
5959 ;; ["x" "" nil nil] ["x" "y" nil nil]
5960
5961 ;; "/x:y@" "/x:y@z" "/x:y@z:"
5962 ;; [nil nil "x" "y@"] [nil nil "x" "y@z"] ["x" "y" "z" ""]
5963 ;; "/[x/y@" "/[x/y@z"
5964 ;; ["x" nil "y" nil] ["x" "y" "z" nil]
5965 (defun tramp-completion-dissect-file-name (name)
5966 "Returns a list of `tramp-file-name' structures.
5967 They are collected by `tramp-completion-dissect-file-name1'."
5968
5969 (let* ((result)
5970 (x-nil "\\|\\(\\)")
5971 (tramp-completion-ipv6-regexp
5972 (format
5973 "[^%s]*"
5974 (if (zerop (length tramp-postfix-ipv6-format))
5975 tramp-postfix-host-format
5976 tramp-postfix-ipv6-format)))
5977 ;; "/method" "/[method"
5978 (tramp-completion-file-name-structure1
5979 (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
5980 1 nil nil nil))
5981 ;; "/user" "/[user"
5982 (tramp-completion-file-name-structure2
5983 (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil "\\)$")
5984 nil 1 nil nil))
5985 ;; "/host" "/[host"
5986 (tramp-completion-file-name-structure3
5987 (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil "\\)$")
5988 nil nil 1 nil))
5989 ;; "/[ipv6" "/[ipv6"
5990 (tramp-completion-file-name-structure4
5991 (list (concat tramp-prefix-regexp
5992 tramp-prefix-ipv6-regexp
5993 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
5994 nil nil 1 nil))
5995 ;; "/user@host" "/[user@host"
5996 (tramp-completion-file-name-structure5
5997 (list (concat tramp-prefix-regexp
5998 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
5999 "\\(" tramp-host-regexp x-nil "\\)$")
6000 nil 1 2 nil))
6001 ;; "/user@[ipv6" "/[user@ipv6"
6002 (tramp-completion-file-name-structure6
6003 (list (concat tramp-prefix-regexp
6004 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
6005 tramp-prefix-ipv6-regexp
6006 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
6007 nil 1 2 nil))
6008 ;; "/method:user" "/[method/user" "/method://user"
6009 (tramp-completion-file-name-structure7
6010 (list (concat tramp-prefix-regexp
6011 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
6012 "\\(" tramp-user-regexp x-nil "\\)$")
6013 1 2 nil nil))
6014 ;; "/method:host" "/[method/host" "/method://host"
6015 (tramp-completion-file-name-structure8
6016 (list (concat tramp-prefix-regexp
6017 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
6018 "\\(" tramp-host-regexp x-nil "\\)$")
6019 1 nil 2 nil))
6020 ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
6021 (tramp-completion-file-name-structure9
6022 (list (concat tramp-prefix-regexp
6023 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
6024 tramp-prefix-ipv6-regexp
6025 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
6026 1 nil 2 nil))
6027 ;; "/method:user@host" "/[method/user@host" "/method://user@host"
6028 (tramp-completion-file-name-structure10
6029 (list (concat tramp-prefix-regexp
6030 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
6031 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
6032 "\\(" tramp-host-regexp x-nil "\\)$")
6033 1 2 3 nil))
6034 ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
6035 (tramp-completion-file-name-structure11
6036 (list (concat tramp-prefix-regexp
6037 "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
6038 "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
6039 tramp-prefix-ipv6-regexp
6040 "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
6041 1 2 3 nil))
6042 ;; "/method: "/method:/"
6043 (tramp-completion-file-name-structure12
6044 (list
6045 (if (equal tramp-syntax 'url)
6046 (concat tramp-prefix-regexp
6047 "\\(" tramp-method-regexp "\\)"
6048 "\\(" (substring tramp-postfix-method-regexp 0 1)
6049 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
6050 "\\(" "\\)$")
6051 ;; Should not match if not URL syntax.
6052 (concat tramp-prefix-regexp "/$"))
6053 1 3 nil nil))
6054 ;; "/method: "/method:/"
6055 (tramp-completion-file-name-structure13
6056 (list
6057 (if (equal tramp-syntax 'url)
6058 (concat tramp-prefix-regexp
6059 "\\(" tramp-method-regexp "\\)"
6060 "\\(" (substring tramp-postfix-method-regexp 0 1)
6061 "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
6062 "\\(" "\\)$")
6063 ;; Should not match if not URL syntax.
6064 (concat tramp-prefix-regexp "/$"))
6065 1 nil 3 nil)))
6066
6067 (mapc (lambda (regexp)
6068 (add-to-list 'result
6069 (tramp-completion-dissect-file-name1 regexp name)))
6070 (list
6071 tramp-completion-file-name-structure1
6072 tramp-completion-file-name-structure2
6073 tramp-completion-file-name-structure3
6074 tramp-completion-file-name-structure4
6075 tramp-completion-file-name-structure5
6076 tramp-completion-file-name-structure6
6077 tramp-completion-file-name-structure7
6078 tramp-completion-file-name-structure8
6079 tramp-completion-file-name-structure9
6080 tramp-completion-file-name-structure10
6081 tramp-completion-file-name-structure11
6082 tramp-completion-file-name-structure12
6083 tramp-completion-file-name-structure13
6084 tramp-file-name-structure))
6085
6086 (delq nil result)))
6087
6088 (defun tramp-completion-dissect-file-name1 (structure name)
6089 "Returns a `tramp-file-name' structure matching STRUCTURE.
6090 The structure consists of remote method, remote user,
6091 remote host and localname (filename on remote host)."
6092
6093 (save-match-data
6094 (when (string-match (nth 0 structure) name)
6095 (let ((method (and (nth 1 structure)
6096 (match-string (nth 1 structure) name)))
6097 (user (and (nth 2 structure)
6098 (match-string (nth 2 structure) name)))
6099 (host (and (nth 3 structure)
6100 (match-string (nth 3 structure) name)))
6101 (localname (and (nth 4 structure)
6102 (match-string (nth 4 structure) name))))
6103 (vector method user host localname)))))
6104
6105 ;; This function returns all possible method completions, adding the
6106 ;; trailing method delimeter.
6107 (defun tramp-get-completion-methods (partial-method)
6108 "Returns all method completions for PARTIAL-METHOD."
6109 (mapcar
6110 (lambda (method)
6111 (and method
6112 (string-match (concat "^" (regexp-quote partial-method)) method)
6113 (tramp-completion-make-tramp-file-name method nil nil nil)))
6114 (mapcar 'car tramp-methods)))
6115
6116 ;; Compares partial user and host names with possible completions.
6117 (defun tramp-get-completion-user-host (method partial-user partial-host user host)
6118 "Returns the most expanded string for user and host name completion.
6119 PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
6120 (cond
6121
6122 ((and partial-user partial-host)
6123 (if (and host
6124 (string-match (concat "^" (regexp-quote partial-host)) host)
6125 (string-equal partial-user (or user partial-user)))
6126 (setq user partial-user)
6127 (setq user nil
6128 host nil)))
6129
6130 (partial-user
6131 (setq host nil)
6132 (unless
6133 (and user (string-match (concat "^" (regexp-quote partial-user)) user))
6134 (setq user nil)))
6135
6136 (partial-host
6137 (setq user nil)
6138 (unless
6139 (and host (string-match (concat "^" (regexp-quote partial-host)) host))
6140 (setq host nil)))
6141
6142 (t (setq user nil
6143 host nil)))
6144
6145 (unless (zerop (+ (length user) (length host)))
6146 (tramp-completion-make-tramp-file-name method user host nil)))
6147
6148 (defun tramp-parse-rhosts (filename)
6149 "Return a list of (user host) tuples allowed to access.
6150 Either user or host may be nil."
6151 ;; On Windows, there are problems in completion when
6152 ;; `default-directory' is remote.
6153 (let ((default-directory (tramp-compat-temporary-file-directory))
6154 res)
6155 (when (file-readable-p filename)
6156 (with-temp-buffer
6157 (insert-file-contents filename)
6158 (goto-char (point-min))
6159 (while (not (eobp))
6160 (push (tramp-parse-rhosts-group) res))))
6161 res))
6162
6163 (defun tramp-parse-rhosts-group ()
6164 "Return a (user host) tuple allowed to access.
6165 Either user or host may be nil."
6166 (let ((result)
6167 (regexp
6168 (concat
6169 "^\\(" tramp-host-regexp "\\)"
6170 "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
6171 (narrow-to-region (point) (tramp-compat-line-end-position))
6172 (when (re-search-forward regexp nil t)
6173 (setq result (append (list (match-string 3) (match-string 1)))))
6174 (widen)
6175 (forward-line 1)
6176 result))
6177
6178 (defun tramp-parse-shosts (filename)
6179 "Return a list of (user host) tuples allowed to access.
6180 User is always nil."
6181 ;; On Windows, there are problems in completion when
6182 ;; `default-directory' is remote.
6183 (let ((default-directory (tramp-compat-temporary-file-directory))
6184 res)
6185 (when (file-readable-p filename)
6186 (with-temp-buffer
6187 (insert-file-contents filename)
6188 (goto-char (point-min))
6189 (while (not (eobp))
6190 (push (tramp-parse-shosts-group) res))))
6191 res))
6192
6193 (defun tramp-parse-shosts-group ()
6194 "Return a (user host) tuple allowed to access.
6195 User is always nil."
6196 (let ((result)
6197 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
6198 (narrow-to-region (point) (tramp-compat-line-end-position))
6199 (when (re-search-forward regexp nil t)
6200 (setq result (list nil (match-string 1))))
6201 (widen)
6202 (or
6203 (> (skip-chars-forward ",") 0)
6204 (forward-line 1))
6205 result))
6206
6207 (defun tramp-parse-sconfig (filename)
6208 "Return a list of (user host) tuples allowed to access.
6209 User is always nil."
6210 ;; On Windows, there are problems in completion when
6211 ;; `default-directory' is remote.
6212 (let ((default-directory (tramp-compat-temporary-file-directory))
6213 res)
6214 (when (file-readable-p filename)
6215 (with-temp-buffer
6216 (insert-file-contents filename)
6217 (goto-char (point-min))
6218 (while (not (eobp))
6219 (push (tramp-parse-sconfig-group) res))))
6220 res))
6221
6222 (defun tramp-parse-sconfig-group ()
6223 "Return a (user host) tuple allowed to access.
6224 User is always nil."
6225 (let ((result)
6226 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
6227 (narrow-to-region (point) (tramp-compat-line-end-position))
6228 (when (re-search-forward regexp nil t)
6229 (setq result (list nil (match-string 1))))
6230 (widen)
6231 (or
6232 (> (skip-chars-forward ",") 0)
6233 (forward-line 1))
6234 result))
6235
6236 (defun tramp-parse-shostkeys (dirname)
6237 "Return a list of (user host) tuples allowed to access.
6238 User is always nil."
6239 ;; On Windows, there are problems in completion when
6240 ;; `default-directory' is remote.
6241 (let* ((default-directory (tramp-compat-temporary-file-directory))
6242 (regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
6243 (files (when (file-directory-p dirname) (directory-files dirname)))
6244 result)
6245 (while files
6246 (when (string-match regexp (car files))
6247 (push (list nil (match-string 1 (car files))) result))
6248 (setq files (cdr files)))
6249 result))
6250
6251 (defun tramp-parse-sknownhosts (dirname)
6252 "Return a list of (user host) tuples allowed to access.
6253 User is always nil."
6254 ;; On Windows, there are problems in completion when
6255 ;; `default-directory' is remote.
6256 (let* ((default-directory (tramp-compat-temporary-file-directory))
6257 (regexp (concat "^\\(" tramp-host-regexp
6258 "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
6259 (files (when (file-directory-p dirname) (directory-files dirname)))
6260 result)
6261 (while files
6262 (when (string-match regexp (car files))
6263 (push (list nil (match-string 1 (car files))) result))
6264 (setq files (cdr files)))
6265 result))
6266
6267 (defun tramp-parse-hosts (filename)
6268 "Return a list of (user host) tuples allowed to access.
6269 User is always nil."
6270 ;; On Windows, there are problems in completion when
6271 ;; `default-directory' is remote.
6272 (let ((default-directory (tramp-compat-temporary-file-directory))
6273 res)
6274 (when (file-readable-p filename)
6275 (with-temp-buffer
6276 (insert-file-contents filename)
6277 (goto-char (point-min))
6278 (while (not (eobp))
6279 (push (tramp-parse-hosts-group) res))))
6280 res))
6281
6282 (defun tramp-parse-hosts-group ()
6283 "Return a (user host) tuple allowed to access.
6284 User is always nil."
6285 (let ((result)
6286 (regexp
6287 (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)")))
6288 (narrow-to-region (point) (tramp-compat-line-end-position))
6289 (when (re-search-forward regexp nil t)
6290 (setq result (list nil (match-string 1))))
6291 (widen)
6292 (or
6293 (> (skip-chars-forward " \t") 0)
6294 (forward-line 1))
6295 result))
6296
6297 ;; For su-alike methods it would be desirable to return "root@localhost"
6298 ;; as default. Unfortunately, we have no information whether any user name
6299 ;; has been typed already. So we use `tramp-current-user' as indication,
6300 ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
6301 (defun tramp-parse-passwd (filename)
6302 "Return a list of (user host) tuples allowed to access.
6303 Host is always \"localhost\"."
6304 ;; On Windows, there are problems in completion when
6305 ;; `default-directory' is remote.
6306 (let ((default-directory (tramp-compat-temporary-file-directory))
6307 res)
6308 (if (zerop (length tramp-current-user))
6309 '(("root" nil))
6310 (when (file-readable-p filename)
6311 (with-temp-buffer
6312 (insert-file-contents filename)
6313 (goto-char (point-min))
6314 (while (not (eobp))
6315 (push (tramp-parse-passwd-group) res))))
6316 res)))
6317
6318 (defun tramp-parse-passwd-group ()
6319 "Return a (user host) tuple allowed to access.
6320 Host is always \"localhost\"."
6321 (let ((result)
6322 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
6323 (narrow-to-region (point) (tramp-compat-line-end-position))
6324 (when (re-search-forward regexp nil t)
6325 (setq result (list (match-string 1) "localhost")))
6326 (widen)
6327 (forward-line 1)
6328 result))
6329
6330 (defun tramp-parse-netrc (filename)
6331 "Return a list of (user host) tuples allowed to access.
6332 User may be nil."
6333 ;; On Windows, there are problems in completion when
6334 ;; `default-directory' is remote.
6335 (let ((default-directory (tramp-compat-temporary-file-directory))
6336 res)
6337 (when (file-readable-p filename)
6338 (with-temp-buffer
6339 (insert-file-contents filename)
6340 (goto-char (point-min))
6341 (while (not (eobp))
6342 (push (tramp-parse-netrc-group) res))))
6343 res))
6344
6345 (defun tramp-parse-netrc-group ()
6346 "Return a (user host) tuple allowed to access.
6347 User may be nil."
6348 (let ((result)
6349 (regexp
6350 (concat
6351 "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
6352 "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
6353 (narrow-to-region (point) (tramp-compat-line-end-position))
6354 (when (re-search-forward regexp nil t)
6355 (setq result (list (match-string 3) (match-string 1))))
6356 (widen)
6357 (forward-line 1)
6358 result))
6359
6360 (defun tramp-parse-putty (registry)
6361 "Return a list of (user host) tuples allowed to access.
6362 User is always nil."
6363 ;; On Windows, there are problems in completion when
6364 ;; `default-directory' is remote.
6365 (let ((default-directory (tramp-compat-temporary-file-directory))
6366 res)
6367 (with-temp-buffer
6368 (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
6369 (goto-char (point-min))
6370 (while (not (eobp))
6371 (push (tramp-parse-putty-group registry) res))))
6372 res))
6373
6374 (defun tramp-parse-putty-group (registry)
6375 "Return a (user host) tuple allowed to access.
6376 User is always nil."
6377 (let ((result)
6378 (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
6379 (narrow-to-region (point) (tramp-compat-line-end-position))
6380 (when (re-search-forward regexp nil t)
6381 (setq result (list nil (match-string 1))))
6382 (widen)
6383 (forward-line 1)
6384 result))
6385
6386 ;;; Internal Functions:
6387
6388 (defun tramp-maybe-send-script (vec script name)
6389 "Define in remote shell function NAME implemented as SCRIPT.
6390 Only send the definition if it has not already been done."
6391 (let* ((p (tramp-get-connection-process vec))
6392 (scripts (tramp-get-connection-property p "scripts" nil)))
6393 (unless (member name scripts)
6394 (with-progress-reporter vec 5 (format "Sending script `%s'" name)
6395 ;; The script could contain a call of Perl. This is masked with `%s'.
6396 (tramp-send-command-and-check
6397 vec
6398 (format "%s () {\n%s\n}" name
6399 (format script (tramp-get-remote-perl vec))))
6400 (tramp-set-connection-property p "scripts" (cons name scripts))))))
6401
6402 (defun tramp-set-auto-save ()
6403 (when (and ;; ange-ftp has its own auto-save mechanism
6404 (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
6405 'tramp-sh-file-name-handler)
6406 auto-save-default)
6407 (auto-save-mode 1)))
6408 (add-hook 'find-file-hooks 'tramp-set-auto-save t)
6409 (add-hook 'tramp-unload-hook
6410 (lambda ()
6411 (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
6412
6413 (defun tramp-run-test (switch filename)
6414 "Run `test' on the remote system, given a SWITCH and a FILENAME.
6415 Returns the exit code of the `test' program."
6416 (with-parsed-tramp-file-name filename nil
6417 (tramp-send-command-and-check
6418 v
6419 (format
6420 "%s %s %s"
6421 (tramp-get-test-command v)
6422 switch
6423 (tramp-shell-quote-argument localname)))))
6424
6425 (defun tramp-run-test2 (format-string file1 file2)
6426 "Run `test'-like program on the remote system, given FILE1, FILE2.
6427 FORMAT-STRING contains the program name, switches, and place holders.
6428 Returns the exit code of the `test' program. Barfs if the methods,
6429 hosts, or files, disagree."
6430 (unless (tramp-equal-remote file1 file2)
6431 (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
6432 (tramp-error
6433 v 'file-error
6434 "tramp-run-test2 only implemented for same method, user, host")))
6435 (with-parsed-tramp-file-name file1 v1
6436 (with-parsed-tramp-file-name file1 v2
6437 (tramp-send-command-and-check
6438 v1
6439 (format format-string
6440 (tramp-shell-quote-argument v1-localname)
6441 (tramp-shell-quote-argument v2-localname))))))
6442
6443 (defun tramp-buffer-name (vec)
6444 "A name for the connection buffer VEC."
6445 ;; We must use `tramp-file-name-real-host', because for gateway
6446 ;; methods the default port will be expanded later on, which would
6447 ;; tamper the name.
6448 (let ((method (tramp-file-name-method vec))
6449 (user (tramp-file-name-user vec))
6450 (host (tramp-file-name-real-host vec)))
6451 (if (not (zerop (length user)))
6452 (format "*tramp/%s %s@%s*" method user host)
6453 (format "*tramp/%s %s*" method host))))
6454
6455 (defun tramp-delete-temp-file-function ()
6456 "Remove temporary files related to current buffer."
6457 (when (stringp tramp-temp-buffer-file-name)
6458 (condition-case nil
6459 (delete-file tramp-temp-buffer-file-name)
6460 (error nil))))
6461
6462 (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
6463 (add-hook 'tramp-cache-unload-hook
6464 (lambda ()
6465 (remove-hook 'kill-buffer-hook
6466 'tramp-delete-temp-file-function)))
6467
6468 (defun tramp-get-buffer (vec)
6469 "Get the connection buffer to be used for VEC."
6470 (or (get-buffer (tramp-buffer-name vec))
6471 (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
6472 (setq buffer-undo-list t)
6473 (setq default-directory
6474 (tramp-make-tramp-file-name
6475 (tramp-file-name-method vec)
6476 (tramp-file-name-user vec)
6477 (tramp-file-name-host vec)
6478 "/"))
6479 (current-buffer))))
6480
6481 (defun tramp-get-connection-buffer (vec)
6482 "Get the connection buffer to be used for VEC.
6483 In case a second asynchronous communication has been started, it is different
6484 from `tramp-get-buffer'."
6485 (or (tramp-get-connection-property vec "process-buffer" nil)
6486 (tramp-get-buffer vec)))
6487
6488 (defun tramp-get-connection-process (vec)
6489 "Get the connection process to be used for VEC.
6490 In case a second asynchronous communication has been started, it is different
6491 from the default one."
6492 (get-process
6493 (or (tramp-get-connection-property vec "process-name" nil)
6494 (tramp-buffer-name vec))))
6495
6496 (defun tramp-debug-buffer-name (vec)
6497 "A name for the debug buffer for VEC."
6498 ;; We must use `tramp-file-name-real-host', because for gateway
6499 ;; methods the default port will be expanded later on, which would
6500 ;; tamper the name.
6501 (let ((method (tramp-file-name-method vec))
6502 (user (tramp-file-name-user vec))
6503 (host (tramp-file-name-real-host vec)))
6504 (if (not (zerop (length user)))
6505 (format "*debug tramp/%s %s@%s*" method user host)
6506 (format "*debug tramp/%s %s*" method host))))
6507
6508 (defconst tramp-debug-outline-regexp
6509 "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
6510
6511 (defun tramp-get-debug-buffer (vec)
6512 "Get the debug buffer for VEC."
6513 (with-current-buffer
6514 (get-buffer-create (tramp-debug-buffer-name vec))
6515 (when (bobp)
6516 (setq buffer-undo-list t)
6517 ;; Activate `outline-mode'. This runs `text-mode-hook' and
6518 ;; `outline-mode-hook'. We must prevent that local processes
6519 ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
6520 ;; Furthermore, `outline-regexp' must have the correct value
6521 ;; already, because it is used by `font-lock-compile-keywords'.
6522 (let ((default-directory (tramp-compat-temporary-file-directory))
6523 (outline-regexp tramp-debug-outline-regexp))
6524 (outline-mode))
6525 (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
6526 (set (make-local-variable 'outline-level) 'tramp-outline-level))
6527 (current-buffer)))
6528
6529 (defun tramp-outline-level ()
6530 "Return the depth to which a statement is nested in the outline.
6531 Point must be at the beginning of a header line.
6532
6533 The outline level is equal to the verbosity of the Tramp message."
6534 (1+ (string-to-number (match-string 1))))
6535
6536 (defun tramp-find-executable
6537 (vec progname dirlist &optional ignore-tilde ignore-path)
6538 "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
6539 First arg VEC specifies the connection, PROGNAME is the program
6540 to search for, and DIRLIST gives the list of directories to
6541 search. If IGNORE-TILDE is non-nil, directory names starting
6542 with `~' will be ignored. If IGNORE-PATH is non-nil, searches
6543 only in DIRLIST.
6544
6545 Returns the absolute file name of PROGNAME, if found, and nil otherwise.
6546
6547 This function expects to be in the right *tramp* buffer."
6548 (with-current-buffer (tramp-get-connection-buffer vec)
6549 (let (result)
6550 ;; Check whether the executable is in $PATH. "which(1)" does not
6551 ;; report always a correct error code; therefore we check the
6552 ;; number of words it returns.
6553 (unless ignore-path
6554 (tramp-send-command vec (format "which \\%s | wc -w" progname))
6555 (goto-char (point-min))
6556 (if (looking-at "^\\s-*1$")
6557 (setq result (concat "\\" progname))))
6558 (unless result
6559 (when ignore-tilde
6560 ;; Remove all ~/foo directories from dirlist. In XEmacs,
6561 ;; `remove' is in CL, and we want to avoid CL dependencies.
6562 (let (newdl d)
6563 (while dirlist
6564 (setq d (car dirlist))
6565 (setq dirlist (cdr dirlist))
6566 (unless (char-equal ?~ (aref d 0))
6567 (setq newdl (cons d newdl))))
6568 (setq dirlist (nreverse newdl))))
6569 (tramp-send-command
6570 vec
6571 (format (concat "while read d; "
6572 "do if test -x $d/%s -a -f $d/%s; "
6573 "then echo tramp_executable $d/%s; "
6574 "break; fi; done <<'EOF'\n"
6575 "%s\nEOF")
6576 progname progname progname (mapconcat 'identity dirlist "\n")))
6577 (goto-char (point-max))
6578 (when (search-backward "tramp_executable " nil t)
6579 (skip-chars-forward "^ ")
6580 (skip-chars-forward " ")
6581 (setq result (buffer-substring
6582 (point) (tramp-compat-line-end-position)))))
6583 result)))
6584
6585 (defun tramp-set-remote-path (vec)
6586 "Sets the remote environment PATH to existing directories.
6587 I.e., for each directory in `tramp-remote-path', it is tested
6588 whether it exists and if so, it is added to the environment
6589 variable PATH."
6590 (tramp-message vec 5 (format "Setting $PATH environment variable"))
6591 (tramp-send-command
6592 vec (format "PATH=%s; export PATH"
6593 (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
6594
6595 ;; ------------------------------------------------------------
6596 ;; -- Communication with external shell --
6597 ;; ------------------------------------------------------------
6598
6599 (defun tramp-find-file-exists-command (vec)
6600 "Find a command on the remote host for checking if a file exists.
6601 Here, we are looking for a command which has zero exit status if the
6602 file exists and nonzero exit status otherwise."
6603 (let ((existing "/")
6604 (nonexisting
6605 (tramp-shell-quote-argument "/ this file does not exist "))
6606 result)
6607 ;; The algorithm is as follows: we try a list of several commands.
6608 ;; For each command, we first run `$cmd /' -- this should return
6609 ;; true, as the root directory always exists. And then we run
6610 ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
6611 ;; does not exist. This should return false. We use the first
6612 ;; command we find that seems to work.
6613 ;; The list of commands to try is as follows:
6614 ;; `ls -d' This works on most systems, but NetBSD 1.4
6615 ;; has a bug: `ls' always returns zero exit
6616 ;; status, even for files which don't exist.
6617 ;; `test -e' Some Bourne shells have a `test' builtin
6618 ;; which does not know the `-e' option.
6619 ;; `/bin/test -e' For those, the `test' binary on disk normally
6620 ;; provides the option. Alas, the binary
6621 ;; is sometimes `/bin/test' and sometimes it's
6622 ;; `/usr/bin/test'.
6623 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
6624 (unless (or
6625 (and (setq result (format "%s -e" (tramp-get-test-command vec)))
6626 (zerop (tramp-send-command-and-check
6627 vec (format "%s %s" result existing)))
6628 (not (zerop (tramp-send-command-and-check
6629 vec (format "%s %s" result nonexisting)))))
6630 (and (setq result "/bin/test -e")
6631 (zerop (tramp-send-command-and-check
6632 vec (format "%s %s" result existing)))
6633 (not (zerop (tramp-send-command-and-check
6634 vec (format "%s %s" result nonexisting)))))
6635 (and (setq result "/usr/bin/test -e")
6636 (zerop (tramp-send-command-and-check
6637 vec (format "%s %s" result existing)))
6638 (not (zerop (tramp-send-command-and-check
6639 vec (format "%s %s" result nonexisting)))))
6640 (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
6641 (zerop (tramp-send-command-and-check
6642 vec (format "%s %s" result existing)))
6643 (not (zerop (tramp-send-command-and-check
6644 vec (format "%s %s" result nonexisting))))))
6645 (tramp-error
6646 vec 'file-error "Couldn't find command to check if file exists"))
6647 result))
6648
6649 (defun tramp-open-shell (vec shell)
6650 "Opens shell SHELL."
6651 (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
6652 ;; Find arguments for this shell.
6653 (let ((tramp-end-of-output tramp-initial-end-of-output)
6654 (alist tramp-sh-extra-args)
6655 item extra-args)
6656 (while (and alist (null extra-args))
6657 (setq item (pop alist))
6658 (when (string-match (car item) shell)
6659 (setq extra-args (cdr item))))
6660 (when extra-args (setq shell (concat shell " " extra-args)))
6661 (tramp-send-command
6662 vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
6663 (shell-quote-argument tramp-end-of-output) shell)
6664 t))
6665 ;; Setting prompts.
6666 (tramp-send-command
6667 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
6668 (tramp-send-command vec "PS2=''" t)
6669 (tramp-send-command vec "PS3=''" t)
6670 (tramp-send-command vec "PROMPT_COMMAND=''" t)))
6671
6672 (defun tramp-find-shell (vec)
6673 "Opens a shell on the remote host which groks tilde expansion."
6674 (unless (tramp-get-connection-property vec "remote-shell" nil)
6675 (let (shell)
6676 (with-current-buffer (tramp-get-buffer vec)
6677 (tramp-send-command vec "echo ~root" t)
6678 (cond
6679 ((or (string-match "^~root$" (buffer-string))
6680 ;; The default shell (ksh93) of OpenSolaris is buggy.
6681 (string-equal (tramp-get-connection-property vec "uname" "")
6682 "SunOS 5.11"))
6683 (setq shell
6684 (or (tramp-find-executable
6685 vec "bash" (tramp-get-remote-path vec) t t)
6686 (tramp-find-executable
6687 vec "ksh" (tramp-get-remote-path vec) t t)))
6688 (unless shell
6689 (tramp-error
6690 vec 'file-error
6691 "Couldn't find a shell which groks tilde expansion"))
6692 (tramp-message
6693 vec 5 "Starting remote shell `%s' for tilde expansion" shell)
6694 (tramp-open-shell vec shell))
6695
6696 (t (tramp-message
6697 vec 5 "Remote `%s' groks tilde expansion, good"
6698 (tramp-set-connection-property
6699 vec "remote-shell"
6700 (tramp-get-method-parameter
6701 (tramp-file-name-method vec) 'tramp-remote-sh)))))))))
6702
6703 ;; ------------------------------------------------------------
6704 ;; -- Functions for establishing connection --
6705 ;; ------------------------------------------------------------
6706
6707 ;; The following functions are actions to be taken when seeing certain
6708 ;; prompts from the remote host. See the variable
6709 ;; `tramp-actions-before-shell' for usage of these functions.
6710
6711 (defun tramp-action-login (proc vec)
6712 "Send the login name."
6713 (when (not (stringp tramp-current-user))
6714 (save-window-excursion
6715 (let ((enable-recursive-minibuffers t))
6716 (pop-to-buffer (tramp-get-connection-buffer vec))
6717 (setq tramp-current-user (read-string (match-string 0))))))
6718 (tramp-message vec 3 "Sending login name `%s'" tramp-current-user)
6719 (with-current-buffer (tramp-get-connection-buffer vec)
6720 (tramp-message vec 6 "\n%s" (buffer-string)))
6721 (tramp-send-string vec tramp-current-user))
6722
6723 (defun tramp-action-password (proc vec)
6724 "Query the user for a password."
6725 (with-current-buffer (process-buffer proc)
6726 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
6727 (tramp-message vec 3 "Sending %s" (match-string 1))
6728 (tramp-enter-password proc)
6729 ;; Hide password prompt.
6730 (narrow-to-region (point-max) (point-max))))
6731
6732 (defun tramp-action-succeed (proc vec)
6733 "Signal success in finding shell prompt."
6734 (throw 'tramp-action 'ok))
6735
6736 (defun tramp-action-permission-denied (proc vec)
6737 "Signal permission denied."
6738 (kill-process proc)
6739 (throw 'tramp-action 'permission-denied))
6740
6741 (defun tramp-action-yesno (proc vec)
6742 "Ask the user for confirmation using `yes-or-no-p'.
6743 Send \"yes\" to remote process on confirmation, abort otherwise.
6744 See also `tramp-action-yn'."
6745 (save-window-excursion
6746 (let ((enable-recursive-minibuffers t))
6747 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
6748 (unless (yes-or-no-p (match-string 0))
6749 (kill-process proc)
6750 (throw 'tramp-action 'permission-denied))
6751 (with-current-buffer (tramp-get-connection-buffer vec)
6752 (tramp-message vec 6 "\n%s" (buffer-string)))
6753 (tramp-send-string vec "yes"))))
6754
6755 (defun tramp-action-yn (proc vec)
6756 "Ask the user for confirmation using `y-or-n-p'.
6757 Send \"y\" to remote process on confirmation, abort otherwise.
6758 See also `tramp-action-yesno'."
6759 (save-window-excursion
6760 (let ((enable-recursive-minibuffers t))
6761 (save-match-data (pop-to-buffer (tramp-get-connection-buffer vec)))
6762 (unless (y-or-n-p (match-string 0))
6763 (kill-process proc)
6764 (throw 'tramp-action 'permission-denied))
6765 (with-current-buffer (tramp-get-connection-buffer vec)
6766 (tramp-message vec 6 "\n%s" (buffer-string)))
6767 (tramp-send-string vec "y"))))
6768
6769 (defun tramp-action-terminal (proc vec)
6770 "Tell the remote host which terminal type to use.
6771 The terminal type can be configured with `tramp-terminal-type'."
6772 (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
6773 (with-current-buffer (tramp-get-connection-buffer vec)
6774 (tramp-message vec 6 "\n%s" (buffer-string)))
6775 (tramp-send-string vec tramp-terminal-type))
6776
6777 (defun tramp-action-process-alive (proc vec)
6778 "Check, whether a process has finished."
6779 (unless (memq (process-status proc) '(run open))
6780 (throw 'tramp-action 'process-died)))
6781
6782 (defun tramp-action-out-of-band (proc vec)
6783 "Check, whether an out-of-band copy has finished."
6784 (cond ((and (memq (process-status proc) '(stop exit))
6785 (zerop (process-exit-status proc)))
6786 (tramp-message vec 3 "Process has finished.")
6787 (throw 'tramp-action 'ok))
6788 ((or (and (memq (process-status proc) '(stop exit))
6789 (not (zerop (process-exit-status proc))))
6790 (memq (process-status proc) '(signal)))
6791 ;; `scp' could have copied correctly, but set modes could have failed.
6792 ;; This can be ignored.
6793 (with-current-buffer (process-buffer proc)
6794 (goto-char (point-min))
6795 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
6796 (progn
6797 (tramp-message vec 5 "'set mode' error ignored.")
6798 (tramp-message vec 3 "Process has finished.")
6799 (throw 'tramp-action 'ok))
6800 (tramp-message vec 3 "Process has died.")
6801 (throw 'tramp-action 'process-died))))
6802 (t nil)))
6803
6804 ;; Functions for processing the actions.
6805
6806 (defun tramp-process-one-action (proc vec actions)
6807 "Wait for output from the shell and perform one action."
6808 (let (found todo item pattern action)
6809 (while (not found)
6810 ;; Reread output once all actions have been performed.
6811 ;; Obviously, the output was not complete.
6812 (tramp-accept-process-output proc 1)
6813 (setq todo actions)
6814 (while todo
6815 (setq item (pop todo))
6816 (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
6817 (setq action (nth 1 item))
6818 (tramp-message
6819 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
6820 (when (tramp-check-for-regexp proc pattern)
6821 (tramp-message vec 5 "Call `%s'" (symbol-name action))
6822 (setq found (funcall action proc vec)))))
6823 found))
6824
6825 (defun tramp-process-actions (proc vec pos actions &optional timeout)
6826 "Perform ACTIONS until success or TIMEOUT.
6827 PROC and VEC indicate the remote connection to be used. POS, if
6828 set, is the starting point of the region to be deleted in the
6829 connection buffer."
6830 ;; Preserve message for `progress-reporter'.
6831 (with-temp-message ""
6832 ;; Enable auth-source and password-cache.
6833 (tramp-set-connection-property vec "first-password-request" t)
6834 (save-restriction
6835 (let (exit)
6836 (while (not exit)
6837 (tramp-message proc 3 "Waiting for prompts from remote shell")
6838 (setq exit
6839 (catch 'tramp-action
6840 (if timeout
6841 (with-timeout (timeout)
6842 (tramp-process-one-action proc vec actions))
6843 (tramp-process-one-action proc vec actions)))))
6844 (with-current-buffer (tramp-get-connection-buffer vec)
6845 (widen)
6846 (tramp-message vec 6 "\n%s" (buffer-string)))
6847 (unless (eq exit 'ok)
6848 (tramp-clear-passwd vec)
6849 (tramp-error-with-buffer
6850 nil vec 'file-error
6851 (cond
6852 ((eq exit 'permission-denied) "Permission denied")
6853 ((eq exit 'process-died) "Process died")
6854 (t "Login failed"))))
6855 (when (numberp pos)
6856 (with-current-buffer (tramp-get-connection-buffer vec)
6857 (let (buffer-read-only) (delete-region pos (point)))))))))
6858
6859 ;; Utility functions.
6860
6861 (defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
6862 "Like `accept-process-output' for Tramp processes.
6863 This is needed in order to hide `last-coding-system-used', which is set
6864 for process communication also."
6865 (with-current-buffer (process-buffer proc)
6866 (tramp-message proc 10 "%s %s" proc (process-status proc))
6867 (let (buffer-read-only last-coding-system-used)
6868 ;; Under Windows XP, accept-process-output doesn't return
6869 ;; sometimes. So we add an additional timeout.
6870 (with-timeout ((or timeout 1))
6871 (accept-process-output proc timeout timeout-msecs)))
6872 (tramp-message proc 10 "\n%s" (buffer-string))))
6873
6874 (defun tramp-check-for-regexp (proc regexp)
6875 "Check, whether REGEXP is contained in process buffer of PROC.
6876 Erase echoed commands if exists."
6877 (with-current-buffer (process-buffer proc)
6878 (goto-char (point-min))
6879
6880 ;; Check whether we need to remove echo output.
6881 (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
6882 (re-search-forward tramp-echoed-echo-mark-regexp nil t))
6883 (let ((begin (match-beginning 0)))
6884 (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
6885 ;; Discard echo from remote output.
6886 (tramp-set-connection-property proc "check-remote-echo" nil)
6887 (tramp-message proc 5 "echo-mark found")
6888 (forward-line 1)
6889 (delete-region begin (point))
6890 (goto-char (point-min)))))
6891
6892 (when (or (not (tramp-get-connection-property proc "check-remote-echo" nil))
6893 ;; Sometimes, the echo string is suppressed on the remote side.
6894 (not (string-equal
6895 (tramp-compat-funcall
6896 'substring-no-properties tramp-echo-mark-marker
6897 0 (min tramp-echo-mark-marker-length (1- (point-max))))
6898 (tramp-compat-funcall
6899 'buffer-substring-no-properties
6900 1 (min (1+ tramp-echo-mark-marker-length) (point-max))))))
6901 ;; No echo to be handled, now we can look for the regexp.
6902 (goto-char (point-min))
6903 (re-search-forward regexp nil t))))
6904
6905 (defun tramp-wait-for-regexp (proc timeout regexp)
6906 "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
6907 Expects the output of PROC to be sent to the current buffer. Returns
6908 the string that matched, or nil. Waits indefinitely if TIMEOUT is
6909 nil."
6910 (with-current-buffer (process-buffer proc)
6911 (let ((found (tramp-check-for-regexp proc regexp))
6912 (start-time (current-time)))
6913 (cond (timeout
6914 ;; Work around a bug in XEmacs 21, where the timeout
6915 ;; expires faster than it should. This degenerates
6916 ;; to polling for buggy XEmacsen, but oh, well.
6917 (while (and (not found)
6918 (< (tramp-time-diff (current-time) start-time)
6919 timeout))
6920 (with-timeout (timeout)
6921 (while (not found)
6922 (tramp-accept-process-output proc 1)
6923 (unless (memq (process-status proc) '(run open))
6924 (tramp-error-with-buffer
6925 nil proc 'file-error "Process has died"))
6926 (setq found (tramp-check-for-regexp proc regexp))))))
6927 (t
6928 (while (not found)
6929 (tramp-accept-process-output proc 1)
6930 (unless (memq (process-status proc) '(run open))
6931 (tramp-error-with-buffer
6932 nil proc 'file-error "Process has died"))
6933 (setq found (tramp-check-for-regexp proc regexp)))))
6934 (tramp-message proc 6 "\n%s" (buffer-string))
6935 (when (not found)
6936 (if timeout
6937 (tramp-error
6938 proc 'file-error "[[Regexp `%s' not found in %d secs]]"
6939 regexp timeout)
6940 (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
6941 found)))
6942
6943 (defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
6944 "Wait for shell prompt and barf if none appears.
6945 Looks at process PROC to see if a shell prompt appears in TIMEOUT
6946 seconds. If not, it produces an error message with the given ERROR-ARGS."
6947 (unless
6948 (tramp-wait-for-regexp
6949 proc timeout
6950 (format
6951 "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
6952 (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
6953
6954 ;; We don't call `tramp-send-string' in order to hide the password
6955 ;; from the debug buffer, and because end-of-line handling of the
6956 ;; string.
6957 (defun tramp-enter-password (proc)
6958 "Prompt for a password and send it to the remote end."
6959 (process-send-string
6960 proc (concat (tramp-read-passwd proc)
6961 (or (tramp-get-method-parameter
6962 tramp-current-method
6963 'tramp-password-end-of-line)
6964 tramp-default-password-end-of-line))))
6965
6966 (defun tramp-open-connection-setup-interactive-shell (proc vec)
6967 "Set up an interactive shell.
6968 Mainly sets the prompt and the echo correctly. PROC is the shell
6969 process to set up. VEC specifies the connection."
6970 (let ((tramp-end-of-output tramp-initial-end-of-output))
6971 ;; It is useful to set the prompt in the following command because
6972 ;; some people have a setting for $PS1 which /bin/sh doesn't know
6973 ;; about and thus /bin/sh will display a strange prompt. For
6974 ;; example, if $PS1 has "${CWD}" in the value, then ksh will
6975 ;; display the current working directory but /bin/sh will display
6976 ;; a dollar sign. The following command line sets $PS1 to a sane
6977 ;; value, and works under Bourne-ish shells as well as csh-like
6978 ;; shells. Daniel Pittman reports that the unusual positioning of
6979 ;; the single quotes makes it work under `rc', too. We also unset
6980 ;; the variable $ENV because that is read by some sh
6981 ;; implementations (eg, bash when called as sh) on startup; this
6982 ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
6983 ;; is another way to set the prompt in /bin/bash, it must be
6984 ;; discarded as well.
6985 (tramp-open-shell
6986 vec
6987 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh))
6988
6989 ;; Disable echo.
6990 (tramp-message vec 5 "Setting up remote shell environment")
6991 (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
6992 ;; Check whether the echo has really been disabled. Some
6993 ;; implementations, like busybox of embedded GNU/Linux, don't
6994 ;; support disabling.
6995 (tramp-send-command vec "echo foo" t)
6996 (with-current-buffer (process-buffer proc)
6997 (goto-char (point-min))
6998 (when (looking-at "echo foo")
6999 (tramp-set-connection-property proc "remote-echo" t)
7000 (tramp-message vec 5 "Remote echo still on. Ok.")
7001 ;; Make sure backspaces and their echo are enabled and no line
7002 ;; width magic interferes with them.
7003 (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
7004
7005 (tramp-message vec 5 "Setting shell prompt")
7006 (tramp-send-command
7007 vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
7008 (tramp-send-command vec "PS2=''" t)
7009 (tramp-send-command vec "PS3=''" t)
7010 (tramp-send-command vec "PROMPT_COMMAND=''" t)
7011
7012 ;; Try to set up the coding system correctly.
7013 ;; CCC this can't be the right way to do it. Hm.
7014 (tramp-message vec 5 "Determining coding system")
7015 (tramp-send-command vec "echo foo ; echo bar" t)
7016 (with-current-buffer (process-buffer proc)
7017 (goto-char (point-min))
7018 (if (featurep 'mule)
7019 ;; Use MULE to select the right EOL convention for communicating
7020 ;; with the process.
7021 (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
7022 (cons 'undecided 'undecided)))
7023 cs-decode cs-encode)
7024 (when (symbolp cs) (setq cs (cons cs cs)))
7025 (setq cs-decode (car cs))
7026 (setq cs-encode (cdr cs))
7027 (unless cs-decode (setq cs-decode 'undecided))
7028 (unless cs-encode (setq cs-encode 'undecided))
7029 (setq cs-encode (tramp-coding-system-change-eol-conversion
7030 cs-encode 'unix))
7031 (when (search-forward "\r" nil t)
7032 (setq cs-decode (tramp-coding-system-change-eol-conversion
7033 cs-decode 'dos)))
7034 (tramp-compat-funcall
7035 'set-buffer-process-coding-system cs-decode cs-encode)
7036 (tramp-message
7037 vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
7038 ;; Look for ^M and do something useful if found.
7039 (when (search-forward "\r" nil t)
7040 ;; We have found a ^M but cannot frob the process coding system
7041 ;; because we're running on a non-MULE Emacs. Let's try
7042 ;; stty, instead.
7043 (tramp-send-command vec "stty -onlcr" t))))
7044
7045 (tramp-send-command vec "set +o vi +o emacs" t)
7046
7047 ;; Check whether the output of "uname -sr" has been changed. If
7048 ;; yes, this is a strong indication that we must expire all
7049 ;; connection properties. We start again with
7050 ;; `tramp-maybe-open-connection', it will be catched there.
7051 (tramp-message vec 5 "Checking system information")
7052 (let ((old-uname (tramp-get-connection-property vec "uname" nil))
7053 (new-uname
7054 (tramp-set-connection-property
7055 vec "uname"
7056 (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
7057 (when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
7058 (with-current-buffer (tramp-get-debug-buffer vec)
7059 ;; Keep the debug buffer.
7060 (rename-buffer
7061 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
7062 (tramp-compat-funcall 'tramp-cleanup-connection vec)
7063 (if (= (point-min) (point-max))
7064 (kill-buffer nil)
7065 (rename-buffer (tramp-debug-buffer-name vec) 'unique))
7066 ;; We call `tramp-get-buffer' in order to keep the debug buffer.
7067 (tramp-get-buffer vec)
7068 (tramp-message
7069 vec 3
7070 "Connection reset, because remote host changed from `%s' to `%s'"
7071 old-uname new-uname)
7072 (throw 'uname-changed (tramp-maybe-open-connection vec)))))
7073
7074 ;; Check whether the remote host suffers from buggy
7075 ;; `send-process-string'. This is known for FreeBSD (see comment in
7076 ;; `send_process', file process.c). I've tested sending 624 bytes
7077 ;; successfully, sending 625 bytes failed. Emacs makes a hack when
7078 ;; this host type is detected locally. It cannot handle remote
7079 ;; hosts, though.
7080 (with-connection-property proc "chunksize"
7081 (cond
7082 ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
7083 tramp-chunksize)
7084 (t
7085 (tramp-message
7086 vec 5 "Checking remote host type for `send-process-string' bug")
7087 (if (string-match
7088 "^FreeBSD" (tramp-get-connection-property vec "uname" ""))
7089 500 0))))
7090
7091 ;; Set remote PATH variable.
7092 (tramp-set-remote-path vec)
7093
7094 ;; Search for a good shell before searching for a command which
7095 ;; checks if a file exists. This is done because Tramp wants to use
7096 ;; "test foo; echo $?" to check if various conditions hold, and
7097 ;; there are buggy /bin/sh implementations which don't execute the
7098 ;; "echo $?" part if the "test" part has an error. In particular,
7099 ;; the OpenSolaris /bin/sh is a problem. There are also other
7100 ;; problems with /bin/sh of OpenSolaris, like redirection of stderr
7101 ;; in function declarations, or changing HISTFILE in place.
7102 ;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when
7103 ;; detected.
7104 (tramp-find-shell vec)
7105
7106 ;; Disable unexpected output.
7107 (tramp-send-command vec "mesg n; biff n" t)
7108
7109 ;; IRIX64 bash expands "!" even when in single quotes. This
7110 ;; destroys our shell functions, we must disable it. See
7111 ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
7112 (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" ""))
7113 (tramp-send-command vec "set +H" t))
7114
7115 ;; On BSD-like systems, ?\t is expanded to spaces. Suppress this.
7116 (when (string-match "BSD\\|Darwin"
7117 (tramp-get-connection-property vec "uname" ""))
7118 (tramp-send-command vec "stty -oxtabs" t))
7119
7120 ;; Set `remote-tty' process property.
7121 (ignore-errors
7122 (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
7123 (unless (zerop (length tty))
7124 (tramp-compat-process-put proc 'remote-tty tty))))
7125
7126 ;; Dump stty settings in the traces.
7127 (when (>= tramp-verbose 9)
7128 (tramp-send-command vec "stty -a" t))
7129
7130 ;; Set the environment.
7131 (tramp-message vec 5 "Setting default environment")
7132
7133 (let ((env (copy-sequence tramp-remote-process-environment))
7134 unset item)
7135 (while env
7136 (setq item (tramp-compat-split-string (car env) "="))
7137 (setcdr item (mapconcat 'identity (cdr item) "="))
7138 (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
7139 (tramp-send-command
7140 vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t)
7141 (push (car item) unset))
7142 (setq env (cdr env)))
7143 (when unset
7144 (tramp-send-command
7145 vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
7146
7147 ;; CCC: We should either implement a Perl version of base64 encoding
7148 ;; and decoding. Then we just use that in the last item. The other
7149 ;; alternative is to use the Perl version of UU encoding. But then
7150 ;; we need a Lisp version of uuencode.
7151 ;;
7152 ;; Old text from documentation of tramp-methods:
7153 ;; Using a uuencode/uudecode inline method is discouraged, please use one
7154 ;; of the base64 methods instead since base64 encoding is much more
7155 ;; reliable and the commands are more standardized between the different
7156 ;; Unix versions. But if you can't use base64 for some reason, please
7157 ;; note that the default uudecode command does not work well for some
7158 ;; Unices, in particular AIX and Irix. For AIX, you might want to use
7159 ;; the following command for uudecode:
7160 ;;
7161 ;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
7162 ;;
7163 ;; For Irix, no solution is known yet.
7164
7165 (defconst tramp-local-coding-commands
7166 '((b64 base64-encode-region base64-decode-region)
7167 (uu tramp-uuencode-region uudecode-decode-region)
7168 (pack
7169 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7170 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7171 "List of local coding commands for inline transfer.
7172 Each item is a list that looks like this:
7173
7174 \(FORMAT ENCODING DECODING\)
7175
7176 FORMAT is symbol describing the encoding/decoding format. It can be
7177 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7178
7179 ENCODING and DECODING can be strings, giving commands, or symbols,
7180 giving functions. If they are strings, then they can contain
7181 the \"%s\" format specifier. If that specifier is present, the input
7182 filename will be put into the command line at that spot. If the
7183 specifier is not present, the input should be read from standard
7184 input.
7185
7186 If they are functions, they will be called with two arguments, start
7187 and end of region, and are expected to replace the region contents
7188 with the encoded or decoded results, respectively.")
7189
7190 (defconst tramp-remote-coding-commands
7191 '((b64 "base64" "base64 -d -i")
7192 ;; "-i" is more robust with older base64 from GNU coreutils.
7193 ;; However, I don't know whether all base64 versions do supports
7194 ;; this option.
7195 (b64 "base64" "base64 -d")
7196 (b64 "mimencode -b" "mimencode -u -b")
7197 (b64 "mmencode -b" "mmencode -u -b")
7198 (b64 "recode data..base64" "recode base64..data")
7199 (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
7200 (b64 tramp-perl-encode tramp-perl-decode)
7201 (uu "uuencode xxx" "uudecode -o /dev/stdout")
7202 (uu "uuencode xxx" "uudecode -o -")
7203 (uu "uuencode xxx" "uudecode -p")
7204 (uu "uuencode xxx" tramp-uudecode)
7205 (pack
7206 "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
7207 "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
7208 "List of remote coding commands for inline transfer.
7209 Each item is a list that looks like this:
7210
7211 \(FORMAT ENCODING DECODING\)
7212
7213 FORMAT is symbol describing the encoding/decoding format. It can be
7214 `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
7215
7216 ENCODING and DECODING can be strings, giving commands, or symbols,
7217 giving variables. If they are strings, then they can contain
7218 the \"%s\" format specifier. If that specifier is present, the input
7219 filename will be put into the command line at that spot. If the
7220 specifier is not present, the input should be read from standard
7221 input.
7222
7223 If they are variables, this variable is a string containing a Perl
7224 implementation for this functionality. This Perl program will be transferred
7225 to the remote host, and it is available as shell function with the same name.")
7226
7227 (defun tramp-find-inline-encoding (vec)
7228 "Find an inline transfer encoding that works.
7229 Goes through the list `tramp-local-coding-commands' and
7230 `tramp-remote-coding-commands'."
7231 (save-excursion
7232 (let ((local-commands tramp-local-coding-commands)
7233 (magic "xyzzy")
7234 loc-enc loc-dec rem-enc rem-dec litem ritem found)
7235 (while (and local-commands (not found))
7236 (setq litem (pop local-commands))
7237 (catch 'wont-work-local
7238 (let ((format (nth 0 litem))
7239 (remote-commands tramp-remote-coding-commands))
7240 (setq loc-enc (nth 1 litem))
7241 (setq loc-dec (nth 2 litem))
7242 ;; If the local encoder or decoder is a string, the
7243 ;; corresponding command has to work locally.
7244 (if (not (stringp loc-enc))
7245 (tramp-message
7246 vec 5 "Checking local encoding function `%s'" loc-enc)
7247 (tramp-message
7248 vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
7249 (unless (zerop (tramp-call-local-coding-command
7250 loc-enc nil nil))
7251 (throw 'wont-work-local nil)))
7252 (if (not (stringp loc-dec))
7253 (tramp-message
7254 vec 5 "Checking local decoding function `%s'" loc-dec)
7255 (tramp-message
7256 vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
7257 (unless (zerop (tramp-call-local-coding-command
7258 loc-dec nil nil))
7259 (throw 'wont-work-local nil)))
7260 ;; Search for remote coding commands with the same format
7261 (while (and remote-commands (not found))
7262 (setq ritem (pop remote-commands))
7263 (catch 'wont-work-remote
7264 (when (equal format (nth 0 ritem))
7265 (setq rem-enc (nth 1 ritem))
7266 (setq rem-dec (nth 2 ritem))
7267 ;; Check if remote encoding and decoding commands can be
7268 ;; called remotely with null input and output. This makes
7269 ;; sure there are no syntax errors and the command is really
7270 ;; found. Note that we do not redirect stdout to /dev/null,
7271 ;; for two reasons: when checking the decoding command, we
7272 ;; actually check the output it gives. And also, when
7273 ;; redirecting "mimencode" output to /dev/null, then as root
7274 ;; it might change the permissions of /dev/null!
7275 (when (not (stringp rem-enc))
7276 (let ((name (symbol-name rem-enc)))
7277 (while (string-match (regexp-quote "-") name)
7278 (setq name (replace-match "_" nil t name)))
7279 (tramp-maybe-send-script vec (symbol-value rem-enc) name)
7280 (setq rem-enc name)))
7281 (tramp-message
7282 vec 5
7283 "Checking remote encoding command `%s' for sanity" rem-enc)
7284 (unless (zerop (tramp-send-command-and-check
7285 vec (format "%s </dev/null" rem-enc) t))
7286 (throw 'wont-work-remote nil))
7287
7288 (when (not (stringp rem-dec))
7289 (let ((name (symbol-name rem-dec)))
7290 (while (string-match (regexp-quote "-") name)
7291 (setq name (replace-match "_" nil t name)))
7292 (tramp-maybe-send-script vec (symbol-value rem-dec) name)
7293 (setq rem-dec name)))
7294 (tramp-message
7295 vec 5
7296 "Checking remote decoding command `%s' for sanity" rem-dec)
7297 (unless (zerop (tramp-send-command-and-check
7298 vec
7299 (format "echo %s | %s | %s"
7300 magic rem-enc rem-dec)
7301 t))
7302 (throw 'wont-work-remote nil))
7303
7304 (with-current-buffer (tramp-get-buffer vec)
7305 (goto-char (point-min))
7306 (unless (looking-at (regexp-quote magic))
7307 (throw 'wont-work-remote nil)))
7308
7309 ;; `rem-enc' and `rem-dec' could be a string meanwhile.
7310 (setq rem-enc (nth 1 ritem))
7311 (setq rem-dec (nth 2 ritem))
7312 (setq found t)))))))
7313
7314 ;; Did we find something?
7315 (unless found
7316 (tramp-error
7317 vec 'file-error "Couldn't find an inline transfer encoding"))
7318
7319 ;; Set connection properties.
7320 (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
7321 (tramp-set-connection-property vec "local-encoding" loc-enc)
7322 (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
7323 (tramp-set-connection-property vec "local-decoding" loc-dec)
7324 (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
7325 (tramp-set-connection-property vec "remote-encoding" rem-enc)
7326 (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
7327 (tramp-set-connection-property vec "remote-decoding" rem-dec))))
7328
7329 (defun tramp-call-local-coding-command (cmd input output)
7330 "Call the local encoding or decoding command.
7331 If CMD contains \"%s\", provide input file INPUT there in command.
7332 Otherwise, INPUT is passed via standard input.
7333 INPUT can also be nil which means `/dev/null'.
7334 OUTPUT can be a string (which specifies a filename), or t (which
7335 means standard output and thus the current buffer), or nil (which
7336 means discard it)."
7337 (tramp-local-call-process
7338 tramp-encoding-shell
7339 (when (and input (not (string-match "%s" cmd))) input)
7340 (if (eq output t) t nil)
7341 nil
7342 tramp-encoding-command-switch
7343 (concat
7344 (if (string-match "%s" cmd) (format cmd input) cmd)
7345 (if (stringp output) (concat "> " output) ""))))
7346
7347 (defconst tramp-inline-compress-commands
7348 '(("gzip" "gzip -d")
7349 ("bzip2" "bzip2 -d")
7350 ("compress" "compress -d"))
7351 "List of compress and decompress commands for inline transfer.
7352 Each item is a list that looks like this:
7353
7354 \(COMPRESS DECOMPRESS\)
7355
7356 COMPRESS or DECOMPRESS are strings with the respective commands.")
7357
7358 (defun tramp-find-inline-compress (vec)
7359 "Find an inline transfer compress command that works.
7360 Goes through the list `tramp-inline-compress-commands'."
7361 (save-excursion
7362 (let ((commands tramp-inline-compress-commands)
7363 (magic "xyzzy")
7364 item compress decompress
7365 found)
7366 (while (and commands (not found))
7367 (catch 'next
7368 (setq item (pop commands)
7369 compress (nth 0 item)
7370 decompress (nth 1 item))
7371 (tramp-message
7372 vec 5
7373 "Checking local compress command `%s', `%s' for sanity"
7374 compress decompress)
7375 (unless
7376 (zerop
7377 (tramp-call-local-coding-command
7378 (format
7379 ;; Windows shells need the program file name after
7380 ;; the pipe symbol be quoted if they use forward
7381 ;; slashes as directory separators.
7382 (if (memq system-type '(windows-nt))
7383 "echo %s | \"%s\" | \"%s\""
7384 "echo %s | %s | %s")
7385 magic compress decompress) nil nil))
7386 (throw 'next nil))
7387 (tramp-message
7388 vec 5
7389 "Checking remote compress command `%s', `%s' for sanity"
7390 compress decompress)
7391 (unless (zerop (tramp-send-command-and-check
7392 vec (format "echo %s | %s | %s"
7393 magic compress decompress) t))
7394 (throw 'next nil))
7395 (setq found t)))
7396
7397 ;; Did we find something?
7398 (if found
7399 (progn
7400 ;; Set connection properties.
7401 (tramp-message
7402 vec 5 "Using inline transfer compress command `%s'" compress)
7403 (tramp-set-connection-property vec "inline-compress" compress)
7404 (tramp-message
7405 vec 5 "Using inline transfer decompress command `%s'" decompress)
7406 (tramp-set-connection-property vec "inline-decompress" decompress))
7407
7408 (tramp-set-connection-property vec "inline-compress" nil)
7409 (tramp-set-connection-property vec "inline-decompress" nil)
7410 (tramp-message
7411 vec 2 "Couldn't find an inline transfer compress command")))))
7412
7413 (defun tramp-compute-multi-hops (vec)
7414 "Expands VEC according to `tramp-default-proxies-alist'.
7415 Gateway hops are already opened."
7416 (let ((target-alist `(,vec))
7417 (choices tramp-default-proxies-alist)
7418 item proxy)
7419
7420 ;; Look for proxy hosts to be passed.
7421 (while choices
7422 (setq item (pop choices)
7423 proxy (eval (nth 2 item)))
7424 (when (and
7425 ;; host
7426 (string-match (or (eval (nth 0 item)) "")
7427 (or (tramp-file-name-host (car target-alist)) ""))
7428 ;; user
7429 (string-match (or (eval (nth 1 item)) "")
7430 (or (tramp-file-name-user (car target-alist)) "")))
7431 (if (null proxy)
7432 ;; No more hops needed.
7433 (setq choices nil)
7434 ;; Replace placeholders.
7435 (setq proxy
7436 (format-spec
7437 proxy
7438 (format-spec-make
7439 ?u (or (tramp-file-name-user (car target-alist)) "")
7440 ?h (or (tramp-file-name-host (car target-alist)) ""))))
7441 (with-parsed-tramp-file-name proxy l
7442 ;; Add the hop.
7443 (add-to-list 'target-alist l)
7444 ;; Start next search.
7445 (setq choices tramp-default-proxies-alist)))))
7446
7447 ;; Handle gateways.
7448 (when (and (boundp 'tramp-gw-tunnel-method)
7449 (string-match (format
7450 "^\\(%s\\|%s\\)$"
7451 (symbol-value 'tramp-gw-tunnel-method)
7452 (symbol-value 'tramp-gw-socks-method))
7453 (tramp-file-name-method (car target-alist))))
7454 (let ((gw (pop target-alist))
7455 (hop (pop target-alist)))
7456 ;; Is the method prepared for gateways?
7457 (unless (tramp-get-method-parameter
7458 (tramp-file-name-method hop) 'tramp-default-port)
7459 (tramp-error
7460 vec 'file-error
7461 "Method `%s' is not supported for gateway access."
7462 (tramp-file-name-method hop)))
7463 ;; Add default port if needed.
7464 (unless
7465 (string-match
7466 tramp-host-with-port-regexp (tramp-file-name-host hop))
7467 (aset hop 2
7468 (concat
7469 (tramp-file-name-host hop) tramp-prefix-port-format
7470 (number-to-string
7471 (tramp-get-method-parameter
7472 (tramp-file-name-method hop) 'tramp-default-port)))))
7473 ;; Open the gateway connection.
7474 (add-to-list
7475 'target-alist
7476 (vector
7477 (tramp-file-name-method hop) (tramp-file-name-user hop)
7478 (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil))
7479 ;; For the password prompt, we need the correct values.
7480 ;; Therefore, we must remember the gateway vector. But we
7481 ;; cannot do it as connection property, because it shouldn't
7482 ;; be persistent. And we have no started process yet either.
7483 (tramp-set-file-property (car target-alist) "" "gateway" hop)))
7484
7485 ;; Foreign and out-of-band methods are not supported for multi-hops.
7486 (when (cdr target-alist)
7487 (setq choices target-alist)
7488 (while choices
7489 (setq item (pop choices))
7490 (when
7491 (or
7492 (not
7493 (tramp-get-method-parameter
7494 (tramp-file-name-method item) 'tramp-login-program))
7495 (tramp-get-method-parameter
7496 (tramp-file-name-method item) 'tramp-copy-program))
7497 (tramp-error
7498 vec 'file-error
7499 "Method `%s' is not supported for multi-hops."
7500 (tramp-file-name-method item)))))
7501
7502 ;; In case the host name is not used for the remote shell
7503 ;; command, the user could be misguided by applying a random
7504 ;; hostname.
7505 (let* ((v (car target-alist))
7506 (method (tramp-file-name-method v))
7507 (host (tramp-file-name-host v)))
7508 (unless
7509 (or
7510 ;; There are multi-hops.
7511 (cdr target-alist)
7512 ;; The host name is used for the remote shell command.
7513 (member
7514 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
7515 ;; The host is local. We cannot use `tramp-local-host-p'
7516 ;; here, because it opens a connection as well.
7517 (string-match tramp-local-host-regexp host))
7518 (tramp-error
7519 v 'file-error
7520 "Host `%s' looks like a remote host, `%s' can only use the local host"
7521 host method)))
7522
7523 ;; Result.
7524 target-alist))
7525
7526 (defun tramp-maybe-open-connection (vec)
7527 "Maybe open a connection VEC.
7528 Does not do anything if a connection is already open, but re-opens the
7529 connection if a previous connection has died for some reason."
7530 (catch 'uname-changed
7531 (let ((p (tramp-get-connection-process vec))
7532 (process-name (tramp-get-connection-property vec "process-name" nil))
7533 (process-environment (copy-sequence process-environment))
7534 (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
7535
7536 ;; If too much time has passed since last command was sent, look
7537 ;; whether process is still alive. If it isn't, kill it. When
7538 ;; using ssh, it can sometimes happen that the remote end has
7539 ;; hung up but the local ssh client doesn't recognize this until
7540 ;; it tries to send some data to the remote end. So that's why
7541 ;; we try to send a command from time to time, then look again
7542 ;; whether the process is really alive.
7543 (condition-case nil
7544 (when (and (> (tramp-time-diff
7545 (current-time)
7546 (tramp-get-connection-property
7547 p "last-cmd-time" '(0 0 0)))
7548 60)
7549 p (processp p) (memq (process-status p) '(run open)))
7550 (tramp-send-command vec "echo are you awake" t t)
7551 (unless (and (memq (process-status p) '(run open))
7552 (tramp-wait-for-output p 10))
7553 ;; The error will be catched locally.
7554 (tramp-error vec 'file-error "Awake did fail")))
7555 (file-error
7556 (tramp-flush-connection-property vec)
7557 (tramp-flush-connection-property p)
7558 (delete-process p)
7559 (setq p nil)))
7560
7561 ;; New connection must be opened.
7562 (unless (and p (processp p) (memq (process-status p) '(run open)))
7563
7564 ;; We call `tramp-get-buffer' in order to get a debug buffer for
7565 ;; messages from the beginning.
7566 (tramp-get-buffer vec)
7567 (with-progress-reporter
7568 vec 3
7569 (if (zerop (length (tramp-file-name-user vec)))
7570 (format "Opening connection for %s using %s"
7571 (tramp-file-name-host vec)
7572 (tramp-file-name-method vec))
7573 (format "Opening connection for %s@%s using %s"
7574 (tramp-file-name-user vec)
7575 (tramp-file-name-host vec)
7576 (tramp-file-name-method vec)))
7577
7578 ;; Start new process.
7579 (when (and p (processp p))
7580 (delete-process p))
7581 (setenv "TERM" tramp-terminal-type)
7582 (setenv "LC_ALL" "C")
7583 (setenv "PROMPT_COMMAND")
7584 (setenv "PS1" tramp-initial-end-of-output)
7585 (let* ((target-alist (tramp-compute-multi-hops vec))
7586 (process-connection-type tramp-process-connection-type)
7587 (process-adaptive-read-buffering nil)
7588 (coding-system-for-read nil)
7589 ;; This must be done in order to avoid our file name handler.
7590 (p (let ((default-directory
7591 (tramp-compat-temporary-file-directory)))
7592 (start-process
7593 (or process-name (tramp-buffer-name vec))
7594 (tramp-get-connection-buffer vec)
7595 tramp-encoding-shell))))
7596
7597 (tramp-message
7598 vec 6 "%s" (mapconcat 'identity (process-command p) " "))
7599
7600 ;; Check whether process is alive.
7601 (tramp-set-process-query-on-exit-flag p nil)
7602 (tramp-barf-if-no-shell-prompt
7603 p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
7604
7605 ;; Now do all the connections as specified.
7606 (while target-alist
7607 (let* ((hop (car target-alist))
7608 (l-method (tramp-file-name-method hop))
7609 (l-user (tramp-file-name-user hop))
7610 (l-host (tramp-file-name-host hop))
7611 (l-port nil)
7612 (login-program
7613 (tramp-get-method-parameter
7614 l-method 'tramp-login-program))
7615 (login-args
7616 (tramp-get-method-parameter l-method 'tramp-login-args))
7617 (async-args
7618 (tramp-get-method-parameter l-method 'tramp-async-args))
7619 (gw-args
7620 (tramp-get-method-parameter l-method 'tramp-gw-args))
7621 (gw (tramp-get-file-property hop "" "gateway" nil))
7622 (g-method (and gw (tramp-file-name-method gw)))
7623 (g-user (and gw (tramp-file-name-user gw)))
7624 (g-host (and gw (tramp-file-name-host gw)))
7625 (command login-program)
7626 ;; We don't create the temporary file. In fact,
7627 ;; it is just a prefix for the ControlPath option
7628 ;; of ssh; the real temporary file has another
7629 ;; name, and it is created and protected by ssh.
7630 ;; It is also removed by ssh, when the connection
7631 ;; is closed.
7632 (tmpfile
7633 (tramp-set-connection-property
7634 p "temp-file"
7635 (make-temp-name
7636 (expand-file-name
7637 tramp-temp-name-prefix
7638 (tramp-compat-temporary-file-directory)))))
7639 spec)
7640
7641 ;; Add arguments for asynchrononous processes.
7642 (when (and process-name async-args)
7643 (setq login-args (append async-args login-args)))
7644
7645 ;; Add gateway arguments if necessary.
7646 (when (and gw gw-args)
7647 (setq login-args (append gw-args login-args)))
7648
7649 ;; Check for port number. Until now, there's no need
7650 ;; for handling like method, user, host.
7651 (when (string-match tramp-host-with-port-regexp l-host)
7652 (setq l-port (match-string 2 l-host)
7653 l-host (match-string 1 l-host)))
7654
7655 ;; Set variables for computing the prompt for reading
7656 ;; password. They can also be derived from a gateway.
7657 (setq tramp-current-method (or g-method l-method)
7658 tramp-current-user (or g-user l-user)
7659 tramp-current-host (or g-host l-host))
7660
7661 ;; Replace login-args place holders.
7662 (setq
7663 l-host (or l-host "")
7664 l-user (or l-user "")
7665 l-port (or l-port "")
7666 spec (format-spec-make
7667 ?h l-host ?u l-user ?p l-port ?t tmpfile)
7668 command
7669 (concat
7670 ;; We do not want to see the trailing local prompt in
7671 ;; `start-file-process'.
7672 (unless (memq system-type '(windows-nt)) "exec ")
7673 command " "
7674 (mapconcat
7675 (lambda (x)
7676 (setq x (mapcar (lambda (y) (format-spec y spec)) x))
7677 (unless (member "" x) (mapconcat 'identity x " ")))
7678 login-args " ")
7679 ;; Local shell could be a Windows COMSPEC. It
7680 ;; doesn't know the ";" syntax, but we must exit
7681 ;; always for `start-file-process'. "exec" does not
7682 ;; work either.
7683 (if (memq system-type '(windows-nt)) " && exit || exit")))
7684
7685 ;; Send the command.
7686 (tramp-message vec 3 "Sending command `%s'" command)
7687 (tramp-send-command vec command t t)
7688 (tramp-process-actions p vec pos tramp-actions-before-shell 60)
7689 (tramp-message
7690 vec 3 "Found remote shell prompt on `%s'" l-host))
7691 ;; Next hop.
7692 (setq target-alist (cdr target-alist)))
7693
7694 ;; Make initial shell settings.
7695 (tramp-open-connection-setup-interactive-shell p vec)))))))
7696
7697 (defun tramp-send-command (vec command &optional neveropen nooutput)
7698 "Send the COMMAND to connection VEC.
7699 Erases temporary buffer before sending the command. If optional
7700 arg NEVEROPEN is non-nil, never try to open the connection. This
7701 is meant to be used from `tramp-maybe-open-connection' only. The
7702 function waits for output unless NOOUTPUT is set."
7703 (unless neveropen (tramp-maybe-open-connection vec))
7704 (let ((p (tramp-get-connection-process vec)))
7705 (when (tramp-get-connection-property p "remote-echo" nil)
7706 ;; We mark the command string that it can be erased in the output buffer.
7707 (tramp-set-connection-property p "check-remote-echo" t)
7708 (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
7709 (tramp-message vec 6 "%s" command)
7710 (tramp-send-string vec command)
7711 (unless nooutput (tramp-wait-for-output p))))
7712
7713 (defun tramp-wait-for-output (proc &optional timeout)
7714 "Wait for output from remote command."
7715 (unless (buffer-live-p (process-buffer proc))
7716 (delete-process proc)
7717 (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
7718 (with-current-buffer (process-buffer proc)
7719 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
7720 ;; be leading escape sequences, which must be ignored.
7721 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
7722 ;; Sometimes, the commands do not return a newline but a
7723 ;; null byte before the shell prompt, for example "git
7724 ;; ls-files -c -z ...".
7725 (regexp1 (format "\\(^\\|\000\\)%s" regexp))
7726 (found (tramp-wait-for-regexp proc timeout regexp1)))
7727 (if found
7728 (let (buffer-read-only)
7729 ;; A simple-minded busybox has sent " ^H" sequences.
7730 ;; Delete them.
7731 (goto-char (point-min))
7732 (when (re-search-forward
7733 "^\\(.\b\\)+$" (tramp-compat-line-end-position) t)
7734 (forward-line 1)
7735 (delete-region (point-min) (point)))
7736 ;; Delete the prompt.
7737 (goto-char (point-max))
7738 (re-search-backward regexp nil t)
7739 (delete-region (point) (point-max)))
7740 (if timeout
7741 (tramp-error
7742 proc 'file-error
7743 "[[Remote prompt `%s' not found in %d secs]]"
7744 tramp-end-of-output timeout)
7745 (tramp-error
7746 proc 'file-error
7747 "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
7748 ;; Return value is whether end-of-output sentinel was found.
7749 found)))
7750
7751 (defun tramp-send-command-and-check
7752 (vec command &optional subshell dont-suppress-err)
7753 "Run COMMAND and check its exit status.
7754 Sends `echo $?' along with the COMMAND for checking the exit status. If
7755 COMMAND is nil, just sends `echo $?'. Returns the exit status found.
7756
7757 If the optional argument SUBSHELL is non-nil, the command is
7758 executed in a subshell, ie surrounded by parentheses. If
7759 DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
7760 (tramp-send-command
7761 vec
7762 (concat (if subshell "( " "")
7763 command
7764 (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
7765 "echo tramp_exit_status $?"
7766 (if subshell " )" "")))
7767 (with-current-buffer (tramp-get-connection-buffer vec)
7768 (goto-char (point-max))
7769 (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
7770 (tramp-error
7771 vec 'file-error "Couldn't find exit status of `%s'" command))
7772 (skip-chars-forward "^ ")
7773 (prog1
7774 (read (current-buffer))
7775 (let (buffer-read-only) (delete-region (match-beginning 0) (point-max))))))
7776
7777 (defun tramp-barf-unless-okay (vec command fmt &rest args)
7778 "Run COMMAND, check exit status, throw error if exit status not okay.
7779 Similar to `tramp-send-command-and-check' but accepts two more arguments
7780 FMT and ARGS which are passed to `error'."
7781 (unless (zerop (tramp-send-command-and-check vec command))
7782 (apply 'tramp-error vec 'file-error fmt args)))
7783
7784 (defun tramp-send-command-and-read (vec command)
7785 "Run COMMAND and return the output, which must be a Lisp expression.
7786 In case there is no valid Lisp expression, it raises an error"
7787 (tramp-barf-unless-okay vec command "`%s' returns with error" command)
7788 (with-current-buffer (tramp-get-connection-buffer vec)
7789 ;; Read the expression.
7790 (goto-char (point-min))
7791 (condition-case nil
7792 (prog1 (read (current-buffer))
7793 ;; Error handling.
7794 (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t)
7795 (error nil)))
7796 (error (tramp-error
7797 vec 'file-error
7798 "`%s' does not return a valid Lisp expression: `%s'"
7799 command (buffer-string))))))
7800
7801 ;; It seems that Tru64 Unix does not like it if long strings are sent
7802 ;; to it in one go. (This happens when sending the Perl
7803 ;; `file-attributes' implementation, for instance.) Therefore, we
7804 ;; have this function which sends the string in chunks.
7805 (defun tramp-send-string (vec string)
7806 "Send the STRING via connection VEC.
7807
7808 The STRING is expected to use Unix line-endings, but the lines sent to
7809 the remote host use line-endings as defined in the variable
7810 `tramp-rsh-end-of-line'. The communication buffer is erased before sending."
7811 (let* ((p (tramp-get-connection-process vec))
7812 (chunksize (tramp-get-connection-property p "chunksize" nil)))
7813 (unless p
7814 (tramp-error
7815 vec 'file-error "Can't send string to remote host -- not logged in"))
7816 (tramp-set-connection-property p "last-cmd-time" (current-time))
7817 (tramp-message vec 10 "%s" string)
7818 (with-current-buffer (tramp-get-connection-buffer vec)
7819 ;; Clean up the buffer. We cannot call `erase-buffer' because
7820 ;; narrowing might be in effect.
7821 (let (buffer-read-only) (delete-region (point-min) (point-max)))
7822 ;; Replace "\n" by `tramp-rsh-end-of-line'.
7823 (setq string
7824 (mapconcat 'identity
7825 (tramp-compat-split-string string "\n")
7826 tramp-rsh-end-of-line))
7827 (unless (or (string= string "")
7828 (string-equal (substring string -1) tramp-rsh-end-of-line))
7829 (setq string (concat string tramp-rsh-end-of-line)))
7830 ;; Send the string.
7831 (if (and chunksize (not (zerop chunksize)))
7832 (let ((pos 0)
7833 (end (length string)))
7834 (while (< pos end)
7835 (tramp-message
7836 vec 10 "Sending chunk from %s to %s"
7837 pos (min (+ pos chunksize) end))
7838 (process-send-string
7839 p (substring string pos (min (+ pos chunksize) end)))
7840 (setq pos (+ pos chunksize))))
7841 (process-send-string p string)))))
7842
7843 (defun tramp-mode-string-to-int (mode-string)
7844 "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
7845 (let* (case-fold-search
7846 (mode-chars (string-to-vector mode-string))
7847 (owner-read (aref mode-chars 1))
7848 (owner-write (aref mode-chars 2))
7849 (owner-execute-or-setid (aref mode-chars 3))
7850 (group-read (aref mode-chars 4))
7851 (group-write (aref mode-chars 5))
7852 (group-execute-or-setid (aref mode-chars 6))
7853 (other-read (aref mode-chars 7))
7854 (other-write (aref mode-chars 8))
7855 (other-execute-or-sticky (aref mode-chars 9)))
7856 (save-match-data
7857 (logior
7858 (cond
7859 ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
7860 ((char-equal owner-read ?-) 0)
7861 (t (error "Second char `%c' must be one of `r-'" owner-read)))
7862 (cond
7863 ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
7864 ((char-equal owner-write ?-) 0)
7865 (t (error "Third char `%c' must be one of `w-'" owner-write)))
7866 (cond
7867 ((char-equal owner-execute-or-setid ?x)
7868 (tramp-octal-to-decimal "00100"))
7869 ((char-equal owner-execute-or-setid ?S)
7870 (tramp-octal-to-decimal "04000"))
7871 ((char-equal owner-execute-or-setid ?s)
7872 (tramp-octal-to-decimal "04100"))
7873 ((char-equal owner-execute-or-setid ?-) 0)
7874 (t (error "Fourth char `%c' must be one of `xsS-'"
7875 owner-execute-or-setid)))
7876 (cond
7877 ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
7878 ((char-equal group-read ?-) 0)
7879 (t (error "Fifth char `%c' must be one of `r-'" group-read)))
7880 (cond
7881 ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
7882 ((char-equal group-write ?-) 0)
7883 (t (error "Sixth char `%c' must be one of `w-'" group-write)))
7884 (cond
7885 ((char-equal group-execute-or-setid ?x)
7886 (tramp-octal-to-decimal "00010"))
7887 ((char-equal group-execute-or-setid ?S)
7888 (tramp-octal-to-decimal "02000"))
7889 ((char-equal group-execute-or-setid ?s)
7890 (tramp-octal-to-decimal "02010"))
7891 ((char-equal group-execute-or-setid ?-) 0)
7892 (t (error "Seventh char `%c' must be one of `xsS-'"
7893 group-execute-or-setid)))
7894 (cond
7895 ((char-equal other-read ?r)
7896 (tramp-octal-to-decimal "00004"))
7897 ((char-equal other-read ?-) 0)
7898 (t (error "Eighth char `%c' must be one of `r-'" other-read)))
7899 (cond
7900 ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
7901 ((char-equal other-write ?-) 0)
7902 (t (error "Nineth char `%c' must be one of `w-'" other-write)))
7903 (cond
7904 ((char-equal other-execute-or-sticky ?x)
7905 (tramp-octal-to-decimal "00001"))
7906 ((char-equal other-execute-or-sticky ?T)
7907 (tramp-octal-to-decimal "01000"))
7908 ((char-equal other-execute-or-sticky ?t)
7909 (tramp-octal-to-decimal "01001"))
7910 ((char-equal other-execute-or-sticky ?-) 0)
7911 (t (error "Tenth char `%c' must be one of `xtT-'"
7912 other-execute-or-sticky)))))))
7913
7914 (defun tramp-convert-file-attributes (vec attr)
7915 "Convert file-attributes ATTR generated by perl script, stat or ls.
7916 Convert file mode bits to string and set virtual device number.
7917 Return ATTR."
7918 (when attr
7919 ;; Convert last access time.
7920 (unless (listp (nth 4 attr))
7921 (setcar (nthcdr 4 attr)
7922 (list (floor (nth 4 attr) 65536)
7923 (floor (mod (nth 4 attr) 65536)))))
7924 ;; Convert last modification time.
7925 (unless (listp (nth 5 attr))
7926 (setcar (nthcdr 5 attr)
7927 (list (floor (nth 5 attr) 65536)
7928 (floor (mod (nth 5 attr) 65536)))))
7929 ;; Convert last status change time.
7930 (unless (listp (nth 6 attr))
7931 (setcar (nthcdr 6 attr)
7932 (list (floor (nth 6 attr) 65536)
7933 (floor (mod (nth 6 attr) 65536)))))
7934 ;; Convert file size.
7935 (when (< (nth 7 attr) 0)
7936 (setcar (nthcdr 7 attr) -1))
7937 (when (and (floatp (nth 7 attr))
7938 (<= (nth 7 attr) (tramp-compat-most-positive-fixnum)))
7939 (setcar (nthcdr 7 attr) (round (nth 7 attr))))
7940 ;; Convert file mode bits to string.
7941 (unless (stringp (nth 8 attr))
7942 (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
7943 (when (stringp (car attr))
7944 (aset (nth 8 attr) 0 ?l)))
7945 ;; Convert directory indication bit.
7946 (when (string-match "^d" (nth 8 attr))
7947 (setcar attr t))
7948 ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
7949 (when (consp (car attr))
7950 (if (and (stringp (caar attr))
7951 (string-match ".+ -> .\\(.+\\)." (caar attr)))
7952 (setcar attr (match-string 1 (caar attr)))
7953 (setcar attr nil)))
7954 ;; Set file's gid change bit.
7955 (setcar (nthcdr 9 attr)
7956 (if (numberp (nth 3 attr))
7957 (not (= (nth 3 attr)
7958 (tramp-get-remote-gid vec 'integer)))
7959 (not (string-equal
7960 (nth 3 attr)
7961 (tramp-get-remote-gid vec 'string)))))
7962 ;; Convert inode.
7963 (unless (listp (nth 10 attr))
7964 (setcar (nthcdr 10 attr)
7965 (condition-case nil
7966 (cons (floor (nth 10 attr) 65536)
7967 (floor (mod (nth 10 attr) 65536)))
7968 ;; Inodes can be incredible huge. We must hide this.
7969 (error (tramp-get-inode vec)))))
7970 ;; Set virtual device number.
7971 (setcar (nthcdr 11 attr)
7972 (tramp-get-device vec))
7973 attr))
7974
7975 (defun tramp-check-cached-permissions (vec access)
7976 "Check `file-attributes' caches for VEC.
7977 Return t if according to the cache access type ACCESS is known to
7978 be granted."
7979 (let ((result nil)
7980 (offset (cond
7981 ((eq ?r access) 1)
7982 ((eq ?w access) 2)
7983 ((eq ?x access) 3))))
7984 (dolist (suffix '("string" "integer") result)
7985 (setq
7986 result
7987 (or
7988 result
7989 (let ((file-attr
7990 (tramp-get-file-property
7991 vec (tramp-file-name-localname vec)
7992 (concat "file-attributes-" suffix) nil))
7993 (remote-uid
7994 (tramp-get-connection-property
7995 vec (concat "uid-" suffix) nil))
7996 (remote-gid
7997 (tramp-get-connection-property
7998 vec (concat "gid-" suffix) nil)))
7999 (and
8000 file-attr
8001 (or
8002 ;; Not a symlink
8003 (eq t (car file-attr))
8004 (null (car file-attr)))
8005 (or
8006 ;; World accessible.
8007 (eq access (aref (nth 8 file-attr) (+ offset 6)))
8008 ;; User accessible and owned by user.
8009 (and
8010 (eq access (aref (nth 8 file-attr) offset))
8011 (equal remote-uid (nth 2 file-attr)))
8012 ;; Group accessible and owned by user's
8013 ;; principal group.
8014 (and
8015 (eq access (aref (nth 8 file-attr) (+ offset 3)))
8016 (equal remote-gid (nth 3 file-attr)))))))))))
8017
8018 (defun tramp-get-inode (vec)
8019 "Returns the virtual inode number.
8020 If it doesn't exist, generate a new one."
8021 (let ((string (tramp-make-tramp-file-name
8022 (tramp-file-name-method vec)
8023 (tramp-file-name-user vec)
8024 (tramp-file-name-host vec)
8025 "")))
8026 (unless (assoc string tramp-inodes)
8027 (add-to-list 'tramp-inodes
8028 (list string (length tramp-inodes))))
8029 (nth 1 (assoc string tramp-inodes))))
8030
8031 (defun tramp-get-device (vec)
8032 "Returns the virtual device number.
8033 If it doesn't exist, generate a new one."
8034 (let ((string (tramp-make-tramp-file-name
8035 (tramp-file-name-method vec)
8036 (tramp-file-name-user vec)
8037 (tramp-file-name-host vec)
8038 "")))
8039 (unless (assoc string tramp-devices)
8040 (add-to-list 'tramp-devices
8041 (list string (length tramp-devices))))
8042 (cons -1 (nth 1 (assoc string tramp-devices)))))
8043
8044 (defun tramp-file-mode-from-int (mode)
8045 "Turn an integer representing a file mode into an ls(1)-like string."
8046 (let ((type (cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
8047 (user (logand (lsh mode -6) 7))
8048 (group (logand (lsh mode -3) 7))
8049 (other (logand (lsh mode -0) 7))
8050 (suid (> (logand (lsh mode -9) 4) 0))
8051 (sgid (> (logand (lsh mode -9) 2) 0))
8052 (sticky (> (logand (lsh mode -9) 1) 0)))
8053 (setq user (tramp-file-mode-permissions user suid "s"))
8054 (setq group (tramp-file-mode-permissions group sgid "s"))
8055 (setq other (tramp-file-mode-permissions other sticky "t"))
8056 (concat type user group other)))
8057
8058 (defun tramp-file-mode-permissions (perm suid suid-text)
8059 "Convert a permission bitset into a string.
8060 This is used internally by `tramp-file-mode-from-int'."
8061 (let ((r (> (logand perm 4) 0))
8062 (w (> (logand perm 2) 0))
8063 (x (> (logand perm 1) 0)))
8064 (concat (or (and r "r") "-")
8065 (or (and w "w") "-")
8066 (or (and suid x suid-text) ; suid, execute
8067 (and suid (upcase suid-text)) ; suid, !execute
8068 (and x "x") "-")))) ; !suid
8069
8070 (defun tramp-decimal-to-octal (i)
8071 "Return a string consisting of the octal digits of I.
8072 Not actually used. Use `(format \"%o\" i)' instead?"
8073 (cond ((< i 0) (error "Cannot convert negative number to octal"))
8074 ((not (integerp i)) (error "Cannot convert non-integer to octal"))
8075 ((zerop i) "0")
8076 (t (concat (tramp-decimal-to-octal (/ i 8))
8077 (number-to-string (% i 8))))))
8078
8079 ;; Kudos to Gerd Moellmann for this suggestion.
8080 (defun tramp-octal-to-decimal (ostr)
8081 "Given a string of octal digits, return a decimal number."
8082 (let ((x (or ostr "")))
8083 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
8084 (unless (string-match "\\`[0-7]*\\'" x)
8085 (error "Non-octal junk in string `%s'" x))
8086 (string-to-number ostr 8)))
8087
8088 (defun tramp-shell-case-fold (string)
8089 "Converts STRING to shell glob pattern which ignores case."
8090 (mapconcat
8091 (lambda (c)
8092 (if (equal (downcase c) (upcase c))
8093 (vector c)
8094 (format "[%c%c]" (downcase c) (upcase c))))
8095 string
8096 ""))
8097
8098
8099 ;; ------------------------------------------------------------
8100 ;; -- Tramp file names --
8101 ;; ------------------------------------------------------------
8102 ;; Conversion functions between external representation and
8103 ;; internal data structure. Convenience functions for internal
8104 ;; data structure.
8105
8106 (defun tramp-file-name-p (vec)
8107 "Check, whether VEC is a Tramp object."
8108 (and (vectorp vec) (= 4 (length vec))))
8109
8110 (defun tramp-file-name-method (vec)
8111 "Return method component of VEC."
8112 (and (tramp-file-name-p vec) (aref vec 0)))
8113
8114 (defun tramp-file-name-user (vec)
8115 "Return user component of VEC."
8116 (and (tramp-file-name-p vec) (aref vec 1)))
8117
8118 (defun tramp-file-name-host (vec)
8119 "Return host component of VEC."
8120 (and (tramp-file-name-p vec) (aref vec 2)))
8121
8122 (defun tramp-file-name-localname (vec)
8123 "Return localname component of VEC."
8124 (and (tramp-file-name-p vec) (aref vec 3)))
8125
8126 ;; The user part of a Tramp file name vector can be of kind
8127 ;; "user%domain". Sometimes, we must extract these parts.
8128 (defun tramp-file-name-real-user (vec)
8129 "Return the user name of VEC without domain."
8130 (save-match-data
8131 (let ((user (tramp-file-name-user vec)))
8132 (if (and (stringp user)
8133 (string-match tramp-user-with-domain-regexp user))
8134 (match-string 1 user)
8135 user))))
8136
8137 (defun tramp-file-name-domain (vec)
8138 "Return the domain name of VEC."
8139 (save-match-data
8140 (let ((user (tramp-file-name-user vec)))
8141 (and (stringp user)
8142 (string-match tramp-user-with-domain-regexp user)
8143 (match-string 2 user)))))
8144
8145 ;; The host part of a Tramp file name vector can be of kind
8146 ;; "host#port". Sometimes, we must extract these parts.
8147 (defun tramp-file-name-real-host (vec)
8148 "Return the host name of VEC without port."
8149 (save-match-data
8150 (let ((host (tramp-file-name-host vec)))
8151 (if (and (stringp host)
8152 (string-match tramp-host-with-port-regexp host))
8153 (match-string 1 host)
8154 host))))
8155
8156 (defun tramp-file-name-port (vec)
8157 "Return the port number of VEC."
8158 (save-match-data
8159 (let ((host (tramp-file-name-host vec)))
8160 (and (stringp host)
8161 (string-match tramp-host-with-port-regexp host)
8162 (string-to-number (match-string 2 host))))))
8163
8164 (defun tramp-tramp-file-p (name)
8165 "Return t if NAME is a string with Tramp file name syntax."
8166 (save-match-data
8167 (and (stringp name) (string-match tramp-file-name-regexp name))))
8168
8169 (defun tramp-find-method (method user host)
8170 "Return the right method string to use.
8171 This is METHOD, if non-nil. Otherwise, do a lookup in
8172 `tramp-default-method-alist'."
8173 (or method
8174 (let ((choices tramp-default-method-alist)
8175 lmethod item)
8176 (while choices
8177 (setq item (pop choices))
8178 (when (and (string-match (or (nth 0 item) "") (or host ""))
8179 (string-match (or (nth 1 item) "") (or user "")))
8180 (setq lmethod (nth 2 item))
8181 (setq choices nil)))
8182 lmethod)
8183 tramp-default-method))
8184
8185 (defun tramp-find-user (method user host)
8186 "Return the right user string to use.
8187 This is USER, if non-nil. Otherwise, do a lookup in
8188 `tramp-default-user-alist'."
8189 (or user
8190 (let ((choices tramp-default-user-alist)
8191 luser item)
8192 (while choices
8193 (setq item (pop choices))
8194 (when (and (string-match (or (nth 0 item) "") (or method ""))
8195 (string-match (or (nth 1 item) "") (or host "")))
8196 (setq luser (nth 2 item))
8197 (setq choices nil)))
8198 luser)
8199 tramp-default-user))
8200
8201 (defun tramp-find-host (method user host)
8202 "Return the right host string to use.
8203 This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
8204 (or (and (> (length host) 0) host)
8205 tramp-default-host))
8206
8207 (defun tramp-dissect-file-name (name &optional nodefault)
8208 "Return a `tramp-file-name' structure.
8209 The structure consists of remote method, remote user, remote host
8210 and localname (file name on remote host). If NODEFAULT is
8211 non-nil, the file name parts are not expanded to their default
8212 values."
8213 (save-match-data
8214 (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
8215 (unless match (error "Not a Tramp file name: %s" name))
8216 (let ((method (match-string (nth 1 tramp-file-name-structure) name))
8217 (user (match-string (nth 2 tramp-file-name-structure) name))
8218 (host (match-string (nth 3 tramp-file-name-structure) name))
8219 (localname (match-string (nth 4 tramp-file-name-structure) name)))
8220 (when (member method '("multi" "multiu"))
8221 (error
8222 "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
8223 method))
8224 (when host
8225 (when (string-match tramp-prefix-ipv6-regexp host)
8226 (setq host (replace-match "" nil t host)))
8227 (when (string-match tramp-postfix-ipv6-regexp host)
8228 (setq host (replace-match "" nil t host))))
8229 (if nodefault
8230 (vector method user host localname)
8231 (vector
8232 (tramp-find-method method user host)
8233 (tramp-find-user method user host)
8234 (tramp-find-host method user host)
8235 localname))))))
8236
8237 (defun tramp-equal-remote (file1 file2)
8238 "Check, whether the remote parts of FILE1 and FILE2 are identical.
8239 The check depends on method, user and host name of the files. If
8240 one of the components is missing, the default values are used.
8241 The local file name parts of FILE1 and FILE2 are not taken into
8242 account.
8243
8244 Example:
8245
8246 (tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
8247
8248 would yield `t'. On the other hand, the following check results in nil:
8249
8250 (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
8251 (and (stringp (file-remote-p file1))
8252 (stringp (file-remote-p file2))
8253 (string-equal (file-remote-p file1) (file-remote-p file2))))
8254
8255 (defun tramp-make-tramp-file-name (method user host localname)
8256 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
8257 (concat tramp-prefix-format
8258 (when (not (zerop (length method)))
8259 (concat method tramp-postfix-method-format))
8260 (when (not (zerop (length user)))
8261 (concat user tramp-postfix-user-format))
8262 (when host
8263 (if (string-match tramp-ipv6-regexp host)
8264 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8265 host))
8266 tramp-postfix-host-format
8267 (when localname localname)))
8268
8269 (defun tramp-completion-make-tramp-file-name (method user host localname)
8270 "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
8271 It must not be a complete Tramp file name, but as long as there are
8272 necessary only. This function will be used in file name completion."
8273 (concat tramp-prefix-format
8274 (when (not (zerop (length method)))
8275 (concat method tramp-postfix-method-format))
8276 (when (not (zerop (length user)))
8277 (concat user tramp-postfix-user-format))
8278 (when (not (zerop (length host)))
8279 (concat
8280 (if (string-match tramp-ipv6-regexp host)
8281 (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
8282 host)
8283 tramp-postfix-host-format))
8284 (when localname localname)))
8285
8286 (defun tramp-make-copy-program-file-name (vec)
8287 "Create a file name suitable to be passed to `rcp' and workalikes."
8288 (let ((user (tramp-file-name-user vec))
8289 (host (tramp-file-name-real-host vec))
8290 (localname (tramp-shell-quote-argument
8291 (tramp-file-name-localname vec))))
8292 (if (not (zerop (length user)))
8293 (format "%s@%s:%s" user host localname)
8294 (format "%s:%s" host localname))))
8295
8296 (defun tramp-method-out-of-band-p (vec size)
8297 "Return t if this is an out-of-band method, nil otherwise."
8298 (and
8299 ;; It shall be an out-of-band method.
8300 (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
8301 ;; Either the file size is large enough, or (in rare cases) there
8302 ;; does not exist a remote encoding.
8303 (or (null tramp-copy-size-limit)
8304 (> size tramp-copy-size-limit)
8305 (null (tramp-get-inline-coding vec "remote-encoding" size)))))
8306
8307 (defun tramp-local-host-p (vec)
8308 "Return t if this points to the local host, nil otherwise."
8309 ;; We cannot use `tramp-file-name-real-host'. A port is an
8310 ;; indication for an ssh tunnel or alike.
8311 (let ((host (tramp-file-name-host vec)))
8312 (and
8313 (stringp host)
8314 (string-match tramp-local-host-regexp host)
8315 ;; The method shall be applied to one of the shell file name
8316 ;; handler. `tramp-local-host-p' is also called for "smb" and
8317 ;; alike, where it must fail.
8318 (tramp-get-method-parameter
8319 (tramp-file-name-method vec) 'tramp-login-program)
8320 ;; The local temp directory must be writable for the other user.
8321 (file-writable-p
8322 (tramp-make-tramp-file-name
8323 (tramp-file-name-method vec)
8324 (tramp-file-name-user vec)
8325 host
8326 (tramp-compat-temporary-file-directory)))
8327 ;; On some systems, chown runs only for root.
8328 (or (zerop (user-uid))
8329 (zerop (tramp-get-remote-uid vec 'integer))))))
8330
8331 ;; Variables local to connection.
8332
8333 (defun tramp-get-remote-path (vec)
8334 (with-connection-property
8335 ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
8336 ;; cache the result for the session only. Otherwise, the result
8337 ;; is cached persistently.
8338 (if (memq 'tramp-own-remote-path tramp-remote-path)
8339 (tramp-get-connection-process vec)
8340 vec)
8341 "remote-path"
8342 (let* ((remote-path (copy-tree tramp-remote-path))
8343 (elt1 (memq 'tramp-default-remote-path remote-path))
8344 (elt2 (memq 'tramp-own-remote-path remote-path))
8345 (default-remote-path
8346 (when elt1
8347 (condition-case nil
8348 (tramp-send-command-and-read
8349 vec "echo \\\"`getconf PATH`\\\"")
8350 ;; Default if "getconf" is not available.
8351 (error
8352 (tramp-message
8353 vec 3
8354 "`getconf PATH' not successful, using default value \"%s\"."
8355 "/bin:/usr/bin")
8356 "/bin:/usr/bin"))))
8357 (own-remote-path
8358 (when elt2
8359 (condition-case nil
8360 (tramp-send-command-and-read vec "echo \\\"$PATH\\\"")
8361 ;; Default if "getconf" is not available.
8362 (error
8363 (tramp-message
8364 vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.")
8365 nil)))))
8366
8367 ;; Replace place holder `tramp-default-remote-path'.
8368 (when elt1
8369 (setcdr elt1
8370 (append
8371 (tramp-compat-split-string default-remote-path ":")
8372 (cdr elt1)))
8373 (setq remote-path (delq 'tramp-default-remote-path remote-path)))
8374
8375 ;; Replace place holder `tramp-own-remote-path'.
8376 (when elt2
8377 (setcdr elt2
8378 (append
8379 (tramp-compat-split-string own-remote-path ":")
8380 (cdr elt2)))
8381 (setq remote-path (delq 'tramp-own-remote-path remote-path)))
8382
8383 ;; Remove double entries.
8384 (setq elt1 remote-path)
8385 (while (consp elt1)
8386 (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
8387 (setcar elt2 nil))
8388 (setq elt1 (cdr elt1)))
8389
8390 ;; Remove non-existing directories.
8391 (delq
8392 nil
8393 (mapcar
8394 (lambda (x)
8395 (and
8396 (stringp x)
8397 (file-directory-p
8398 (tramp-make-tramp-file-name
8399 (tramp-file-name-method vec)
8400 (tramp-file-name-user vec)
8401 (tramp-file-name-host vec)
8402 x))
8403 x))
8404 remote-path)))))
8405
8406 (defun tramp-get-remote-tmpdir (vec)
8407 (with-connection-property vec "tmp-directory"
8408 (let ((dir (tramp-shell-quote-argument "/tmp")))
8409 (if (and (zerop
8410 (tramp-send-command-and-check
8411 vec (format "%s -d %s" (tramp-get-test-command vec) dir)))
8412 (zerop
8413 (tramp-send-command-and-check
8414 vec (format "%s -w %s" (tramp-get-test-command vec) dir))))
8415 dir
8416 (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
8417
8418 (defun tramp-get-ls-command (vec)
8419 (with-connection-property vec "ls"
8420 (tramp-message vec 5 "Finding a suitable `ls' command")
8421 (or
8422 (catch 'ls-found
8423 (dolist (cmd '("ls" "gnuls" "gls"))
8424 (let ((dl (tramp-get-remote-path vec))
8425 result)
8426 (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
8427 ;; Check parameters. On busybox, "ls" output coloring is
8428 ;; enabled by default sometimes. So we try to disable it
8429 ;; when possible. $LS_COLORING is not supported there.
8430 ;; Some "ls" versions are sensible wrt the order of
8431 ;; arguments, they fail when "-al" is after the
8432 ;; "--color=never" argument (for example on FreeBSD).
8433 (when (zerop (tramp-send-command-and-check
8434 vec (format "%s -lnd /" result)))
8435 (when (zerop (tramp-send-command-and-check
8436 vec (format
8437 "%s --color=never -al /dev/null" result)))
8438 (setq result (concat result " --color=never")))
8439 (throw 'ls-found result))
8440 (setq dl (cdr dl))))))
8441 (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
8442
8443 (defun tramp-get-ls-command-with-dired (vec)
8444 (save-match-data
8445 (with-connection-property vec "ls-dired"
8446 (tramp-message vec 5 "Checking, whether `ls --dired' works")
8447 ;; Some "ls" versions are sensible wrt the order of arguments,
8448 ;; they fail when "-al" is after the "--dired" argument (for
8449 ;; example on FreeBSD).
8450 (zerop (tramp-send-command-and-check
8451 vec (format "%s --dired -al /dev/null"
8452 (tramp-get-ls-command vec)))))))
8453
8454 (defun tramp-get-test-command (vec)
8455 (with-connection-property vec "test"
8456 (tramp-message vec 5 "Finding a suitable `test' command")
8457 (if (zerop (tramp-send-command-and-check vec "test 0"))
8458 "test"
8459 (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
8460
8461 (defun tramp-get-test-nt-command (vec)
8462 ;; Does `test A -nt B' work? Use abominable `find' construct if it
8463 ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
8464 ;; for otherwise the shell crashes.
8465 (with-connection-property vec "test-nt"
8466 (or
8467 (progn
8468 (tramp-send-command
8469 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
8470 (with-current-buffer (tramp-get-buffer vec)
8471 (goto-char (point-min))
8472 (when (looking-at (regexp-quote tramp-end-of-output))
8473 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
8474 (progn
8475 (tramp-send-command
8476 vec
8477 (format
8478 "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
8479 (tramp-get-test-command vec)))
8480 "tramp_test_nt %s %s"))))
8481
8482 (defun tramp-get-file-exists-command (vec)
8483 (with-connection-property vec "file-exists"
8484 (tramp-message vec 5 "Finding command to check if file exists")
8485 (tramp-find-file-exists-command vec)))
8486
8487 (defun tramp-get-remote-ln (vec)
8488 (with-connection-property vec "ln"
8489 (tramp-message vec 5 "Finding a suitable `ln' command")
8490 (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
8491
8492 (defun tramp-get-remote-perl (vec)
8493 (with-connection-property vec "perl"
8494 (tramp-message vec 5 "Finding a suitable `perl' command")
8495 (let ((result
8496 (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
8497 (tramp-find-executable
8498 vec "perl" (tramp-get-remote-path vec)))))
8499 ;; We must check also for some Perl modules.
8500 (when result
8501 (with-connection-property vec "perl-file-spec"
8502 (zerop
8503 (tramp-send-command-and-check
8504 vec (format "%s -e 'use File::Spec;'" result))))
8505 (with-connection-property vec "perl-cwd-realpath"
8506 (zerop
8507 (tramp-send-command-and-check
8508 vec (format "%s -e 'use Cwd \"realpath\";'" result)))))
8509 result)))
8510
8511 (defun tramp-get-remote-stat (vec)
8512 (with-connection-property vec "stat"
8513 (tramp-message vec 5 "Finding a suitable `stat' command")
8514 (let ((result (tramp-find-executable
8515 vec "stat" (tramp-get-remote-path vec)))
8516 tmp)
8517 ;; Check whether stat(1) returns usable syntax. %s does not
8518 ;; work on older AIX systems.
8519 (when result
8520 (setq tmp
8521 ;; We don't want to display an error message.
8522 (with-temp-message (or (current-message) "")
8523 (condition-case nil
8524 (tramp-send-command-and-read
8525 vec (format "%s -c '(\"%%N\" %%s)' /" result))
8526 (error nil))))
8527 (unless (and (listp tmp) (stringp (car tmp))
8528 (string-match "^./.$" (car tmp))
8529 (integerp (cadr tmp)))
8530 (setq result nil)))
8531 result)))
8532
8533 (defun tramp-get-remote-readlink (vec)
8534 (with-connection-property vec "readlink"
8535 (tramp-message vec 5 "Finding a suitable `readlink' command")
8536 (let ((result (tramp-find-executable
8537 vec "readlink" (tramp-get-remote-path vec))))
8538 (when (and result
8539 ;; We don't want to display an error message.
8540 (with-temp-message (or (current-message) "")
8541 (condition-case nil
8542 (zerop
8543 (tramp-send-command-and-check
8544 vec (format "%s --canonicalize-missing /" result)))
8545 (error nil))))
8546 result))))
8547
8548 (defun tramp-get-remote-trash (vec)
8549 (with-connection-property vec "trash"
8550 (tramp-message vec 5 "Finding a suitable `trash' command")
8551 (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
8552
8553 (defun tramp-get-remote-id (vec)
8554 (with-connection-property vec "id"
8555 (tramp-message vec 5 "Finding POSIX `id' command")
8556 (or
8557 (catch 'id-found
8558 (let ((dl (tramp-get-remote-path vec))
8559 result)
8560 (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
8561 ;; Check POSIX parameter.
8562 (when (zerop (tramp-send-command-and-check
8563 vec (format "%s -u" result)))
8564 (throw 'id-found result))
8565 (setq dl (cdr dl)))))
8566 (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
8567
8568 (defun tramp-get-remote-uid (vec id-format)
8569 (with-connection-property vec (format "uid-%s" id-format)
8570 (let ((res (tramp-send-command-and-read
8571 vec
8572 (format "%s -u%s %s"
8573 (tramp-get-remote-id vec)
8574 (if (equal id-format 'integer) "" "n")
8575 (if (equal id-format 'integer)
8576 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8577 ;; The command might not always return a number.
8578 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8579
8580 (defun tramp-get-remote-gid (vec id-format)
8581 (with-connection-property vec (format "gid-%s" id-format)
8582 (let ((res (tramp-send-command-and-read
8583 vec
8584 (format "%s -g%s %s"
8585 (tramp-get-remote-id vec)
8586 (if (equal id-format 'integer) "" "n")
8587 (if (equal id-format 'integer)
8588 "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
8589 ;; The command might not always return a number.
8590 (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
8591
8592 (defun tramp-get-local-uid (id-format)
8593 (if (equal id-format 'integer) (user-uid) (user-login-name)))
8594
8595 (defun tramp-get-local-gid (id-format)
8596 (nth 3 (tramp-compat-file-attributes "~/" id-format)))
8597
8598 ;; Some predefined connection properties.
8599 (defun tramp-get-inline-compress (vec prop size)
8600 "Return the compress command related to PROP.
8601 PROP is either `inline-compress' or `inline-decompress'. SIZE is
8602 the length of the file to be compressed.
8603
8604 If no corresponding command is found, nil is returned."
8605 (when (and (integerp tramp-inline-compress-start-size)
8606 (> size tramp-inline-compress-start-size))
8607 (with-connection-property vec prop
8608 (tramp-find-inline-compress vec)
8609 (tramp-get-connection-property vec prop nil))))
8610
8611 (defun tramp-get-inline-coding (vec prop size)
8612 "Return the coding command related to PROP.
8613 PROP is either `remote-encoding', `remode-decoding',
8614 `local-encoding' or `local-decoding'.
8615
8616 SIZE is the length of the file to be coded. Depending on SIZE,
8617 compression might be applied.
8618
8619 If no corresponding command is found, nil is returned.
8620 Otherwise, either a string is returned which contains a `%s' mark
8621 to be used for the respective input or output file; or a Lisp
8622 function cell is returned to be applied on a buffer."
8623 ;; We must catch the errors, because we want to return `nil', when
8624 ;; no inline coding is found.
8625 (ignore-errors
8626 (let ((coding
8627 (with-connection-property vec prop
8628 (tramp-find-inline-encoding vec)
8629 (tramp-get-connection-property vec prop nil)))
8630 (prop1 (if (string-match "encoding" prop)
8631 "inline-compress" "inline-decompress"))
8632 compress)
8633 ;; The connection property might have been cached. So we must
8634 ;; send the script to the remote side - maybe.
8635 (when (and coding (symbolp coding) (string-match "remote" prop))
8636 (let ((name (symbol-name coding)))
8637 (while (string-match (regexp-quote "-") name)
8638 (setq name (replace-match "_" nil t name)))
8639 (tramp-maybe-send-script vec (symbol-value coding) name)
8640 (setq coding name)))
8641 (when coding
8642 ;; Check for the `compress' command.
8643 (setq compress (tramp-get-inline-compress vec prop1 size))
8644 ;; Return the value.
8645 (cond
8646 ((and compress (symbolp coding))
8647 (if (string-match "decompress" prop1)
8648 `(lambda (beg end)
8649 (,coding beg end)
8650 (let ((coding-system-for-write 'binary)
8651 (coding-system-for-read 'binary))
8652 (apply
8653 'call-process-region (point-min) (point-max)
8654 (car (split-string ,compress)) t t nil
8655 (cdr (split-string ,compress)))))
8656 `(lambda (beg end)
8657 (let ((coding-system-for-write 'binary)
8658 (coding-system-for-read 'binary))
8659 (apply
8660 'call-process-region beg end
8661 (car (split-string ,compress)) t t nil
8662 (cdr (split-string ,compress))))
8663 (,coding (point-min) (point-max)))))
8664 ((symbolp coding)
8665 coding)
8666 ((and compress (string-match "decoding" prop))
8667 (format
8668 ;; Windows shells need the program file name after
8669 ;; the pipe symbol be quoted if they use forward
8670 ;; slashes as directory separators.
8671 (if (and (string-match "local" prop)
8672 (memq system-type '(windows-nt)))
8673 "(%s | \"%s\" >%%s)"
8674 "(%s | %s >%%s)")
8675 coding compress))
8676 (compress
8677 (format
8678 ;; Windows shells need the program file name after
8679 ;; the pipe symbol be quoted if they use forward
8680 ;; slashes as directory separators.
8681 (if (and (string-match "local" prop)
8682 (memq system-type '(windows-nt)))
8683 "(%s <%%s | \"%s\")"
8684 "(%s <%%s | %s)")
8685 compress coding))
8686 ((string-match "decoding" prop)
8687 (format "%s >%%s" coding))
8688 (t
8689 (format "%s <%%s" coding)))))))
8690
8691 (defun tramp-get-method-parameter (method param)
8692 "Return the method parameter PARAM.
8693 If the `tramp-methods' entry does not exist, return nil."
8694 (let ((entry (assoc param (assoc method tramp-methods))))
8695 (when entry (cadr entry))))
8696
8697 ;; Auto saving to a special directory.
8698
8699 (defun tramp-exists-file-name-handler (operation &rest args)
8700 "Check, whether OPERATION runs a file name handler."
8701 ;; The file name handler is determined on base of either an
8702 ;; argument, `buffer-file-name', or `default-directory'.
8703 (condition-case nil
8704 (let* ((buffer-file-name "/")
8705 (default-directory "/")
8706 (fnha file-name-handler-alist)
8707 (check-file-name-operation operation)
8708 (file-name-handler-alist
8709 (list
8710 (cons "/"
8711 (lambda (operation &rest args)
8712 "Returns OPERATION if it is the one to be checked."
8713 (if (equal check-file-name-operation operation)
8714 operation
8715 (let ((file-name-handler-alist fnha))
8716 (apply operation args))))))))
8717 (equal (apply operation args) operation))
8718 (error nil)))
8719
8720 (unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
8721 (defadvice make-auto-save-file-name
8722 (around tramp-advice-make-auto-save-file-name () activate)
8723 "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files."
8724 (if (tramp-tramp-file-p (buffer-file-name))
8725 ;; We cannot call `tramp-handle-make-auto-save-file-name'
8726 ;; directly, because this would bypass the locking mechanism.
8727 (setq ad-return-value
8728 (tramp-file-name-handler 'make-auto-save-file-name))
8729 ad-do-it))
8730 (add-hook
8731 'tramp-unload-hook
8732 (lambda ()
8733 (ad-remove-advice
8734 'make-auto-save-file-name
8735 'around 'tramp-advice-make-auto-save-file-name)
8736 (ad-activate 'make-auto-save-file-name))))
8737
8738 ;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus
8739 ;; umask. This is a security threat.
8740
8741 (defun tramp-set-auto-save-file-modes ()
8742 "Set permissions of autosaved remote files to the original permissions."
8743 (let ((bfn (buffer-file-name)))
8744 (when (and (tramp-tramp-file-p bfn)
8745 (buffer-modified-p)
8746 (stringp buffer-auto-save-file-name)
8747 (not (equal bfn buffer-auto-save-file-name)))
8748 (unless (file-exists-p buffer-auto-save-file-name)
8749 (write-region "" nil buffer-auto-save-file-name))
8750 ;; Permissions should be set always, because there might be an old
8751 ;; auto-saved file belonging to another original file. This could
8752 ;; be a security threat.
8753 (set-file-modes buffer-auto-save-file-name
8754 (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
8755
8756 (unless (and (featurep 'xemacs)
8757 (= emacs-major-version 21)
8758 (> emacs-minor-version 4))
8759 (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
8760 (add-hook 'tramp-unload-hook
8761 (lambda ()
8762 (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
8763
8764 (defun tramp-subst-strs-in-string (alist string)
8765 "Replace all occurrences of the string FROM with TO in STRING.
8766 ALIST is of the form ((FROM . TO) ...)."
8767 (save-match-data
8768 (while alist
8769 (let* ((pr (car alist))
8770 (from (car pr))
8771 (to (cdr pr)))
8772 (while (string-match (regexp-quote from) string)
8773 (setq string (replace-match to t t string)))
8774 (setq alist (cdr alist))))
8775 string))
8776
8777 ;; ------------------------------------------------------------
8778 ;; -- Compatibility functions section --
8779 ;; ------------------------------------------------------------
8780
8781 (defun tramp-read-passwd (proc &optional prompt)
8782 "Read a password from user (compat function).
8783 Consults the auth-source package.
8784 Invokes `password-read' if available, `read-passwd' else."
8785 (let* ((key (tramp-make-tramp-file-name
8786 tramp-current-method tramp-current-user
8787 tramp-current-host ""))
8788 (pw-prompt
8789 (or prompt
8790 (with-current-buffer (process-buffer proc)
8791 (tramp-check-for-regexp proc tramp-password-prompt-regexp)
8792 (format "%s for %s " (capitalize (match-string 1)) key)))))
8793 (with-parsed-tramp-file-name key nil
8794 (prog1
8795 (or
8796 ;; See if auth-sources contains something useful, if it's bound.
8797 (and (boundp 'auth-sources)
8798 (tramp-get-connection-property v "first-password-request" nil)
8799 ;; Try with Tramp's current method.
8800 (tramp-compat-funcall
8801 'auth-source-user-or-password
8802 "password" tramp-current-host tramp-current-method))
8803 ;; Try the password cache.
8804 (when (functionp 'password-read)
8805 (unless (tramp-get-connection-property
8806 v "first-password-request" nil)
8807 (tramp-compat-funcall 'password-cache-remove key))
8808 (let ((password
8809 (tramp-compat-funcall 'password-read pw-prompt key)))
8810 (tramp-compat-funcall 'password-cache-add key password)
8811 password))
8812 ;; Else, get the password interactively.
8813 (read-passwd pw-prompt))
8814 (tramp-set-connection-property v "first-password-request" nil)))))
8815
8816 (defun tramp-clear-passwd (vec)
8817 "Clear password cache for connection related to VEC."
8818 (tramp-compat-funcall
8819 'password-cache-remove
8820 (tramp-make-tramp-file-name
8821 (tramp-file-name-method vec)
8822 (tramp-file-name-user vec)
8823 (tramp-file-name-host vec)
8824 "")))
8825
8826 ;; Snarfed code from time-date.el and parse-time.el
8827
8828 (defconst tramp-half-a-year '(241 17024)
8829 "Evaluated by \"(days-to-time 183)\".")
8830
8831 (defconst tramp-parse-time-months
8832 '(("jan" . 1) ("feb" . 2) ("mar" . 3)
8833 ("apr" . 4) ("may" . 5) ("jun" . 6)
8834 ("jul" . 7) ("aug" . 8) ("sep" . 9)
8835 ("oct" . 10) ("nov" . 11) ("dec" . 12))
8836 "Alist mapping month names to integers.")
8837
8838 (defun tramp-time-less-p (t1 t2)
8839 "Say whether time value T1 is less than time value T2."
8840 (unless t1 (setq t1 '(0 0)))
8841 (unless t2 (setq t2 '(0 0)))
8842 (or (< (car t1) (car t2))
8843 (and (= (car t1) (car t2))
8844 (< (nth 1 t1) (nth 1 t2)))))
8845
8846 (defun tramp-time-subtract (t1 t2)
8847 "Subtract two time values.
8848 Return the difference in the format of a time value."
8849 (unless t1 (setq t1 '(0 0)))
8850 (unless t2 (setq t2 '(0 0)))
8851 (let ((borrow (< (cadr t1) (cadr t2))))
8852 (list (- (car t1) (car t2) (if borrow 1 0))
8853 (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
8854
8855 (defun tramp-time-diff (t1 t2)
8856 "Return the difference between the two times, in seconds.
8857 T1 and T2 are time values (as returned by `current-time' for example)."
8858 ;; Pacify byte-compiler with `symbol-function'.
8859 (cond ((and (fboundp 'subtract-time)
8860 (fboundp 'float-time))
8861 (tramp-compat-funcall
8862 'float-time (tramp-compat-funcall 'subtract-time t1 t2)))
8863 ((and (fboundp 'subtract-time)
8864 (fboundp 'time-to-seconds))
8865 (tramp-compat-funcall
8866 'time-to-seconds (tramp-compat-funcall 'subtract-time t1 t2)))
8867 ((fboundp 'itimer-time-difference)
8868 (tramp-compat-funcall
8869 'itimer-time-difference
8870 (if (< (length t1) 3) (append t1 '(0)) t1)
8871 (if (< (length t2) 3) (append t2 '(0)) t2)))
8872 (t
8873 (let ((time (tramp-time-subtract t1 t2)))
8874 (+ (* (car time) 65536.0)
8875 (cadr time)
8876 (/ (or (nth 2 time) 0) 1000000.0))))))
8877
8878 (defun tramp-coding-system-change-eol-conversion (coding-system eol-type)
8879 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
8880 EOL-TYPE can be one of `dos', `unix', or `mac'."
8881 (cond ((fboundp 'coding-system-change-eol-conversion)
8882 (tramp-compat-funcall
8883 'coding-system-change-eol-conversion coding-system eol-type))
8884 ((fboundp 'subsidiary-coding-system)
8885 (tramp-compat-funcall
8886 'subsidiary-coding-system coding-system
8887 (cond ((eq eol-type 'dos) 'crlf)
8888 ((eq eol-type 'unix) 'lf)
8889 ((eq eol-type 'mac) 'cr)
8890 (t
8891 (error "Unknown EOL-TYPE `%s', must be %s"
8892 eol-type
8893 "`dos', `unix', or `mac'")))))
8894 (t (error "Can't change EOL conversion -- is MULE missing?"))))
8895
8896 (defun tramp-set-process-query-on-exit-flag (process flag)
8897 "Specify if query is needed for process when Emacs is exited.
8898 If the second argument flag is non-nil, Emacs will query the user before
8899 exiting if process is running."
8900 (if (fboundp 'set-process-query-on-exit-flag)
8901 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
8902 (tramp-compat-funcall 'process-kill-without-query process flag)))
8903
8904
8905 ;; ------------------------------------------------------------
8906 ;; -- Kludges section --
8907 ;; ------------------------------------------------------------
8908
8909 ;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
8910 ;; does not deal well with newline characters. Newline is replaced by
8911 ;; backslash newline. But if, say, the string `a backslash newline b'
8912 ;; is passed to a shell, the shell will expand this into "ab",
8913 ;; completely omitting the newline. This is not what was intended.
8914 ;; It does not appear to be possible to make the function
8915 ;; `shell-quote-argument' work with newlines without making it
8916 ;; dependent on the shell used. But within this package, we know that
8917 ;; we will always use a Bourne-like shell, so we use an approach which
8918 ;; groks newlines.
8919 ;;
8920 ;; The approach is simple: we call `shell-quote-argument', then
8921 ;; massage the newline part of the result.
8922 ;;
8923 ;; This function should produce a string which is grokked by a Unix
8924 ;; shell, even if the Emacs is running on Windows. Since this is the
8925 ;; kludges section, we bind `system-type' in such a way that
8926 ;; `shell-quote-arguments' behaves as if on Unix.
8927 ;;
8928 ;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
8929 ;; function to work with Bourne-like shells.
8930 ;;
8931 ;; CCC: This function should be rewritten so that
8932 ;; `shell-quote-argument' is not used. This way, we are safe from
8933 ;; changes in `shell-quote-argument'.
8934 (defun tramp-shell-quote-argument (s)
8935 "Similar to `shell-quote-argument', but groks newlines.
8936 Only works for Bourne-like shells."
8937 (let ((system-type 'not-windows))
8938 (save-match-data
8939 (let ((result (shell-quote-argument s))
8940 (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
8941 (when (and (>= (length result) 2)
8942 (string= (substring result 0 2) "\\~"))
8943 (setq result (substring result 1)))
8944 (while (string-match nl result)
8945 (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
8946 t t result)))
8947 result))))
8948
8949 ;; Checklist for `tramp-unload-hook'
8950 ;; - Unload all `tramp-*' packages
8951 ;; - Reset `file-name-handler-alist'
8952 ;; - Cleanup hooks where Tramp functions are in
8953 ;; - Cleanup advised functions
8954 ;; - Cleanup autoloads
8955 ;;;###autoload
8956 (defun tramp-unload-tramp ()
8957 "Discard Tramp from loading remote files."
8958 (interactive)
8959 ;; When Tramp is not loaded yet, its autoloads are still active.
8960 (tramp-unload-file-name-handlers)
8961 ;; ange-ftp settings must be enabled.
8962 (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
8963 ;; Maybe its not loaded yet.
8964 (condition-case nil
8965 (unload-feature 'tramp 'force)
8966 (error nil)))
8967
8968 (when (and load-in-progress
8969 (string-match "Loading tramp..." (or (current-message) "")))
8970 (message "Loading tramp...done"))
8971
8972 (provide 'tramp)
8973
8974 ;;; TODO:
8975
8976 ;; * Handle nonlocal exits such as C-g.
8977 ;; * But it would probably be better to use with-local-quit at the
8978 ;; place where it's actually needed: around any potentially
8979 ;; indefinitely blocking piece of code. In this case it would be
8980 ;; within Tramp around one of its calls to accept-process-output (or
8981 ;; around one of the loops that calls accept-process-output)
8982 ;; (Stefan Monnier).
8983 ;; * Rewrite `tramp-shell-quote-argument' to abstain from using
8984 ;; `shell-quote-argument'.
8985 ;; * In Emacs 21, `insert-directory' shows total number of bytes used
8986 ;; by the files in that directory. Add this here.
8987 ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
8988 ;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
8989 ;; * Don't use globbing for directories with many files, as this is
8990 ;; likely to produce long command lines, and some shells choke on
8991 ;; long command lines.
8992 ;; * How to deal with MULE in `insert-file-contents' and `write-region'?
8993 ;; * abbreviate-file-name
8994 ;; * Better error checking. At least whenever we see something
8995 ;; strange when doing zerop, we should kill the process and start
8996 ;; again. (Greg Stark)
8997 ;; * Remove unneeded parameters from methods.
8998 ;; * Make it work for different encodings, and for different file name
8999 ;; encodings, too. (Daniel Pittman)
9000 ;; * Don't search for perl5 and perl. Instead, only search for perl and
9001 ;; then look if it's the right version (with `perl -v').
9002 ;; * When editing a remote CVS controlled file as a different user, VC
9003 ;; gets confused about the file locking status. Try to find out why
9004 ;; the workaround doesn't work.
9005 ;; * Username and hostname completion.
9006 ;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode-p'.
9007 ;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
9008 ;; Code is nearly identical.
9009 ;; * Allow out-of-band methods as _last_ multi-hop. Open a connection
9010 ;; until the last but one hop via `start-file-process'. Apply it
9011 ;; also for ftp and smb.
9012 ;; * WIBNI if we had a command "trampclient"? If I was editing in
9013 ;; some shell with root priviledges, it would be nice if I could
9014 ;; just call
9015 ;; trampclient filename.c
9016 ;; as an editor, and the _current_ shell would connect to an Emacs
9017 ;; server and would be used in an existing non-priviledged Emacs
9018 ;; session for doing the editing in question.
9019 ;; That way, I need not tell Emacs my password again and be afraid
9020 ;; that it makes it into core dumps or other ugly stuff (I had Emacs
9021 ;; once display a just typed password in the context of a keyboard
9022 ;; sequence prompt for a question immediately following in a shell
9023 ;; script run within Emacs -- nasty).
9024 ;; And if I have some ssh session running to a different computer,
9025 ;; having the possibility of passing a local file there to a local
9026 ;; Emacs session (in case I can arrange for a connection back) would
9027 ;; be nice.
9028 ;; Likely the corresponding Tramp server should not allow the
9029 ;; equivalent of the emacsclient -eval option in order to make this
9030 ;; reasonably unproblematic. And maybe trampclient should have some
9031 ;; way of passing credentials, like by using an SSL socket or
9032 ;; something. (David Kastrup)
9033 ;; * Reconnect directly to a compliant shell without first going
9034 ;; through the user's default shell. (Pete Forman)
9035 ;; * Make `tramp-default-user' obsolete.
9036 ;; * How can I interrupt the remote process with a signal
9037 ;; (interrupt-process seems not to work)? (Markus Triska)
9038 ;; * Avoid the local shell entirely for starting remote processes. If
9039 ;; so, I think even a signal, when delivered directly to the local
9040 ;; SSH instance, would correctly be propagated to the remote process
9041 ;; automatically; possibly SSH would have to be started with
9042 ;; "-t". (Markus Triska)
9043 ;; * It makes me wonder if tramp couldn't fall back to ssh when scp
9044 ;; isn't on the remote host. (Mark A. Hershberger)
9045 ;; * Use lsh instead of ssh. (Alfred M. Szmidt)
9046 ;; * Implement a general server-local-variable mechanism, as there are
9047 ;; probably other variables that need different values for different
9048 ;; servers too. The user could then configure a variable (such as
9049 ;; tramp-server-local-variable-alist) to define any such variables
9050 ;; that they need to, which would then be let bound as appropriate
9051 ;; in tramp functions. (Jason Rumney)
9052 ;; * Optimize out-of-band copying, when both methods are scp-like (not
9053 ;; rsync).
9054 ;; * Keep a second connection open for out-of-band methods like scp or
9055 ;; rsync.
9056 ;; * IMHO, it's a drawback that currently Tramp doesn't support
9057 ;; Unicode in Dired file names by default. Is it possible to
9058 ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
9059 ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
9060 ;; expects only English messages? (Juri Linkov)
9061 ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
9062 ;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705)
9063 ;; * Try telnet+curl as new method. It might be useful for busybox,
9064 ;; without built-in uuencode/uudecode.
9065 ;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'.
9066 ;; * I was wondering it it would be possible to use tramp even if I'm
9067 ;; actually using sshfs. But when I launch a command I would like
9068 ;; to get it executed on the remote machine where the files really
9069 ;; are. (Andrea Crotti)
9070 ;; * Run emerge on two remote files. Bug is described here:
9071 ;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
9072 ;; (Bug#6850)
9073
9074 ;; Functions for file-name-handler-alist:
9075 ;; diff-latest-backup-file -- in diff.el
9076
9077 ;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
9078 ;;; tramp.el ends here
9079
9080 ;; Local Variables:
9081 ;; mode: Emacs-Lisp
9082 ;; coding: utf-8
9083 ;; End: