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 utmpSin 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: 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. |