Люди, помогите с 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
Файл el.pl
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