Люди, помогите с perl'ом
S-anches 6 сентября, 2008 - 18:37
Есть такой скрипт:
#!/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