Привет.
Задумал я себе сделать на перле демон, который слушает сокет, а при подключении пользователя - форкается и, потомок уже общается с клиентом сам.
Пересмотрел кучу примеров, но, как назло, пример либо просто демона (как отключиться от консоли), либо обычный скрипт-слушалка сокета с умением делать форк.
А вместе два примера почему-то не удается увязать.

#!/usr/bin/perl

use strict;
use IO::Socket;
use POSIX;

my $pidfile = "/var/run/fd.pid";
my $port = "21000";
$|=1;

if(-e $pidfile){ die "$pidfile exists.\n"; }

$SIG{INT} = $SIG{TERM} = sub { unlink($pidfile); die "fd exited\n"; };

###
# will become daemon

defined(my $pid = fork)     or die "Can't fork: $!";
exit if $pid;

open STDIN, '/dev/null'     or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null'   or die "Can't write to /dev/null: $!";
warn("PID: ".getpid()."\n");

POSIX::setsid               or die "Can't start a new session: $!";
open STDERR, '>logfile'     or die "Can't dup stdout: $!";

open(PID, ">$pidfile") or die "fd: can't open $pidfile: $!\n";
print PID $$;
close PID;

sub REAPER {
    my $wpid = wait();
    $SIG{CHLD} = \&REAPER;   # unless $] >= 5.002
}
$SIG{CHLD} = \&REAPER;

#open server socket, bind to it and listen.
my $main_sock = new IO::Socket::INET (LocalHost => '192.168.0.1',
                                   LocalPort => $port,
                                   Listen    => SOMAXCONN,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
                                  );

while ( my $sock = $main_sock->accept() ) {
    my $pid = fork;                    # parent
    die "Cant fork: $!" unless defined $pid;
    next if($pid); #parent goes further

    #now child is running
    print $sock "Hello\r\n";
    close($sock);
    exit(0);
}
---------------------------------
В чем прикол, что в таком варианте программа отрабатывает ровно один раз, затем завершается? Я что-то упустил?
Если сигнал SIG_CHLD игнорировать, то все работает как надо. Только, естественно, число зомби растет с каждым новым подключением.

• форкающийся демон и сокеты,andy, 10:52 , 22-Апр-07
  • форкающийся демон и сокеты,боря, 16:54 , 23-Апр-07
    • форкающийся демон и сокеты,wtf, 18:26 , 23-Апр-07
      • форкающийся демон и сокеты,seller, 16:13 , 24-Апр-07
        • форкающийся демон и сокеты,seller, 16:23 , 24-Апр-07
          • форкающийся демон и сокеты,NuINu, 16:37 , 24-Апр-07
            • форкающийся демон и сокеты,NuINu, 16:41 , 24-Апр-07

Неудобно с телефона читать код, поэтому, если честно, не разбирался. Похоже, вам нужен модуль net::daemon

>Неудобно с телефона читать код, поэтому, если честно, не разбирался. Похоже, вам
>нужен модуль net::daemon

Да, модуль-то спасет. но хотелось бы самому разобраться в принципах работы.
тут похоже всего-то заковырка в обработке сигналов (CHLD), а в чем конкретно - вот это пока непонятно.

use POSIX 'WNOHANG';
$SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };

попробуйте так

>
>use POSIX 'WNOHANG';
>$SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };
>
>попробуйте так

и так не получилось, первый коннект обрабатывается, но после этого завершается весь процесс.

>>
>>use POSIX 'WNOHANG';
>>$SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };
>>
>>попробуйте так
>
Тьфу, не до конца ответил, правильно было бы
"у меня ни так, ни эдак не получилось, первый коннект обрабатывается, но после этого завершается весь процесс."
Поскольку у меня где-то тоже валялась поделка с форкающимся демоном, решил посмотреть как там было сделано. А там вместо SIG{CHLD} - коммент о том, что где-то что-то непонятно почему зомби не убиваются, поэтому фиг с ним, с SIG{CHLD}, пусть зомби живут, все равно демон придется рестартить часто.
Попробовал и sub REAPER и waitpid (что, в общем-то одно и то же) - результат один. Хмм...

