1046 |
:group 'tramp |
:group 'tramp |
1047 |
:type '(repeat (list variable function))) |
:type '(repeat (list variable function))) |
1048 |
|
|
1049 |
|
(defcustom tramp-multi-actions |
1050 |
|
'((tramp-password-prompt-regexp tramp-multi-action-password) |
1051 |
|
(tramp-login-prompt-regexp tramp-multi-action-login) |
1052 |
|
(shell-prompt-pattern tramp-multi-action-succeed) |
1053 |
|
(tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)) |
1054 |
|
"List of pattern/action pairs. |
1055 |
|
This list is used for each hop in multi-hop connections. |
1056 |
|
See `tramp-actions-before-shell' for more info." |
1057 |
|
:group 'tramp |
1058 |
|
:type '(repeat (list variable function))) |
1059 |
|
|
1060 |
;;; Internal Variables: |
;;; Internal Variables: |
1061 |
|
|
1189 |
on the remote file system.") |
on the remote file system.") |
1190 |
|
|
1191 |
;; Perl script to implement `mime-encode' |
;; Perl script to implement `mime-encode' |
1192 |
(defvar tramp-perl-mime-encode (concat |
;; (defvar tramp-perl-mime-encode (concat |
1193 |
"sub encode_base64 ($); |
;; "sub encode_base64 ($); |
1194 |
my $buf; |
;; my $buf; |
1195 |
while(read(STDIN, $buf, 60*57)) { print encode_base64($buf) } |
;; while(read(STDIN, $buf, 60*57)) { print encode_base64($buf) } |
1196 |
sub encode_base64 ($) { |
;; sub encode_base64 ($) { |
1197 |
my $res = \"\"; |
;; my $res = \"\"; |
1198 |
my $eol = \"\n\"; |
;; my $eol = \"\n\"; |
1199 |
pos($_[0]) = 0; # ensure start at the beginning |
;; pos($_[0]) = 0; # ensure start at the beginning |
1200 |
while ($_[0] =~ /(.{1,45})/gs) { |
;; while ($_[0] =~ /(.{1,45})/gs) { |
1201 |
$res .= substr(pack(\"u\", $1), 1); |
;; $res .= substr(pack(\"u\", $1), 1); |
1202 |
chop($res); |
;; chop($res); |
1203 |
} |
;; } |
1204 |
$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs |
;; $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs |
1205 |
# fix padding at the end |
;; # fix padding at the end |
1206 |
my $padding = (3 - length($_[0]) % 3) % 3; |
;; my $padding = (3 - length($_[0]) % 3) % 3; |
1207 |
$res =~ s/.{$padding}$/\"=\" x $padding/e if $padding; |
;; $res =~ s/.{$padding}$/\"=\" x $padding/e if $padding; |
1208 |
# break encoded string into lines of no more than 76 characters each |
;; # break encoded string into lines of no more than 76 characters each |
1209 |
if (length $eol) { |
;; if (length $eol) { |
1210 |
$res =~ s/(.{1,76})/$1$eol/g; |
;; $res =~ s/(.{1,76})/$1$eol/g; |
1211 |
} |
;; } |
1212 |
$res;}")) |
;; $res;}")) |
1213 |
|
|
1214 |
|
(defvar tramp-perl-encode "%s -e'\ |
1215 |
|
print qq(begin 644 xxx\n); |
1216 |
|
my $s = q(); |
1217 |
|
my $res = q(); |
1218 |
|
while (read(STDIN, $s, 45)) { |
1219 |
|
print pack(q(u), $s); |
1220 |
|
} |
1221 |
|
print qq(`\n); |
1222 |
|
print qq(end\n); |
1223 |
|
'" |
1224 |
|
"Perl program to use for encoding a file. |
1225 |
|
Escape sequence %s is replaced with name of Perl binary.") |
1226 |
|
|
1227 |
;; Perl script to implement `mime-decode' |
;; Perl script to implement `mime-decode' |
1228 |
(defvar tramp-perl-mime-decode (concat |
(defvar tramp-perl-decode "%s -ne ' |
1229 |
"sub decode_base64 ($); |
print unpack q(u), $_; |
1230 |
my $buf; |
'" |
1231 |
while(read(STDIN, $buf, 60*57)) { print decode_base64($buf) } |
"Perl program to use for decoding a file. |
1232 |
sub decode_base64 ($) { |
Escape sequence %s is replaced with name of Perl binary.") |
1233 |
local($^W) = 0; # unpack(\"u\",...) gives bogus warning in 5.00[123] |
|
1234 |
|
;; (defvar tramp-perl-mime-decode (concat |
1235 |
my $str = shift; |
;; "sub decode_base64 ($); |
1236 |
my $res = \"\"; |
;; my $buf; |
1237 |
|
;; while(read(STDIN, $buf, 60*57)) { print decode_base64($buf) } |
1238 |
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars |
;; sub decode_base64 ($) { |
1239 |
if (length($str) % 4) { |
;; local($^W) = 0; # unpack(\"u\",...) gives bogus warning in 5.00[123] |
1240 |
warn(\"Length of base64 data not a multiple of 4\") |
|
1241 |
} |
;; my $str = shift; |
1242 |
$str =~ s/=+$//; # remove padding |
;; my $res = \"\"; |
1243 |
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format |
|
1244 |
while ($str =~ /(.{1,60})/gs) { |
;; $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars |
1245 |
my $len = chr(32 + length($1)*3/4); # compute length byte |
;; if (length($str) % 4) { |
1246 |
$res .= unpack(\"u\", $len . $1 ); # uudecode |
;; warn(\"Length of base64 data not a multiple of 4\") |
1247 |
} |
;; } |
1248 |
$res;}")) |
;; $str =~ s/=+$//; # remove padding |
1249 |
|
;; $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format |
1250 |
|
;; while ($str =~ /(.{1,60})/gs) { |
1251 |
|
;; my $len = chr(32 + length($1)*3/4); # compute length byte |
1252 |
|
;; $res .= unpack(\"u\", $len . $1 ); # uudecode |
1253 |
|
;; } |
1254 |
|
;; $res;}")) |
1255 |
|
|
1256 |
; These values conform to `file-attributes' from XEmacs 21.2. |
; These values conform to `file-attributes' from XEmacs 21.2. |
1257 |
; GNU Emacs and other tools not checked. |
; GNU Emacs and other tools not checked. |
3471 |
;; prompts from the remote host. See the variable |
;; prompts from the remote host. See the variable |
3472 |
;; `tramp-actions-before-shell' for usage of these functions. |
;; `tramp-actions-before-shell' for usage of these functions. |
3473 |
|
|
3474 |
(defun tramp-action-login (multi-method method user host) |
(defun tramp-action-login (p multi-method method user host) |
3475 |
"Send the login name." |
"Send the login name." |
3476 |
(tramp-message 9 "Sending login name `%s'" |
(tramp-message 9 "Sending login name `%s'" |
3477 |
(or user (user-login-name))) |
(or user (user-login-name))) |
3478 |
(process-send-string nil (concat (or user (user-login-name)) |
(process-send-string nil (concat (or user (user-login-name)) |
3479 |
tramp-rsh-end-of-line))) |
tramp-rsh-end-of-line))) |
3480 |
|
|
3481 |
(defun tramp-action-password (multi-method method user host) |
(defun tramp-action-password (p multi-method method user host) |
3482 |
"Query the user for a password." |
"Query the user for a password." |
3483 |
(when (tramp-method-out-of-band-p multi-method method) |
(when (tramp-method-out-of-band-p multi-method method) |
3484 |
(kill-process (get-buffer-process (current-buffer))) |
(kill-process (get-buffer-process (current-buffer))) |
3485 |
(error (concat "Out of band method `%s' not applicable " |
(error (concat "Out of band method `%s' not applicable " |
3486 |
"for remote shell asking for a password") |
"for remote shell asking for a password") |
3487 |
method)) |
method)) |
3488 |
(tramp-enter-password (match-string 0))) |
(tramp-enter-password p (match-string 0))) |
3489 |
|
|
3490 |
(defun tramp-action-succeed (multi-method method user host) |
(defun tramp-action-succeed (p multi-method method user host) |
3491 |
"Signal success in finding shell prompt." |
"Signal success in finding shell prompt." |
3492 |
(tramp-message 9 "Found remote shell prompt.") |
(tramp-message 9 "Found remote shell prompt.") |
3493 |
(throw 'tramp-action 'ok)) |
(throw 'tramp-action 'ok)) |
3494 |
|
|
3495 |
(defun tramp-action-permission-denied (multi-method method user host) |
(defun tramp-action-permission-denied (p multi-method method user host) |
3496 |
"Signal permission denied." |
"Signal permission denied." |
3497 |
(tramp-message 9 "Permission denied by remote host.") |
(tramp-message 9 "Permission denied by remote host.") |
3498 |
(kill-process (get-buffer-process (current-buffer))) |
(kill-process p) |
3499 |
|
(throw 'tramp-action 'permission-denied)) |
3500 |
|
|
3501 |
|
;; The following functions are specifically for multi connections. |
3502 |
|
|
3503 |
|
(defun tramp-multi-action-login (p method user host) |
3504 |
|
"Send the login name." |
3505 |
|
(tramp-message 9 "Sending login name `%s'" user) |
3506 |
|
(process-send-string p (concat user tramp-rsh-end-of-line))) |
3507 |
|
|
3508 |
|
(defun tramp-multi-action-password (p method user host) |
3509 |
|
"Query the user for a password." |
3510 |
|
(tramp-enter-password p (match-string 0))) |
3511 |
|
|
3512 |
|
(defun tramp-multi-action-succeed (p method user host) |
3513 |
|
"Signal success in finding shell prompt." |
3514 |
|
(tramp-message 9 "Found shell prompt on `%s'" host) |
3515 |
|
(throw 'tramp-action 'ok)) |
3516 |
|
|
3517 |
|
(defun tramp-multi-action-permission-denied (p method user host) |
3518 |
|
"Signal permission denied." |
3519 |
|
(tramp-message 9 "Permission denied by remote host `%s'" host) |
3520 |
|
(kill-process p) |
3521 |
(throw 'tramp-action 'permission-denied)) |
(throw 'tramp-action 'permission-denied)) |
3522 |
|
|
3523 |
;; Functions for processing the actions. |
;; Functions for processing the actions. |
3524 |
|
|
3525 |
(defun tramp-process-one-action (multi-method method user host actions) |
(defun tramp-process-one-action (p multi-method method user host actions) |
3526 |
"Wait for output from the shell and perform one action." |
"Wait for output from the shell and perform one action." |
3527 |
(let (found item pattern action) |
(let (found item pattern action todo) |
3528 |
(erase-buffer) |
(erase-buffer) |
3529 |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
3530 |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
(with-timeout (60 (throw 'tramp-action 'timeout)) |
3531 |
(while (not found) |
(while (not found) |
3532 |
(accept-process-output (get-buffer-process (current-buffer)) 1) |
(accept-process-output p 1) |
3533 |
(goto-char (point-min)) |
(setq todo actions) |
3534 |
(while actions |
(while todo |
3535 |
(setq item (pop actions)) |
(goto-char (point-min)) |
3536 |
|
(setq item (pop todo)) |
3537 |
(setq pattern (symbol-value (nth 0 item))) |
(setq pattern (symbol-value (nth 0 item))) |
3538 |
(setq action (nth 1 item)) |
(setq action (nth 1 item)) |
3539 |
|
(tramp-message 10 "Looking for pattern %s" pattern) |
3540 |
(when (re-search-forward (concat pattern "\\'") nil t) |
(when (re-search-forward (concat pattern "\\'") nil t) |
3541 |
(setq found (funcall action multi-method method user host))))) |
(setq found (funcall action p multi-method method user host))))) |
3542 |
found))) |
found))) |
3543 |
|
|
3544 |
(defun tramp-process-actions (multi-method method user host actions) |
(defun tramp-process-actions (p multi-method method user host actions) |
3545 |
"Perform actions until success." |
"Perform actions until success." |
3546 |
(let (exit) |
(let (exit) |
3547 |
(while (not exit) |
(while (not exit) |
3548 |
|
(tramp-message 10 "Processing actions") |
3549 |
(setq exit |
(setq exit |
3550 |
(catch 'tramp-action |
(catch 'tramp-action |
3551 |
(tramp-process-one-action multi-method method user host actions) |
(tramp-process-one-action |
3552 |
|
p multi-method method user host actions) |
3553 |
nil))) |
nil))) |
3554 |
(unless (eq exit 'ok) |
(unless (eq exit 'ok) |
3555 |
(error "Login failed")))) |
(error "Login failed")))) |
3556 |
|
|
3557 |
|
;; For multi-actions. |
3558 |
|
|
3559 |
|
(defun tramp-process-one-multi-action (p method user host actions) |
3560 |
|
"Wait for output from the shell and perform one action." |
3561 |
|
(let (found item pattern action todo) |
3562 |
|
(erase-buffer) |
3563 |
|
(tramp-message 9 "Waiting 60s for prompt from remote shell") |
3564 |
|
(with-timeout (60 (throw 'tramp-action 'timeout)) |
3565 |
|
(while (not found) |
3566 |
|
(accept-process-output p 1) |
3567 |
|
(setq todo actions) |
3568 |
|
(while todo |
3569 |
|
(goto-char (point-min)) |
3570 |
|
(setq item (pop todo)) |
3571 |
|
(setq pattern (symbol-value (nth 0 item))) |
3572 |
|
(setq action (nth 1 item)) |
3573 |
|
(tramp-message 10 "Looking for pattern %s" pattern) |
3574 |
|
(when (re-search-forward (concat pattern "\\'") nil t) |
3575 |
|
(setq found (funcall action p method user host))))) |
3576 |
|
found))) |
3577 |
|
|
3578 |
|
(defun tramp-process-multi-actions (p method user host actions) |
3579 |
|
"Perform actions until success." |
3580 |
|
(let (exit) |
3581 |
|
(while (not exit) |
3582 |
|
(setq exit |
3583 |
|
(catch 'tramp-action |
3584 |
|
(tramp-process-one-multi-action p method user host actions) |
3585 |
|
nil))) |
3586 |
|
(unless (eq exit 'ok) |
3587 |
|
(error "Login failed")))) |
3588 |
|
|
3589 |
|
;; The actual functions for opening connections. |
3590 |
|
|
3591 |
(defun tramp-open-connection-telnet (multi-method method user host) |
(defun tramp-open-connection-telnet (multi-method method user host) |
3592 |
"Open a connection using a telnet METHOD. |
"Open a connection using a telnet METHOD. |
3593 |
This starts the command `telnet HOST ARGS'[*], then waits for a remote |
This starts the command `telnet HOST ARGS'[*], then waits for a remote |
3634 |
(process-kill-without-query p) |
(process-kill-without-query p) |
3635 |
(set-buffer (tramp-get-buffer multi-method method user host)) |
(set-buffer (tramp-get-buffer multi-method method user host)) |
3636 |
(erase-buffer) |
(erase-buffer) |
3637 |
(tramp-process-actions multi-method method user host |
(tramp-process-actions p multi-method method user host |
3638 |
tramp-actions-before-shell) |
tramp-actions-before-shell) |
3639 |
|
|
3640 |
;; (tramp-message 9 "Waiting for login prompt...") |
;; (tramp-message 9 "Waiting for login prompt...") |
3732 |
(process-kill-without-query p) |
(process-kill-without-query p) |
3733 |
|
|
3734 |
(set-buffer buf) |
(set-buffer buf) |
3735 |
(tramp-process-actions multi-method method user host |
(tramp-process-actions p multi-method method user host |
3736 |
tramp-actions-before-shell) |
tramp-actions-before-shell) |
3737 |
|
|
3738 |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host) |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host) |
3820 |
(pw nil)) |
(pw nil)) |
3821 |
(process-kill-without-query p) |
(process-kill-without-query p) |
3822 |
(set-buffer (tramp-get-buffer multi-method method user host)) |
(set-buffer (tramp-get-buffer multi-method method user host)) |
3823 |
(tramp-process-actions multi-method method user host |
(tramp-process-actions p multi-method method user host |
3824 |
tramp-actions-before-shell) |
tramp-actions-before-shell) |
3825 |
|
|
3826 |
;; (tramp-message 9 "Waiting 30s for shell or password prompt...") |
;; (tramp-message 9 "Waiting 30s for shell or password prompt...") |
3941 |
(erase-buffer) |
(erase-buffer) |
3942 |
(tramp-message 9 "Sending telnet command `%s'" cmd1) |
(tramp-message 9 "Sending telnet command `%s'" cmd1) |
3943 |
(process-send-string p cmd) |
(process-send-string p cmd) |
3944 |
(tramp-process-actions multi-method method user host |
(tramp-process-multi-actions p method user host |
3945 |
tramp-actions-before-shell) |
tramp-multi-actions) |
3946 |
|
|
3947 |
;; (tramp-message 9 "Waiting 30s for login prompt from %s" host) |
;; (tramp-message 9 "Waiting 30s for login prompt from %s" host) |
3948 |
;; (unless (tramp-wait-for-regexp p 30 tramp-login-prompt-regexp) |
;; (unless (tramp-wait-for-regexp p 30 tramp-login-prompt-regexp) |
3999 |
(erase-buffer) |
(erase-buffer) |
4000 |
(tramp-message 9 "Sending rlogin command `%s'" cmd1) |
(tramp-message 9 "Sending rlogin command `%s'" cmd1) |
4001 |
(process-send-string p cmd) |
(process-send-string p cmd) |
4002 |
(tramp-process-actions multi-method method user host |
(tramp-process-multi-actions p method user host |
4003 |
tramp-actions-before-shell) |
tramp-multi-actions) |
4004 |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host) |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt from %s" host) |
4005 |
;; (unless (setq found |
;; (unless (setq found |
4006 |
;; (tramp-wait-for-regexp p 60 |
;; (tramp-wait-for-regexp p 60 |
4053 |
(erase-buffer) |
(erase-buffer) |
4054 |
(tramp-message 9 "Sending su command `%s'" cmd1) |
(tramp-message 9 "Sending su command `%s'" cmd1) |
4055 |
(process-send-string p cmd) |
(process-send-string p cmd) |
4056 |
(tramp-process-actions multi-method method user host |
(tramp-process-multi-actions p method user host |
4057 |
tramp-actions-before-shell) |
tramp-multi-actions) |
4058 |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt for %s" (or user (user-login-name))) |
;; (tramp-message 9 "Waiting 60s for shell or passwd prompt for %s" (or user (user-login-name))) |
4059 |
;; (unless (setq found (tramp-wait-for-regexp |
;; (unless (setq found (tramp-wait-for-regexp |
4060 |
;; p 60 (format "\\(%s\\)\\|\\(%s\\)\\'" |
;; p 60 (format "\\(%s\\)\\|\\(%s\\)\\'" |
4393 |
(tramp-message 5 "Sending the Perl `mime-encode' implementation.") |
(tramp-message 5 "Sending the Perl `mime-encode' implementation.") |
4394 |
(tramp-send-linewise |
(tramp-send-linewise |
4395 |
multi-method method user host |
multi-method method user host |
4396 |
(concat "tramp_mimencode () {\n" |
(concat "tramp_encode () {\n" |
4397 |
(if (tramp-find-executable multi-method method user host |
(format tramp-perl-encode tramp-remote-perl) |
4398 |
"mimencode" tramp-remote-path t) |
" 2>/dev/null" |
|
"mimencode -b $1" |
|
|
(concat tramp-remote-perl |
|
|
" -e '" tramp-perl-mime-encode "' $1 2>/dev/null")) |
|
4399 |
"\n}")) |
"\n}")) |
4400 |
(tramp-wait-for-output) |
(tramp-wait-for-output) |
4401 |
(tramp-message 5 "Sending the Perl `mime-decode' implementation.") |
(tramp-message 5 "Sending the Perl `mime-decode' implementation.") |
4402 |
(tramp-send-linewise |
(tramp-send-linewise |
4403 |
multi-method method user host |
multi-method method user host |
4404 |
(concat "tramp_mimedecode () {\n" |
(concat "tramp_decode () {\n" |
4405 |
(if (tramp-find-executable multi-method method user host |
(format tramp-perl-decode tramp-remote-perl) |
4406 |
"mimencode" tramp-remote-path t) |
" 2>/dev/null" |
|
"mimencode -u -b $1" |
|
|
(concat tramp-remote-perl |
|
|
" -e '" tramp-perl-mime-decode "' $1 2>/dev/null")) |
|
4407 |
"\n}")) |
"\n}")) |
4408 |
(tramp-wait-for-output)))) |
(tramp-wait-for-output)))) |
4409 |
;; Find ln(1) |
;; Find ln(1) |
4443 |
(tramp-message |
(tramp-message |
4444 |
5 "Checking to see if encoding/decoding commands work on remote host...done")))) |
5 "Checking to see if encoding/decoding commands work on remote host...done")))) |
4445 |
|
|
4446 |
|
;; XXX adapt rest of code to new mechanism. |
4447 |
|
;; We now have remote and local encoders and decoders, and each can be |
4448 |
|
;; a string (shell command) or a symbol (Lisp function). |
4449 |
(defvar tramp-coding-commands |
(defvar tramp-coding-commands |
4450 |
'(("mimencode -b" "mimencode -u -b" |
`(("tramp_encode" "tramp_decode" |
4451 |
|
"uuencode xxx" uudecode-decode-region) |
4452 |
|
("mimencode -b" "mimencode -u -b" |
4453 |
base64-encode-region base64-decode-region) |
base64-encode-region base64-decode-region) |
4454 |
("mmencode -b" "mmencode -u -b" |
("mmencode -b" "mmencode -u -b" |
4455 |
base64-encode-region base64-decode-region) |
base64-encode-region base64-decode-region) |
|
("tramp_mimencode" "tramp_mimedecode" |
|
|
base64-encode-region base64-encode-region) |
|
4456 |
("uuencode xxx" "uudecode -o -" |
("uuencode xxx" "uudecode -o -" |
4457 |
nil uudecode-decode-region) |
"uuencode xxx" uudecode-decode-region) |
4458 |
("uuencode xxx" "uudecode -p" |
("uuencode xxx" "uudecode -p" |
4459 |
nil uudecode-decode-region)) |
"uuencode xxx" uudecode-decode-region)) |
4460 |
"List of coding commands for inline transfer. |
"List of coding commands for inline transfer. |
4461 |
Each item is a list (ENCODING-COMMAND DECODING-COMMAND |
Each item is a list (REMOTE-ENCODING REMOTE-DECODING |
4462 |
ENCODING-FUNCTION DECODING-FUNCTION). |
LOCAL-ENCODING LOCAL-DECODING). |
4463 |
|
|
4464 |
|
Each item can be a string, giving a command, or a symbol, giving |
4465 |
|
a function. |
4466 |
|
|
4467 |
The ENCODING-COMMAND should be a command accepting a plain file on |
The ENCODING-COMMAND should be a command accepting a plain file on |
4468 |
standard input and writing the encoded file to standard output. The |
standard input and writing the encoded file to standard output. The |