Есть такой скрипт:#!/usr/bin/perl
use IO::Socket;
use constant PORT => 1000;
use constant USER => 'guest';
use constant GROUP => 'guest';
use constant PIDFILE => '/var/tmp/eliza.pid';
use POSIX qw( :sys_wait_h );
use POSIX qw(setsid);
use Carp 'croak','cluck';
use IO::File;
use Sys::Syslog qw(:DEFAULT setlogsock);
use constant PIDPATH => '/var/run';
use constant FACILITY => 'local0';
my ($pid, $pidfile);
sub init_server {
my ($user,$group);
($pidfile,$user,$group) = @_;
$pidfile ||= getpidfilename();
my $fh = open_pid_file($pidfile);
become_daemon();
print $fh $$;
close $fh;
init_log();
change_privileges($user,$group) if defined $user && defined $group;
return $pid = $$;
}
sub become_daemon {
die "Can't fork" unless defined (my $child = fork);
exit 0 if $child;
setsid();
open(STDIN,"/dev/null");
open(STDERR,">&STDOUT");
chdir '/';
umask(0);
$ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
$SIG{CHLD} = \&reap_child;
return $$;
}
sub init_log {
setlogsock(unix);
my $basename = "elizabet";
openlog($basename,'pid',FACILITY);
}
sub log_debug { syslog('debug',_msg(@_)) }
sub log_notice { syslog('notice',_msg(@_)) }
sub log_warn { syslog('warning',_msg(@_)) }
sub log_die {
syslog('crit',_msg(@_));
die @_;
}
sub _msg {
my $msg = join('',@_) || "Something's wrong";
my ($pack,$filename,$line) = caller(1);
$msg .= " at $filename line $line\n" unless $msg =~ /\n$/;
$msg;
}
sub getpidfilename {
my $basename = "elizabet";
return PIDPATH . "/$basename.pid";
}
sub open_pid_file {
my $file = shift;
if(-e $file) {
my $fh = IO::File->new($file) || return;
my $pid = <$fh>;
croak "Server already running with PID $pid" if kill 0 => $pid;
cluck "Removing PID file for defunct server process $pid.\n";
croak "Can't unlink PID file $file" unless -w $file && unlink $file;
}
return IO::File->new($file, O_WRONLY|O_CREAT|O_EXCL, 0644) or die "Can't create pid file $file: $!\n";
}
sub reap_child {
do { } while waitpid(-1,WHOHANG) > 0;
}
sub change_privileges {
my ($user,$group) = @_;
my $uid = getpwnam($user) or log_die("Can't get uid for $user\n");
my $gid = getgrnam($group) or log_die("Can't get gid for $group\n");
$) = "$gid $gid";
$( = $gid;
$> = $uid;
}
$SIG{TERM} = $SIG{INT} = sub { $quit++ };
my $port = shift || PORT;
my $listen_socket = IO::Socket::INET->new(LocalPort=>PORT,
Listen=>20,
Proto=>'tcp',
Reuse=>1,
Timeout=>60*60,
);
die "Can't create a listening socket: $@" unless $listen_socket;
my $pid = init_server(PIDFILE, USER, GROUP);
log_notice "Server acception connections on port $port\n";
while (my $connection = $listen_socket->accept) {
my $host = $connection->peerhost;
log_die("Can't fork: $!") unless defined (my $child = fork());
if ($child == 0) {
$listen_socket->close;
$< = $>;
log_notice("Accepting a connection from %s\n",$host);
interact($connection);
log_notice("Connection from %s finished\n",$host);
}
$connection->close;
}
sub interact {
my $sock = shift;
STDIN->fdopen($sock,"r") or die "Can't reopen STDIN: $!";
STDOUT->fdopen($sock,"w") or die "Can't reopen STDOUT: $!";
STDERR->fdopen($sock,"w") or die "Can't reopen STDERR: $!";
$|=1;
}
END {
$> = $<;
log_notice("Server exiting normally\n") if $$ == $pid;
unlink $pidfile if $$ == $pid
}
После 1-6 подключения на порт 1000 при запущенном скрипте, скрипт завершает работу. В чем может быть дело?