Control de un Programa Externo con IO::Pty

El código que sigue muestra una relación bidireccional con la calculadora bc. La subrutina do_command en la línea 10 procede al lanzamiento de un programa cuya entrada/salida se acopla a una seudoterminal. El contructor IO::Pty->new retorna el manejador de fichero de seudoterminal que representa el lado maestro de la seudoterminal (línea 13). El proceso padre despues de crear el proceso hijo en la línea 15 y establecer los modos de la seudoterminal según hayan sido especificados en la línea de comandos (línea 14) retorna (línea 16) devolviendo el manejador. El proceso hijo se deshace de la terminal y arranca una nueva sesión llamando a $pty->make_slave_controlling_terminal(). Esta función crea una nueva sesión y convierte al hijo en lider de la nueva sesión.

Una sesión es un conjunto de procesos que comparten la misma terminal. En cualquier instante solo un grupo de procesos del conjunto tiene el privilegio de leer/escribir en la terminal. Decimos que estos procesos están en foreground y que el resto de los procesos están en background. Estos procesos en foreground juegan un papel especial en el manejo de señales generadas por los caracteres de entrada. Un grupo de sesión está relacionado pero no es exactamente lo mismo que un grupo de procesos. Un grupo de procesos es un conjunto de procesos que han sido lanzados por un padre común y se caracterizan mediante un entero (el PID del grupo) que es el PID del ancestro común.

Cuando una terminal resulta asociada con una sesión, el grupo de procesos en foreground se establece como el grupo de procesos del lider de sesión. La terminal asociada con una sesión es conocida como terminal controlada. La terminal controlada es heredada por los hijos generados durante un fork. La terminal controlada para una sesión es asignada por el lider de sesión de una manera que es dependiente de la implementación. Los procesos normales no pueden modificar la terminal controlado; solo el proceso lider puede hacerlo.

Si un proceso pertenece al grupo de procesos en foreground de su terminal puede leer y escribir en ella; sin embargo, un proceso en el grupo de procesos en background que intente leer o escribir en su terminal dará lugar a la generación de una señal a su grupo de procesos (SIGTTIN para la lectura, SIGTTOU para la escritura)7.1.

Cada proceso de una sesión que tiene una terminal controlada tiene la misma terminal controlada. Una terminal puede ser la terminal de control de a lo mas una sesión.

A un nivel mas bajo que el proporcionado por make_slave_controlling_terminal, la función setsid (proveída por el módulo POSIX) crea una nueva sesión y un nuevo grupo de la que sólo el proceso forma parte. Se desacopla el proceso de la terminal actual: Un proceso abandona su terminal controlada cuando crea una nueva sesión con setsid.

El siguiente paso es llamar (línea 18) a $pty->slave(). Este método retorna el manejador del otro lado de la seudoterminal, del lado esclavo. Este es el momento para - si el módulo IO::Stty esta instalado - llamar al método $slave->stty() para modificar las características de la seudoterminal.

Después se reabren STDIN, STDOUT y STDERR en el lado esclavo de la seudoterminal. Obsérvese como STDIN, STDOUT y STDERR son tratadas como objetos constantes de clase IO::Handle. A partir de ahora toda la comunicación con la aplicación ocurrirá a través de estos tres objetos y la copia $tty del objeto no hace ya falta. En la línea 24 se hace que las salidas por STDOUT se hagan sin buffers. Por último se ejecuta el comando y - en el caso de fallo del lanzamiento - se emite el correspondiente diagnóstico final.

lhp@nereida:~/Lperl/src/perl_networking/ch2$ cat -n bc_pty6.pl
 1  #!/usr/bin/perl -sw
 2  use strict;
 3  use IO::Handle;
 4  use IO::Pty;
 5  use POSIX;
 6  use constant DEBUG => 1;
 7  use constant DEFAULT_DEADLINE => 1;
 8  my $after = "";
 9
