Sig: Práctica: Cambiar la clave Sup: Pseudoterminales Ant: El Módulo IO::Pty
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; factEsta 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$
