Convirtiendo un Programa en un Servicio

El siguiente ejemplo esta tomado del libro de Lincoln Stein Network Programming with Perl [1]. El ejemplo es similar al de la sección anterior pero ilustra además como reconvertir un programa en un servicio.

Habitualmente un programa utiliza la entrada-salida estandar para comunicarse con el usuario. Por ejemplo, el módulo Chatbot::Eliza establece un diálogo con el usuario imitando a un psiquiatra:

nereida:~/LGRID_Machine/lib/GRID$ perl -wde 0
main::(-e:1):   0
  DB<1> use Chatbot::Eliza
  DB<2> $bot = Chatbot::Eliza->new
  DB<3> $bot->command_interface()
Eliza:  Is something troubling you?
you:    The future
Eliza:  I'm not sure I understand you fully.
you:    Nothing stands, everything changes
Eliza:  I'm not sure I understand you fully.
you:    Is very honest from you to say that
Eliza:  Oh, I to say that?
you:    bye!
Eliza:  Goodbye.  It was nice talking to you.

La solución está en redirigir la entrada/salida del programa hacia el socket tal y como hacíamos en la sección 1.5.

milogin@beowulf:~/src/perl/NETWORKING$ cat -n eliza_server.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use Chatbot::Eliza;
 4  use IO::Socket;
 5  use POSIX 'WNOHANG';
 6
 7  my $PORT = shift || 1026;
 8
 9  my $quit = 0;
10
11  # signal handler for child die events
12  $SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };
13
14  # signal handler for interrupt key and TERM signal (15)
15  $SIG{INT} = sub { $quit++ };
16
17  my $listen_socket = IO::Socket::INET->new(LocalPort => $PORT,
18                                            Listen    => 20,
19                                            Proto     => 'tcp',
20                                            Reuse     => 1,
21                                            Timeout   => 60*60,
22                                           );
23  die "Can't create a listening socket: $@" unless $listen_socket;
24  warn "Server ready.  Waiting for connections...\n";
25
26  while (!$quit) {
27
28    next unless my $connection = $listen_socket->accept;
29
30    defined (my $child = fork()) or die "Can't fork: $!";
31    if ($child == 0) {
32      $listen_socket->close;
33      interact($connection);
34      exit 0;
35    }
36
37    $connection->close;
38  }
39
40  sub interact {
41    my $sock = shift;
42    STDIN->fdopen($sock,"<")  or die "Can't reopen STDIN: $!";
43    STDOUT->fdopen($sock,">") or die "Can't reopen STDOUT: $!";
44    STDERR->fdopen($sock,">") or die "Can't reopen STDERR: $!";
45    $|=1;
46    my $bot = Chatbot::Eliza->new;
47    $bot->command_interface();
48  }

El método command_interface del objeto $bot (línea 47) utiliza los ficheros STDIN y STDOUT. Pero ahora, al reconvertir el método a un servicio queremos que use el socket $sock.

El método fdopen en IO::Handle funciona de manera parecida a open pero su primer parámetro es un descriptor de fichero. El método cierra el fichero y lo reabre utilizando el manejador $sock proveído como argumento. Después de las tres llamadas en las líneas 42-44 escribir en STDOUT y STDERR es enviar los datos vía el socket. Leer desde STDIN es leer desde el socket. Funciona de manera parecida a las aperturas con los descriptores ">&" (escritura) y "<&" (lectura).

casiano@beowulf:~/src/perl/NETWORKING$ ./eliza_server.pl
Server ready.  Waiting for connections...
..............................
milogin@beowulf:~/src/perl/netserver$ pkill eliza_server

milogin@micasa:~/LPOP$ telnet beowulf 1026
Trying 123.123.123.123...
Connected to beowulf.
Escape character is '^]'.
Eliza:  Please tell me what's been bothering you.
you:    Hey! it works!
Eliza:  Tell me more about that.
you:    You are server. You work
Eliza:  Do you sometimes wish you were server?
you:    No
Eliza:  Are you saying no just to be negative?
you:    quit
Eliza:  Life is tough.  Hang in there!
Connection closed by foreign host.

Hay otro problema con la conversión de Eliza en un servicio. Eliza esta pensado para trabajar con un sólo usuario y por ello sólo termina cuando la entrada contiene palabras como quit o bye. En otro caso se queda en un bucle a la espera por mas entrada del usuario. Incluso si se genera un final de fichero pulsando CTRL-D no termina.

Para lograr que el programa termine cuando se alcanza el final de fichero Lincoln Stein propone sustituir el método privado _test_quit del objeto por este:

sub Chatbot::Eliza::_testquit {
  my ($self,$string) = @_;
  return 1 unless defined $string;  # test for EOF
  foreach (@{$self->{quit}}) { return 1 if $string =~ /\b$_\b/i };
}