Люди, помогите с perl'ом

Есть такой скрипт:

#!/usr/bin/perl

use IO::Socket;
use constant PORT => 1000;
use constant USER => 'subbilling';
use constant GROUP => 'subbilling';
use constant PIDFILE => '/var/run/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(STDOUT,">/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 при запущенном скрипте, скрипт завершает работу. В чем может быть дело?

Ууу, как все

Ууу, как все запущенно. Теперь я понимаю откуда идут мифы о непонятности программ на перле - если их так писать, то ясен пень непонятно =). Вы как-то пишите на перле юзая его как Си. В таком случае оптимальнее писать на Си - шустрее будет. Заюзайте use strict и -w - оно поможет

Вот результат:
night@Nord ~ $ ./aaa.pl
Can't use an undefined value as a symbol reference at ./aaa.pl line 26.
Use of uninitialized value in numeric eq (==) at ./aaa.pl line 132.
Use of uninitialized value in numeric eq (==) at ./aaa.pl line 133.
Use of uninitialized value in numeric eq (==) at ./aaa.pl line 132.
Use of uninitialized value in numeric eq (==) at ./aaa.pl line 133.

Как минимум у вас есть проблемы с $$. Разберитесь для начала с ней, а вообще лучше все переписать, используя более перловые модули =)

Си я вообще ни

Си я вообще ни знаю :) Стрикт пишет ошибки, и я не могу их исправить. А тут код быстро вытащен из двух файлов который я написал, и видемо не работает. Вот как оно есть:
Файл Daemon.pm

package Daemon;
use vars qw(@EXPORT @ISA @EXPORT_OK $VERSION);
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';
require Exporter;

@EXPORT_OK = qw( init_server log_debug log_notice log_warn log_die);
@EXPORT = @EXPORT_OK;
@ISA = qw(Exporter);
$VERSION = "1.00";

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(STDOUT,">/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");#die "Can't get uid for $user\n";
	my $gid = getgrnam($group) or log_die("Can't get gid for $group\n");#die "Can't get gid for $group\n";
	$) = "$gid $gid";
	$( = $gid;
	$> = $uid;
}

END { unlink $pidfile if defined $pid and $$ == $pid }

1;

Файл el.pl

#!/usr/bin/perl

use Chatbot::Eliza;
use IO::Socket;
use Daemon;
use constant PORT => 1000;
use constant USER => 'subbilling';
use constant GROUP => 'subbilling';
use constant PIDFILE => '/var/run/eliza.pid';

$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;
        my $bot = Chatbot::Eliza->new;
        $bot->command_interface();
}

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

END {
	$> = $<;
	log_notice("Server exiting normally\n") if $$ == $pid;
	unlink $pidfile if $$ == $pid
}

Chatbot::eliza тут временно, потом тут будет разбор потока netflow. Вот в таком виде он почему то выключается после 1-6 подлючения на порт.
______________________________________________________
HTC TyTN
MSI PR210-003RU

Ну, стрикт не

Ну, стрикт не зря ругается. Во-первых он ругается на barewords, там где должны быть строки - это вообще не хорошо так делать. Во вторых он ругается на неопределенный глобальный $quit, в-третих он ругается на переинициализацию $pid. Посмотрите что у вас там с $$. Почитайте perldoc по fork - его как-то очень хитро юзать надо

А вообще вы не тот язык юзаете для серверных приложений. Изучите erlang - лучшего языка для таких целей я не видел. Парсить там что-либо довольно проблематично (хотя в этом процессе есть своя прелесть), но можно делать "порты" (ака биндинги) в Си и даже есть в перл. Можете вот это почитать:
http://www.nabble.com/how:-perl-%3C-%3E-erlang-td15817312.html

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".