[PerlChina] 再问一个网络的编程问题

黄叶 hylinux at gmail.com
Tue Jan 10 22:21:21 PST 2006


我写了两个脚本。
都是使用进程做服务器的。
这两个代码几乎是一模一样的,但是运行后,就是结果不一样。
请那位朋友帮我看一下。
谢谢。

#!/usr/bin/perl
use strict;
use warnings;
use Chatbot::Eliza;
use IO::Socket;
use IO::File;
use POSIX qw(WNOHANG setsid);

use constant PORT => 12000;
use constant PID_FILE => '/var/tmp/eliza.pid';

my $quit = 0;

# signal handler for child die event
$SIG{INT} = sub {
   $quit++;
};

$SIG{CHLD} = sub {
   while ( waitpid(-1, WNOHANG) > 0 ) {

   }
};

my $fh = open_pid_file(PID_FILE);

# create a sock file
my $listen_sock = IO::Socket::INET->new(
   LocalPort => PORT,
   Listen => 20,
   Reuse  => 1,
   Timeout => 60 * 60
);

die "Can't create a listenling socket: $@ \n" unless defined $listen_sock;

warn "$0 Starting...\n";

my $pid = become_daemon();

print $fh $pid;
close $fh;

while ( !$quit ) {
   next unless my $connection = $listen_sock->accept;

   my $child = fork;
   die "Can't fork: $!\n" unless defined $child;

   if ( $child == 0 ) {
      $listen_sock->close;
      interact($connection);
      exit 0;
   }

   $connection->close;
}

sub interact {
   my $sock = shift;
   STDIN->fdopen($sock, "<") or die "Can't reopen the STDIN: $!\n";
   STDOUT->fdopen($sock, ">") or die "Can't reopen the STDOUT: $!\n";
   SDTERR->fdopen($sock, ">") or die "Can't reopen the STDERR: $!\n";
   $| = 1;
   my $bot = Chatbot::Eliza->new;
   $bot->name('Doctor Jane');

   $bot->command_interface;
}

sub open_pid_file {
   my $file = shift;

   if ( -e $file ) {
      my $fh = IO::File->new($file) || return;
      my $pid = <$fh>;
      die "Server already running with PID $pid" if kill 0 => $pid;
      warn "Removing PID file for defunct server process $pid.\n";
      die "Can't unlink PID file $file\n" unless -w $file && unlink $file;
   }

   return IO::File->new($file, O_WRONLY|O_CREAT|O_EXCL, 0644) or die "Can't
create $file:$!\n";
}

sub become_daemon {
   die "Can't fork: $!" unless defined (my $child = fork);
   exit 0 if $child;
   setsid();
   open(STDIN, "</dev/null") or die "Can't reopen the STDIN to /dev/null";
   open(STDOUT, ">/dev/null") or die "Can't reopen the STDOUT to /dev/null";
   open(STDERR, ">&STDOUT") or die "Can't reopen the STDERR to /dev/null";
   chdir "/";
   umask(0);
   $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin";
   return $$;
}


第二个脚本:

#!/usr/bin/perl
use strict;
use warnings;
use Chatbot::Eliza;
use IO::Socket;
use IO::File;
use POSIX qw(WNOHANG setsid);

use constant PORT=> 12000;
use constant PID_FILE => '/var/tmp/eliza.pid';

my $quit = 0;

$SIG{CHLD} = sub {
   while ( waitpid(-1, WNOHANG) > 0 ) {

   }
};

$SIG{INT} = sub {
   $quit++;
};

my $fh = open_pid_file(PID_FILE);

my $listen_port = IO::Socket::INET->new(
   LocalPort => PORT,
   Listen => 20,
   Reuse  => 1,
   Timeout => 60 * 60
);

die "Can't create the socket" unless defined $listen_port;

warn "Server Ready: Waiting for connections...\n";

my $pid = become_daemon();

print $fh $pid;
close $fh;


while ( !$quit ) {
   next unless my $connection = $listen_port->accept;

   my $child = fork;
   die 'Can not fork a new process.' unless defined $child;

   if ( $child == 0 ) {
      # it is child process.
      # will close the socket copy
      $listen_port->close;
      interact($connection);
      exit 0;
   }

   $connection->close;
}

sub interact {
   my $sock = shift;
   STDIN->fdopen($sock, "<") or die "Can't reopen STDIN:$!\n";
   STDOUT->fdopen($sock, ">") or die "Can't reopen STDOUT: $!\n";
   STDERR->fdopen($sock, ">") or die "Can't reopen STDERR: $!\n";
   $| = 1;
   my $bot = Chatbot::Eliza->new;
   $bot->name('Doctor Jane');
   $bot->command_interface;
}

sub become_daemon {
   die "Can't fork" unless defined ( my $child = fork );
   exit 0 if $child;
   setsid();

   open(STDIN, "</dev/null");
   open(STDOUT, ">/dev/null");
   open(STDERR, ">&STDOUT");
   chdir "/";
   umask(0);
   $ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
   return $$;
}

sub open_pid_file {
   my $file = shift;

   if ( -e $file ) {
      my $fh = IO::File->new($file) || return;
      my $pid = <$fh>;
      die "Server already running with PID $pid" if kill 0 => $pid;
      warn "Removing PID file for defunct server process $pid.\n";
      die "Can't unlink PID file $file\n" unless -w $file && unlink $file;
   }

   return IO::File->new($file, O_WRONLY|O_CREAT|O_EXCL, 0644) or die "Can't
create $file:$!\n";
}


谢谢。请高手们帮帮我的忙。
谢谢。
-------------- next part --------------
q?????!???,r??m??m???????j+??j)r?j??j?r????:?u?m
q?????!???


More information about the China-pm mailing list