lhp@nereida:~/Lperl/src/expect/tutorial$ cat -n callbacks 1 #!/usr/bin/perl -w 2 use strict; 3 use Expect; 4 5 # $Expect::Debug=2; 6 $Expect::Exp_Internal=1; 7 8 # Get the password. 9 sub Expect::get_password { 10 my $stdin = shift; 11 12 $| = 1; 13 print "Enter password: "; 14 $stdin->exp_stty('-echo'); # Now turn off echoing 15 my ($match_num,$error,$match,$before,$after)=$stdin->expect(undef,"\n"); 16 my $password = $before; 17 $stdin->exp_stty('echo'); # Turn echo back on 18 print "\n"; # print that newline that wasn't echoed 19 return $password; 20 } 21 22 my $timeout = 10; 23 my $RSH=`which ssh`; chomp($RSH); 24 my $host_to_login_to= shift || 'localhost'; 25 my $stdin=Expect->exp_init(\*STDIN); 26 my $username = shift || `whoami`; 27 my $password = $stdin->get_password(); 28 my $prompt = qr'[$>#:] $'; 29 my $spawn_ok; 30 31 sub login_handler { 32 my $self = shift; 33 $spawn_ok = 1; 34 print $self "$username\n"; 35 exp_continue; 36 } 37 38 sub password_handler { 39 my $self = shift; 40 $spawn_ok = 1; 41 print $self "$password\n"; 42 exp_continue; 43 } 44 45 sub eof_handler { 46 my $self = shift; 47 die "Error! Premature EOF during login\n" if $spawn_ok; 48 die "Error! Could not spawn ssh\n"; 49 } 50 51 ### main 52 53 #$stdin->stty(qw(raw -echo)); 54 my $ssh = Expect->spawn($RSH, $host_to_login_to) or die "Cannot spawn ssh: $!\n"; 55 56 $ssh->expect( 57 $timeout, 58 [qr'login: $', \&login_handler], 59 ['Password: ', \&password_handler], 60 ['eof', \&eof_handler], 61 ['timeout', sub { die "No login.\n"; }], 62 '-re', $prompt, # wait for shell prompt then exit expect 63 ); 64 65 print $ssh "uname -a\n"; $ssh->expect($timeout, '-re', $prompt); 66 print $ssh "bc\n"; $ssh->expect($timeout, '-re', '.+'); 67 print $ssh "4*8\n"; $ssh->expect($timeout, '-re', '\d+\*\d+\s+\d+'); 68 my $result = $ssh->match(); 69 print $ssh "quit\n"; $ssh->expect($timeout, '-re', $prompt); 70 71 $ssh->hard_close(); 72 $stdin->stty(qw(sane)); 73 74 $result =~ s/[\r\n]/=/g; 75 print "\nRemote Machine Result: $result\n"; 76 77 =head1 NAME callbacks 78 79 =head1 SYNOPSIS 80 81 callbacks [machine [username]] 82 83 =head1 DESRIPTION 84 85 Example illustrating the use of the Expect.pm module. 86 Makes a ssh connection to C<machine> as C<username>. 87 Ask for the pass and send it using C<Expect>. Sends 88 a C<uname> command and closes the session. 89 90 Follows an example of use of this script. 91 92 lhp@nereida:~/Lperl/src/expect/tutorial$ ./callbacks europa pp2 93 Enter password: 94 Linux europa.xxxx.xxx.es 2.4.20-ck2 #1 vie mar 28 17:32:02 WET 2003 i686 unknown 95 96 Most of the programs included with the Debian GNU/Linux system are 97 freely redistributable; the exact distribution terms for each program 98 are described in the individual files in /usr/share/doc/*/copyright 99 100 Debian GNU/Linux comes with ABSOLUTELY NO WARRANTY, to the extent 101 permitted by applicable law. 102 You have mail. 103 Last login: Wed Mar 15 10:09:39 2006 from nereida.xxxx.xxx.es 104 lhp@europa:~$ lhp@nereida:~/Lperl/src/expect/tutorial$La llamada de la línea 56 en este ejemplo tiene un formato diferente. Sigue el esquema:
$exp->expect( $timeout, [ qr/regexp1/i, sub { my $self = shift; ... exp_continue; }, @optional_subparams], [ qr/regexp2/i, sub { my $self = shift; ... exp_continue; }, @optional_subparams], [ qr/regexp3/i, sub { my $self = shift; ... exp_continue_timeout; }, @optional_subparams], ................................................................................. [ 'eof', sub { my $self = shift; ... exp_continue; }, @optional_subparams], [ 'timeout', sub { my $self = shift; ... exp_continue; }, @optional_subparams], $shell_prompt);Esto es, una especificación de un patrón viene dada por el esquema
[ $regexp, sub { ... }, @optional_subparams]
Cuando el patrón casa se llama a la subrutina con parámetros
($matched_expect_obj, @optional_subparms)
.
La subrutina puede retornar el símbolo exp_continue
para continuar con el casamiento de patrones reinicializando el
reloj o bien exp_continue_timeout
para continuar
sin reiniciarlo.
Casiano Rodríguez León