El Programa Completo

Código del Servidor

La llamada a open_pid_file se hace antes de poner el servidor en background para tener la oportunidad de emitir los mensajes de error.

El bloque END{}:

END { unlink $PID_FILE if defined($pid) && ($$ == $pid); }

hace que el servidor suprima el fichero a su salida. La comprobación garantiza que en el caso de que el daemon se bifurque en una jerarquía de procesos, solo un proceso, el principal, intente borrar el fichero.

Mediante la instalación de los manejadores para las señales INT (valor numérico 2) y TERM (15) aseguramos que el bloque END se ejecutará en el caso de que se produzcan tales señales.

casiano@beowulf:~/src/perl/NETWORKING$ cat -n eliza_daemon.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use Chatbot::Eliza;
 4  use IO::Socket;
 5  use IO::File;
 6  use POSIX qw(WNOHANG setsid);
 7
 8  my $PORT = shift || 1026;
 9  my $PID_FILE  = shift || '/tmp/.eliza.pid'; # /var/run/eliza.pid
10  my $quit = 0;
11
12  # signal handler for child die events
13  $SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };
14  $SIG{TERM} = $SIG{INT} = sub { $quit++ };
15
16  my $fh = open_pid_file($PID_FILE);
17  my $listen_socket = IO::Socket::INET->new(LocalPort => shift || $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
25  warn "$0 starting... Listening at $PORT\n";
26  my $pid = become_daemon();
27  print $fh $pid;
28  close $fh;
29
30  while (!$quit) {
31
32    next unless my $connection = $listen_socket->accept;
33
34    die "Can't fork: $!" unless defined (my $child = fork());
35    if ($child == 0) {
36      $listen_socket->close;
37      interact($connection);
38      exit 0;
39    }
40
41    $connection->close;
42  }
43
44  sub interact {
45    my $sock = shift;
46    STDIN->fdopen($sock,"<")  or die "Can't reopen STDIN: $!";
47    STDOUT->fdopen($sock,">") or die "Can't reopen STDOUT: $!";
48    STDERR->fdopen($sock,">") or die "Can't reopen STDERR: $!";
49    $| = 1;
50    my $bot = Chatbot::Eliza->new;
51    $bot->command_interface;
52  }
53
54  sub become_daemon {
55    die "Can't fork" unless defined (my $child = fork);
56    exit 0 if $child;    # parent dies;
57    warn "PID: $$\n";
58    setsid();     # become session leader
59    open(STDIN, "</dev/null");
60    open(STDOUT,">/dev/null");
61    open(STDERR,">&STDOUT");
62    chdir '/';           # change working directory
63    umask(0);            # forget file mode creation mask
64    $ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
65    return $$;
66  }
67
68  sub open_pid_file {
69    my $file = shift;
70    if (-e $file) {  # oops.  pid file already exists
71      my $fh = IO::File->new($file) || die "Can't open file $file\n";
72      my $pid = <$fh>;
73      die "Corrupted PID file  $PID_FILE\n" unless defined($pid) && ($pid =~ /^\s*\d+\s*$/);
74      die "Server already running with PID $pid" if kill 0 => $pid;
75      warn "Removing PID file for defunct server process $pid.\n";
76      die "Can't unlink PID file $file" unless -w $file && unlink $file;
77    }
78    return IO::File->new($file,O_WRONLY|O_CREAT|O_EXCL,0644)
79      or die "Can't create $file: $!\n";
80  }
81
82  sub Chatbot::Eliza::_testquit {
83    my ($self,$string) = @_;
84    return 1 unless defined $string;  # test for EOF
85    foreach (@{$self->{quit}}) { return 1 if $string =~ /\b$_\b/i };
86  }
87
88  END { unlink $PID_FILE if defined($pid) && ($$ == $pid); }

Si el daemon se ejecutara como root podríamos escribir en /var/run/ siguiendo el convenio clásico en Linux para los daemons.

casiano@mymachine:~/src/perl/NETWORKING$ ls -ltr /var/run | tail -5
-rw-r--r-- 1 root        root            6 may 13 23:26 syslogd.pid
drwxr-xr-x 2 tomcat5     adm          4096 may 13 23:43 tomcat5
-rw-r--r-- 1 root        root            6 may 14 00:15 apache2.pid
-rw-r--r-- 1 root        root            5 may 14 09:55 sshd.pid
-rw-rw-r-- 1 root        utmp        14976 may 14 12:58 utmp

Sin embargo ejecutar el daemon con privilegios de root a estas alturas no es una buena idea. Es posible comenzar la aplicación como root - para abrir sockets en puertos privilegiados o ficheros de PID y log en localizaciones como /var/run/ - para renunciar a los privilegios de root tan pronto como sea posible. Por ahora simplemente creamos el fichero de PID en un lugar al que tengamos acceso.

Ejecución

Ejecución: Servidor

casiano@beowulf:~/src/perl/NETWORKING$ ./eliza_daemon.pl
./eliza_daemon.pl starting...
casiano@beowulf:~/src/perl/NETWORKING$ pgrep -l eliza
25561 eliza_daemon.pl
casiano@beowulf:~/src/perl/NETWORKING$ ./eliza_daemon.pl
Server already running with PID 25561 at ./eliza_daemon.pl line 72, <GEN0> line 1.

Ejecución: Cliente

casiano@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:    wau!
Eliza:  That is interesting. Please continue.
you:    uff!
Eliza:  I'm not sure I understand you fully.
you:    For sure you don't understand me
Eliza:  Do you wish to believe I don't understand you?
you:    No
Eliza:  Are you saying no just to be negative?
you:    yes
Eliza:  Please tell me some more about this.
you:    quit
Eliza:  Goodbye.  I hope you found this session helpful.
Connection closed by foreign host.

Ejercicio 14.1.1  

1. Prueba a cerrar la shell después de arrancado el demonio ¿Sigue vivo el daemon?
2. Prueba a eliminar la terminal después de arrancado el demonio ¿Sigue vivo el daemon?
3. ¿A donde va a parar el mensaje de error de la línea 34?