10  sub do_command {
11    my ($stty, $command, @args) = @_;
12
13    my $pty = IO::Pty->new or die "Can't make Pty: $!";
14    $pty->slave->stty($stty);
15    defined(my $child = fork) or die "Can't fork: $!";
16    return $pty if $child;
17    $pty->make_slave_controlling_terminal();
18    my $tty = $pty->slave();
19    close($pty);
20    STDIN->fdopen($tty, "<");
21    STDOUT->fdopen($tty, ">");
22    STDERR->fdopen($tty, ">");
23    close($tty);
24    $| = 1;
25    exec $command, @args;
26    die "Couldn't exec $command @args: $!";
27  }
28
29  sub alarmhandler { die; }
30
31  {
32    my $line = '';
33
34    sub waitfor {
35      my $pty = shift;
36      my $regexp = shift;
37      my $seconds = shift || DEFAULT_DEADLINE;
38      my ($localline, $delayed);
39
40      alarm($seconds);
41      eval {
42        while (sysread($pty, $line, 2048, length($line))) {
43          last if $line =~ m{$regexp};
44        }
45      };
46      alarm(0);
47      $line =~ m{($regexp)};
48      if (defined($1)) {
49        $localline = substr($line, 0, $+[0]); 
50        $line = substr($line, length($localline));
51        $delayed = 0;
52      }
53      else {
54        $localline = $line;
55        $line = '';
56        $delayed = 1;
57      }
58      return wantarray? ($localline, $line, $delayed) : $localline;
59    }
60  }  # clausura
61
62  sub printRes {
63    my ($r, $s, $d) = @_;
64
65    print "\n<<r = '$r'\ns = '$s'\nd = $d>>"
66  }
67
68  local $SIG{ALRM} = \&alarmhandler;
69  our $n;
70  our $stty;
71  our $pause;
72
73  $n = 4 unless defined($n);
74  $stty = '' unless defined($stty);
75  $pause = 1 unless defined($pause);
76
77  my $pty = do_command($stty, 'bc');
78  my ($r, $s, $d)  = waitfor($pty, qr{warranty'\.\s+});
79  printRes($r, $s, $d);
80
81  sleep $pause; # Démosle tiempo a la calculadora de iniciar
82  print $pty "fact = 1; fact\n";
83  ($r, $s, $d) = waitfor($pty, qr{\n\d+\s+});
84  printRes($r, $s, $d);
85  foreach (2..$n) {
86    print $pty "fact *= $_; fact\n";
87    ($r, $s, $d) = waitfor($pty, qr{\n\d+\s+});
88    printRes($r, $s, $d);
89  }
90  print $pty "quit\n";
91  print "\n";
El programa principal (líneas 68-91) consiste en la emisión de comandos a la calculadora (mediante sentencias print $pty "comando" y el procesado de la respuesta mediante llamadas a la función waitfor situada en la clausura que se extiende en las líneas de la 31 a la 60. La función waitfor($pty, /regexp/, deadline) permanece leyendo desde $pty hasta que la entrada casa con /regexp/ o hasta que el tiempo de espera sobrepasa el umbral deadline. En la línea 49 se establece localline al prefijo que va hasta el final del casamiento (recuerde que el array @+ contiene los desplazamientos de los finales de las subcadenas en $1, etc.). La variable $line (línea 50) se actualiza al sufijo desde el final del casamiento, conservando sus contenidos para la siguiente llamada.

Al ejecutar el programa anterior obtenemos la siguiente salida:

lhp@nereida:~/Lperl/src/perl_networking/ch2$ ./bc_pty6.pl -pause=0

<<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>>
<<r = 'fact = 1; fact
fact = 1; fact
1
'
s = ''
d = 0>>
<<r = 'fact *= 2; fact
2
'
s = ''
d = 0>>
<<r = 'fact *= 3; fact
6
'
s = ''
d = 0>>
<<r = 'fact *= 4; fact
24
'
s = ''
d = 0>>
lhp@nereida:~/Lperl/src/perl_networking/ch2$
Obsérvese la curiosa repetición
fact = 1; fact
fact = 1; fact
Esta repetición puede eliminarse poniendo 1 segundo de espera antes de enviar los comandos a la calculadora:
lhp@nereida:~/Lperl/src/perl_networking/ch2$ ./bc_pty6.pl -pause=1

<<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>>
<<r = 'fact = 1; fact
1
'
s = ''
d = 0>>
<<r = 'fact *= 2; fact
2
'
s = ''
d = 0>>
<<r = 'fact *= 3; fact
6
'
s = ''
d = 0>>
<<r = 'fact *= 4; fact
24
'
s = ''
d = 0>>
lhp@nereida:~/Lperl/src/perl_networking/ch2$

Obsérvese como cambia la salida si ponemos la seudoterminal en modo - echo:

lhp@nereida:~/Lperl/src/perl_networking/ch2$ ./bc_pty6.pl -pause=0 -stty='-echo'

<<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>>
<<r = '1
'
s = ''
d = 1>>
<<r = '2
'
s = ''
d = 1>>
<<r = '6
'
s = ''
d = 1>>
<<r = '24
'
s = ''
d = 1>>
lhp@nereida:~/Lperl/src/perl_networking/ch2$



Subsecciones
Casiano Rodríguez León
Licencia de Creative Commons
Programación Distribuida y Mejora del Rendimiento
por Casiano Rodríguez León is licensed under a Creative Commons Reconocimiento 3.0 Unported License.

Permissions beyond the scope of this license may be available at http://campusvirtual.ull.es/ocw/course/view.php?id=44.
2012-06-19