Una Introducción a Expect

El módulo Expect será estudiado en mas detalle en la sección 8.1. Esta sección es una rápida introducción al módulo. Expect resuelve el problema de la comunicación bidireccional con un proceso externo.

Bastiones

Como ejemplo escribiremos un guión que realiza una conexión ssh con una red protegida por un bastion. Un bastión es un ordenador que es el único punto de entrada/salida a internet desde una red interna. Los bastiones se usan para disminuir los problemas de seguridad al establecer una barrera entre las zonas públicas y privadas.

Nuestro guión supone que hay un ordenador bastión el cual permite una conexión ssh. Una vez validada la conexión mediante el username y el password se nos pregunta a que máquina queremos conectarnos. Suponemos que dependiendo de la máquina será necesario introducir de nuevo la clave o no.

pp2@nereida:~/src/perl/expect$ cat -n bastion
 1  #!/usr/bin/perl -w
 2  use strict;
 3  use Getopt::Long;
 4  use Pod::Usage;
 5  use List::MoreUtils qw(any);
 6  use Expect;
 7
 8  my $VERSION = "1.0";
 9  my $RSH = `which ssh`;
10  chomp($RSH);
11  my $password = "";
12  my $user = $ENV{USER};
13  my $machine = 'millo';
14  my $bastion;
15  my $config;
16
17  my $delay = 1;
18  my $passwordprompt = 'word:\s$';
19  my $machineprompt = 'salir\)(\s)+$';
20  my @MOREPASSWORDS = ();
21
22  GetOptions(
23      'ssh=s'       => \$RSH,
24      'password=s'  => \$password,
25      'user=s'      => \$user,
26      'machine=s'   => \$machine,
27      'bastion=s'   => \$bastion,
28      'config=s'    => \$config,
29      'version'     => \&version,
30      'help'        => \&man,
31    ) or croak usage();
32
33
34  ($config) = @ARGV if @ARGV;
35
36  $config = ".bastion.conf" if !$config and !$bastion and -r ".bastion.conf";
37  $config = "$ENV{HOME}/.bastion.conf" if !$config and !$bastion and -r "$ENV{HOME}/.bastion.conf";
38
39  eval_config($config) if $config and -r $config;
40
41  die man() unless $bastion and $bastion =~ m{(\w+\.?)+};
42  my $host_to_login_to=$user.'@'.$bastion;

El Fichero de Configuración

El programa comienza obteniendo los valores desde la línea de comandos o desde un fichero de configuración (opción config).

31  my ($passwordprompt, $machineprompt, $delay, @MOREPASSWORDS);
32
33  eval_config($config) if $config and -r $config;
El fichero de configuración esta escrito en Perl y es evaluado de manera parecida a como se hizo en la práctica 1.9.

Estos son los contenidos de un fichero de configuración:

pp2@nereida:~/src/perl/expect$ cat -n bastion.conf
 1  $password = 'password';
 2  $user = 'user';
 3  $machine = 'banot';
 4  #$machine = 'millo';
 5  $bastion = 'exthost.instituto.ull.es';
 6
 7  # Seconds to wait before leaving
 8  $delay = 3;
 9
10  # user@instituto's password:
11  $passwordprompt = 'word:\s$';
12
13  # Nombre de la máquina?:(q para salir)
14  $machineprompt = 'salir\)(\s)+$';
15
16  @MOREPASSWORDS = qw(timple manis banot tonga);

El Código Principal

42  my $host_to_login_to=$user.'@'.$bastion;
43
44  my $rsh=Expect->spawn($RSH,$host_to_login_to);
45
46  $rsh->expect($delay,'-re', $passwordprompt)||(die"Never got password prompt\n");
47  print $rsh "$password\r";
48
49  $rsh->expect($delay,'-re',$machineprompt)||(die"Never got machine prompt\n");
50  print $rsh "$machine\r";
51
52  if (any { /^$machine$/ } @MOREPASSWORDS ) {
53    $rsh->expect($delay,'-re', $passwordprompt)||(die"Never got password prompt\n");
54    print $rsh "$password\r";
55  }
56  # Retornar control al usuario
57  $rsh->interact();
..  .............. # subrutinas de apoyo

