The OpenNET Project / Index page

[ новости /+++ | форум | теги | ]

форумы  помощь  поиск  регистрация  майллист  вход/выход  слежка  RSS
"Люди, помогите с perl'ом"
Вариант для распечатки  
Пред. тема | След. тема 
Форумы OpenNET: Виртуальная конференция (Public)
Изначальное сообщение [ Отслеживать ]

"Люди, помогите с perl'ом"  
Сообщение от sanches email(ok) on 06-Сен-08, 19:35 
Есть такой скрипт:

#!/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 при запущенном скрипте, скрипт завершает работу. В чем может быть дело?

Высказать мнение | Ответить | Правка | Cообщить модератору

 Оглавление

Сообщения по теме [Сортировка по времени | RSS]


1. "Люди, помогите с perl'ом"  
Сообщение от angra (ok) on 07-Сен-08, 07:13 
Может стоит для начала лог посмотреть?
Высказать мнение | Ответить | Правка | Наверх | Cообщить модератору

2. "Люди, помогите с perl'ом"  
Сообщение от sanches email(ok) on 07-Сен-08, 11:21 
>Может стоит для начала лог посмотреть?

ничего там нет.

Высказать мнение | Ответить | Правка | Наверх | Cообщить модератору

3. "Люди, помогите с perl'ом"  
Сообщение от angra (ok) on 07-Сен-08, 17:38 
Ну тогда остается либо предположить присутствие нечистой силы, либо ваше неумение настроить и читать syslog. Обратите внимание, что логируется с разными приоритетами, вполне возможно, что у вас все кроме crit отбрасывается.

Высказать мнение | Ответить | Правка | Наверх | Cообщить модератору

4. "Люди, помогите с perl'ом"  
Сообщение от mrV on 09-Сен-08, 10:59 
>Ну тогда остается либо предположить присутствие нечистой силы, либо ваше неумение настроить
>и читать syslog. Обратите внимание, что логируется с разными приоритетами, вполне
>возможно, что у вас все кроме crit отбрасывается.

Не первый пост, в котором товарищ просто-напросто унижает людей, просящих помощь.

Высказать мнение | Ответить | Правка | Наверх | Cообщить модератору

Архив | Удалить

Индекс форумов | Темы | Пред. тема | След. тема
Оцените тред (1=ужас, 5=супер)? [ 1 | 2 | 3 | 4 | 5 ] [Рекомендовать для помещения в FAQ]




Партнёры:
PostgresPro
Inferno Solutions
Hosting by Hoster.ru
Хостинг:

Закладки на сайте
Проследить за страницей
Created 1996-2024 by Maxim Chirkov
Добавить, Поддержать, Вебмастеру