и waitpid (что, в общем-то одно и то
>же) - результат один. Хмм...
да все нормально убивается! правильно ты посоветовал. так гуру и советуют, смотри Линкольн Штайн Разработка сетевых программ на перл, я могу пример из нее привести, никаких зомби не возникает(по крайней мере я не нашел).
-------------------------------------------------------------------------
#!/usr/bin/perl -w

use strict;
use IO::Socket;
use IO::File;
use POSIX 'WNOHANG';

my $pidfile = "/var/tmp/fd.pid";
my $logfile = "my.log";
my $pid;

my $port = 21000;
my $quit = 0;

#if(-e $pidfile){ die "$pidfile exists.\n"; }

#Установка обработчиков сигналов
$SIG{INT} = $SIG{TERM} = sub { $quit++ };
$SIG{CHLD} = \&REAPER;

open(LOG, '>>', $logfile) or die "Can't open log file $logfile\n";

my $fh_pid = open_pid_file($pidfile) or die "fd: can't open $pidfile: $!\n";
#open server socket, bind to it and listen.
my $main_sock = new IO::Socket::INET (LocalHost => '127.0.0.1',
                                   LocalPort => $port,
                                   Listen    => 20,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
       Timeout => 60*60,
                                  );
die "Can't create a listening socket: $@" unless $main_sock;

# will become daemon
warn "$0 starting ...\n";
$pid = become_daemon();
warn("PID: $pid\n");
print $fh_pid $pid;
close $fh_pid;

open(STDERR, ">&LOG")        or die "Can't dup log: $!";

warn "go in cycle\n";
while (!$quit) {
    next unless my $sess_sock = $main_sock->accept();
    my $pid_sess = fork;
    die "Can't fork: $!" unless defined $pid_sess;
    if($pid_sess == 0) {
     #now child is running
$main_sock->close();
        run_session_work($sess_sock);
exit(0);
    }
    $sess_sock->close();
}
close(LOG);
unlink($pidfile);
die "fd exited\n";

sub become_daemon {
    die "Can't fork" unless defined (my $child = fork());
    if($child) {
print LOG "close parent, and stay demon";
exit 0;  #Завершение родительского сеанса
    }
    POSIX::setsid();  #Преобразование в лидеры сеанса
    print "I life??\n";
#меняем дискрипторы ввода/вывода
    open(STDIN,  '</dev>/dev/null')   or die "Can't write to /dev/null: $!";
    umask(0);  #Сброс маски режима создания файлов
    $ENV{PATH} = '/bin:/usr/bin';
    return $$;
}

sub REAPER {
    while( (my $wpid = waitpid(-1, WNOHANG)) > 0) {
warn "Reaper child with PID $wpid\n"
    }
}

sub run_session_work {
    my $sock = shift;
    $|=1;
    print $sock "Hello\r\n";
    close($sock);
    exit(0);
}

sub open_pid_file {
    my $file = shift;
    if(-e $file) {
my $fh = IO::File->new($file) || return;
my $p_old = <$fh>;
     #Пытаемся убить текущий процесс
if(defined($p_old)) {
     die "Server already running witch PID $p_old\n"
  if kill 15, $p_old;
}
warn "Removing PID file for defunct server process \n";
     #И удалить pid файл
die "Can't unlink PID file $file\n"
   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";
}

>и waitpid (что, в общем-то одно и то
>>же) - результат один. Хмм...
>да все нормально убивается! правильно ты посоветовал. так гуру и советуют, смотри
>Линкольн Штайн Разработка сетевых программ на перл, я могу пример из
>нее привести, никаких зомби не возникает(по крайней мере я не нашел).
>

>    open(STDIN,  '</dev>/dev/null')   or die "Can't write to /dev/null: $!";
странно кудато переназначение стдоут делось при отправке? его что как тег вырзали?
ну вообщем оно было :)