El método spawn

El método spawn ejecuta el comando (línea 37) creando una seudoterminal como vía de comunicación entre el comando y el programa cliente.

Seudoterminales

Una seudoterminal es un proceso que proporciona un canal de comunicaciones entre los dos procesos implicados mediante la emulación de una terminal de texto. Casi todos los programas admiten una comunicación vía una terminal y alguno (editores, el programa para cambiar la clave de usuario, etc.) solo admiten una comunicación via una seudoterminal. Además, la comunicación con seudoterminales no esta bufferada. Se evita asi el riesgo de bloqueo que introduce la presencia de memorias auxiliares.

El Método expect

Despues de creado el objeto seudoterminal $rsh se establece un diálogo con el comando lanzado (lineas 39-40, 42-43 y 46-47). El método expect permite analizar la salida del comando hasta que case con la expresión regular proporcionada como argumento. La llamada termina si no se produce el casamiento en menos de $delay segundos.

El Método print

Mediante llamadas a print en el manejador de la seudoterminal $rsh proporcionamos la entrada al comando lanzado.

El Método any de List::MoreUtils

Si la máquina de la red interna a la que entramos requiere una validación adicional (esta entre las descritas en el array @MOREPASSWORDS) la (misma) clave es introducida de nuevo.

El Método interact

El método interact (línea 50) devuelve el control de la entrada/salida a los manejadores de fichero habituales STDIN, STDOUT y STDERR.

Ejercicio 8.2.1   Estudie la siguiente cuestion (Module Net::SSH::Expect - Cannot interact) en PerlMonks. ¿Cuales son sus sugerencias?



Subsecciones
Casiano Rodríguez León
2010-03-22
CAPE_OR_EOF 265 } 266 } 267 } 268 redo; 269 } 270 return $return_value; 271 } 272 273 sub deadline { 274 ${$_[0]->{deadline}} = $_[1] if @_ >1; 275 ${$_[0]->{deadline}}; 276 } 277 278 sub parenthesis { 279 return @{$_[0]->{parenthesis}}; 280 } 281 282 sub can_read { 283 my $self = shift; 284 my $deadline = shift; 285 my $sel = $self->{sel}; 286 287 return $sel->can_read($deadline); 288 } 289 290 sub can_write { 291 my $self = shift; 292 my $deadline = shift; 293 my $sel = $self->{sel}; 294 295 return $sel->can_write($deadline); 296 } 297 298 sub AUTOLOAD { 299 my $self = shift; 300 301 $AUTOLOAD =~ /.*::(\w+)/; 302 my $subname = $1; 303 carp "No such method $AUTOLOAD " unless (defined($subname)); 304 no strict 'refs'; 305 if (exists($self->{$subname})) { 306 *{$AUTOLOAD} = sub { 307 $_[0]->{$subname} = $_[1] if @_ >1; 308 $_[0]->{$subname} 309 }; 310 $self->{$subname} = $_[0] if @_; 311 return $self->{$subname}; 312 } 313 carp "No such method $AUTOLOAD"; 314 } 315 316 sub DESTROY { 317 } 318 319 1;

Veamos un ejemplo de uso:

lhp@nereida:~/Lperl/src/perl_networking/ch2/IO-Pty-Script/script$ cat -n ptyconnect4.pl
 1  #!/usr/bin/perl -sw -I../lib
 2  use strict;
 3  use IO::Pty::Script qw{TIMEOUT DEFAULT_DEADLINE chats};
 4
 5  my %script;
 6  our($c, $d, $p, $f); # Inicializadas via -s switch
 7
 8  $p = '' unless defined($p);
 9  $d = DEFAULT_DEADLINE unless defined($d);
