Usando Callbacks

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.