10  $f = '' unless defined($f);
11  die "Usage:$0 -c=command -p=key -d=deadline -f=script\n"
12                                        unless defined($c);
13  my $prompt = '[$>]\s+';
14
15  $script{'ssh -l casiano etsii'} = [
16  '.*password:\s'           => "$p\n",
17  '(word:\s)|(login: )|(> )' => "$f\n",
18  $prompt                    => "exit\n"
19  ];
20
21  #$script{'ssh -l casiano etsii'} = [
22  #'.*password:\s'           => "$p\n",
23  #'.*q para salir.\s\s\s\s' => "millo\n",
24  #'word:\s'                 => "$p\n",
25  #'(word:\s)|(login: )|(> )' => "$f\n",
26  #$prompt                    => "exit\n"
27  #];
28
29  $script{'ssh -l casiano beowulf'} = [
30  '.*password:\s'           => "$p\n",
31  $prompt                   => "$f\n",
32  $prompt                   => "exit\n"
33  ];
34
35  #$script{'ssh europa'} = [
36  #$prompt                   => "$f\n",
37  #$prompt                   => [\&titi, 1, 2, "tres"],
38  #$prompt                   => "exit\n"
39  #];
40
41  $script{'ssh europa'} = [
42  $prompt                   => "$f\n",
43  $prompt                   => [\&titi, 1, 2, "tres"],
44  $prompt                   => sub { my $self = shift; $self->keyboard("\cD"); "ls\n" },
45  $prompt                   => "echo 'Despues de la interaccion'\n",
46  $prompt                   => "exit\n"
47  ];
48
49  sub tutu {
50    print "<<sub tutu:\n";
51    print $_[0];
52    my @par = $_[0]->parenthesis();
53    print "Paréntesis: @par\n";
54    print "Es posible leer en la terminal\n" if $_[0]->can_read(TIMEOUT);
55    print "Es posible escribir en la terminal\n" if $_[0]->can_write(TIMEOUT);
56    print "end sub tutu>>\n";
57    "8*2\n"
58  }
59
60  sub titi {
61    local $" = "\nsub titi:";
62    print "<<sub titi: @_>>\n";
63    "date\n";
64  }
65
66  $script{bc} = [
67  'warranty..\s\s' => "5*9.5\n",
68  '(\d+)\.?(\d*)\s+' => \&tutu,
69  '\d+\.?\d*\s+' => "4*2\n",
70  '\d+\.?\d*\s+' => "quit",
71  ];
72
73  my $bc = IO::Pty::Script->new(
74            command => 'bc',
75            deadline => 4,
76            script => $script{bc},
77            defaultaction => sub { print $_[0] }
78          );
79
80  my $s = IO::Pty::Script->new(
81            command => $c,
82            deadline => $d,
83            script => $script{$c},
84            defaultaction => sub { print $_[0] }
85          );
86  chats($bc, $s);

Sigue un ejemplo de ejecución:

lhp@nereida:~/Lperl/src/perl_networking/ch2/IO-Pty-Script/script$ ptyconnect4.pl -c='ssh -l casiano beowulf' -p=password -d=3 -f='ls'
<<r = 'bc 1.06
Copyright 1991-1994, 1997, 1998, 2000 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
'
s = ''
d = '0'>>
<<sub tutu:
<<r = '47.5
'
s = ''
d = '0'>>
Paréntesis: 47 5
Es posible escribir en la terminal
end sub tutu>>
<<r = '16
'
s = ''
d = '0'>>
<<r = '8
'
s = ''
d = '0'>>
<<r = 'casiano@beowulf's password: '
s = ''
d = '0'>>
<<r = '
Linux beowulf 2.6.15-1-686 #2 Mon Mar 6 15:27:08 UTC 2006 i686

The programs included with the Debian GNU/Linux system are free software;
the exact distribution terms for each program are described in the
individual files in /usr/share/doc/*/copyright.

Debian GNU/Linux comes with ABSOLUTELY NO WARRANTY, to the extent
permitted by applicable law.
Last login: Mon Jun  5 13:24:42 2006 from nereida.deioc.ull.es
casiano@beowulf:~$ '
s = ''
d = '0'>>
<<r = 'bc_pty2.pl  _Inline  passwd_pty.pl  pilock.pl  src         try6
bc_pty6.pl  log      pi             pi.pl      ssh_pty.pl
casiano@beowulf:~$ '
s = ''
d = '0'>>
lhp@nereida:~/Lperl/src/perl_networking/ch2/IO-Pty-Script/script$



Subsecciones
Casiano Rodríguez León
2011-06-03