http://qs321.pair.com?node_id=340402

fxmakers has asked for the wisdom of the Perl Monks concerning the following question:

Hi again!
Since I decided to get away from Threads, I'm trying to make retrieve fork's status to do the same thing.
Little background description:
I'm coding an IRC server (services). This one has to link to an IRC hub and scan any new client connection to detect unsecure proxy, etc...
No problem with the IRC protocol, here's this portion of code:

use strict; use IO::Socket::INET; my $ts = time(); # current time my $last = $ts; # process the infinite loop each second only, no mill +iseconds needed my %socklist = (); # hash table of sockets my $bit = ''; # connect to the IRC server my $socket = &open_socket("tcp", "ircserver.com", 6667, 3); sub open_socket { my ($proto, $host, $port, $timeout) = (shift, shift, shift, shift); my $socket = IO::Socket::INET->new( Proto => $proto, PeerAddr => $host, PeerPort => $port, Timeout => $timeout ); if (!$socket) { return(0); } return($socket); } if (!$socket) { die("can't connect"); } &add_socket($socket, "IRC"); sub add_socket { my ($socket, $type) = (shift, shift); $socket->autoflush(1); $socklist{$socket}{'sock'} = $socket; $socklist{$socket}{'type'} = $type; $socklist{$socket}{'fileno'} = $socket->fileno(); $socklist{$socket}{'time'} = $ts; vec($bit, $socklist{$socket}{'fileno'}, 1) = 1; return(0); } print $socket "USER zxf sdf sdf sdf\n"; print $socket "NICK sdfsdfg\n"; sub loop_socket { my $rin = $bit; $rin =~ /[^\0]/ || next; my $idx = select($rin, undef, undef, 1); my $buffer = ""; $idx || next; $idx > 0 || die($!); my %list = %socklist; # work with a copy while ($idx && (my ($socket, $value) = each(%list))) { $socket = $value->{'sock'}; if (vec($rin, $value->{'fileno'}, 1)) { $buffer = <$socket>; print + STDOUT "IRC: $buffer"; } } return(0); } for (;;) { &loop_socket(); }

It's multisocket using select() because I'm going to connect to many other servers.
Okay, everything works fine with this one.



Now, the scan routines: we have a new client connection, "hacker".
We're going to scan him:


use strict; use POSIX ":sys_wait_h"; $SIG{'CHLD'} = \&REAPER; # manage moribound children my %status = (); # hash of pid nš and their returned status my %scan = (); # users to scan my $ts = time(); # current time my @ports = (23, 24, 25, 1080, 1081); # ports to scan my $threads = 0; # current number of threads/scans, if $threads is rea +cher, enqueue. my $max = 3; # max number of simul scans my $last = $ts; # process the infinite loop each second only, no mill +iseconds needed sub REAPER { my $pid = 0; while (($pid = waitpid(-1, &WNOHANG)) > 0) { $status{$pid} = $?; } $SIG{'CHLD'} = \&REAPER; } # ok here we link to the IRC hub as a server # When a new client connects, we have to scan some @ports to check if +he's using an unsecure proxy # Let's try with "hacker" : $scan{"hacker"}{'nick'} = "hacker"; # user's nickname $scan{"hacker"}{'start'} = $ts; # time of scan $scan{"hacker"}{'completed'} = 0; # scan completed? 1 = yes $scan{"hacker"}{'total'} = 0; # total number of scan to do (sca +lar(@ports)) $scan{"hacker"}{'list'} = (); # associate pid with port $scan{"hacker"}{'unsecure'} = 0; # is unsecure? 1 = yes $scan{"hacker"}{'proto'} = ""; # proto of an unsecure result $scan{"hacker"}{'port'} = 0; # port of an unsecure result # start the scan my $idx = 0; # list of threads foreach (@ports) { ++$idx; ++$scan{"hacker"}{'total'}; $scan{"hacker"}{'list'}{$idx}{'proto'} = "Wingate"; $scan{"hacker"}{'list'}{$idx}{'port'} = $_; $scan{"hacker"}{'list'}{$idx}{'start'} = 0; if ($threads >= $max) { # enqueue this scan, too many are running $scan{"hacker"}{'list'}{$idx}{'id'} = 0; $scan{"hacker"}{'list'}{$idx}{'queued'} = 1; } else { # start the scan my $id = &new_thread("hacker", "Wingate", $_); $scan{"hacker"}{'list'}{$idx}{'id'} = $id; $scan{"hacker"}{'list'}{$idx}{'start'} = $ts; } } # the scan routine sub new_thread { my ($nick, $proto, $port) = (shift, shift, shift); my $result = 0; # if 1, the we have an unsecure connection if (my $pid = fork()) { ++$threads; return($pid); } eval { local $SIG{'ALRM'} = sub { die("stopped\n"); }; alarm(2); $result = 0; # here we connect to the $nick's host and $port and send some stuf +f using a classical IO::Socket::INET alarm(0); }; exit($result); } sub del_threads { # delete all $nick's pid-related my $nick = shift; foreach (keys(%{$scan{$nick}{'list'}})) { if ($scan{$nick}{'list'}{$_}{'id'}) { my $id = $scan{$nick}{'list'}{$_}{'id'}; kill('SIGTERM', $id); --$threads; $scan{$nick}{'list'}{$_}{'id'} = 0; ++$scan{$nick}{'completed'}; } } return(0); } # infinite IRC loop routine sub timer_online { $ts = time(); if ($ts == $last) { return(); } $last = $ts; my $unsecure = 0; # got an insecure connex? my $port = 0; # if yes, copy the port nš my $proto = ""; # and the protocol used foreach (keys(%scan)) { my $nick = $scan{$_}{'nick'}; if ($scan{$nick}{'unsecure'} || ($scan{$nick}{'total'} == $scan{$n +ick}{'completed'})) { # finished scan of this user if ($scan{$nick}{'unsecure'}) { print STDOUT "unsecure!\n"; } else { print STDOUT "clean!\n"; } &del_threads($nick); delete($scan{$nick}); next; } foreach my $idx (keys(%{$scan{$nick}{'list'}})) { # foreach pid of + this user foreach my $pid (keys(%status)) { # compare a pid with the "glo +bal" pid hash table if ($pid == $scan{$nick}{'list'}{$idx}{'id'}) { $scan{$nick}{'list'}{$idx}{'id'} = 0; ++$scan{$nick}{'completed'}; --$threads; if ($status{$pid}) { $scan{$nick}{'unsecure'} = 1; $scan{$nick}{'proto'} = $scan{$nick}{'list'}{$idx}{'proto' +}; $scan{$nick}{'port'} = $scan{$nick}{'list'}{$idx}{'port'}; delete($status{$pid}); &del_threads($nick); $unsecure = 1; last; } } } if ($unsecure) { last; } if ($scan{$nick}{'list'}{$idx}{'id'} && ($ts - $scan{$nick}{'lis +t'}{$idx}{'start'} > 3)) { # 3 sec timeout, stop this process my $id = $scan{$nick}{'list'}{$idx}{'id'}; kill('SIGTERM', $id); $scan{$nick}{'list'}{$idx}{'id'} = 0; ++$scan{$nick}{'completed'}; --$threads; next; } if ($scan{$nick}{'list'}{$idx}{'queued'} && ($threads < $max)) { + # queued scans? my $id = &new_thread($nick, $scan{$nick}{'list'}{$idx}{'proto' +}, $scan{$nick}{'list'}{$idx}{'port'}); $scan{$nick}{'list'}{$idx}{'id'} = $id; $scan{$nick}{'list'}{$idx}{'queued'} = 0; $scan{$nick}{'list'}{$idx}{'start'} = $ts; } } } return(0); } # infinite IRC loop for (;;) { &timer_online(); }


Everything is OK too, so what's the problem?
Now I'm going to mix these 2 portions:

use strict; use IO::Socket::INET; use POSIX ":sys_wait_h"; $SIG{'CHLD'} = \&REAPER; # manage moribound children my %status = (); # hash of pid nš and their returned status my %scan = (); # users to scan my $ts = time(); # current time my $last = $ts; # process the infinite loop each second only, no mill +iseconds needed my @ports = (23, 24, 25, 1080, 1081); # ports to scan my $threads = 0; # current number of threads/scans, if $threads is rea +cher, enqueue. my $max = 3; # max number of simul scans my %socklist = (); # hash table of sockets my $bit = ''; sub REAPER { my $pid = 0; while (($pid = waitpid(-1, &WNOHANG)) > 0) { $status{$pid} = $?; } $SIG{'CHLD'} = \&REAPER; } # connect to the IRC server my $socket = &open_socket("tcp", "ircserver.com", 6667, 3); sub open_socket { my ($proto, $host, $port, $timeout) = (shift, shift, shift, shift); my $socket = IO::Socket::INET->new( Proto => $proto, PeerAddr => $host, PeerPort => $port, Timeout => $timeout ); if (!$socket) { return(0); } return($socket); } if (!$socket) { die("can't connect"); } &add_socket($socket, "IRC"); sub add_socket { my ($socket, $type) = (shift, shift); $socket->autoflush(1); $socklist{$socket}{'sock'} = $socket; $socklist{$socket}{'type'} = $type; $socklist{$socket}{'fileno'} = $socket->fileno(); $socklist{$socket}{'time'} = $ts; vec($bit, $socklist{$socket}{'fileno'}, 1) = 1; return(0); } print $socket "USER zxf sdf sdf sdf\n"; print $socket "NICK sdfsdfg\n"; $scan{"hacker"}{'nick'} = "hacker"; # user's nickname $scan{"hacker"}{'start'} = $ts; # time of scan $scan{"hacker"}{'completed'} = 0; # scan completed? 1 = yes $scan{"hacker"}{'total'} = 0; # total number of scan to do (sca +lar(@ports)) $scan{"hacker"}{'list'} = (); # associate pid with port $scan{"hacker"}{'unsecure'} = 0; # is unsecure? 1 = yes $scan{"hacker"}{'proto'} = ""; # proto of an unsecure result $scan{"hacker"}{'port'} = 0; # port of an unsecure result # start the scan my $idx = 0; # list of threads foreach (@ports) { ++$idx; ++$scan{"hacker"}{'total'}; $scan{"hacker"}{'list'}{$idx}{'proto'} = "Wingate"; $scan{"hacker"}{'list'}{$idx}{'port'} = $_; $scan{"hacker"}{'list'}{$idx}{'start'} = 0; if ($threads >= $max) { # enqueue this scan, too many are running $scan{"hacker"}{'list'}{$idx}{'id'} = 0; $scan{"hacker"}{'list'}{$idx}{'queued'} = 1; } else { # start the scan my $id = &new_thread("hacker", "Wingate", $_); $scan{"hacker"}{'list'}{$idx}{'id'} = $id; $scan{"hacker"}{'list'}{$idx}{'start'} = $ts; } } # the scan routine sub new_thread { my ($nick, $proto, $port) = (shift, shift, shift); my $result = 0; # if 1, the we have an unsecure connection if (my $pid = fork()) { ++$threads; return($pid); } eval { local $SIG{'ALRM'} = sub { die("stopped\n"); }; alarm(2); $result = 0; # here we connect to the $nick's host and $port and send some stuf +f using a classical IO::Socket::INET alarm(0); }; exit($result); } sub del_threads { # delete all $nick's pid-related my $nick = shift; foreach (keys(%{$scan{$nick}{'list'}})) { if ($scan{$nick}{'list'}{$_}{'id'}) { my $id = $scan{$nick}{'list'}{$_}{'id'}; kill('SIGTERM', $id); --$threads; $scan{$nick}{'list'}{$_}{'id'} = 0; ++$scan{$nick}{'completed'}; } } return(0); } sub loop_socket { my $rin = $bit; $rin =~ /[^\0]/ || next; my $idx = select($rin, undef, undef, 1); my $buffer = ""; $idx || next; $idx > 0 || die($!); my %list = %socklist; while ($idx && (my ($socket, $value) = each(%list))) { $socket = $value->{'sock'}; if (vec($rin, $value->{'fileno'}, 1)) { $buffer = <$socket>; print + STDOUT "IRC: $buffer"; } } return(0); } # infinite IRC loop routine sub timer_online { $ts = time(); if ($ts == $last) { return(); } $last = $ts; my $unsecure = 0; # got an insecure connex? my $port = 0; # if yes, copy the port nš my $proto = ""; # and the protocol used foreach (keys(%scan)) { my $nick = $scan{$_}{'nick'}; if ($scan{$nick}{'unsecure'} || ($scan{$nick}{'total'} == $scan{$n +ick}{'completed'})) { # finished scan of this user if ($scan{$nick}{'unsecure'}) { print STDOUT "unsecure!\n"; } else { print STDOUT "clean!\n"; } &del_threads($nick); delete($scan{$nick}); next; } foreach my $idx (keys(%{$scan{$nick}{'list'}})) { # foreach pid of + this user foreach my $pid (keys(%status)) { # compare a pid with the "glo +bal" pid hash table if ($pid == $scan{$nick}{'list'}{$idx}{'id'}) { $scan{$nick}{'list'}{$idx}{'id'} = 0; ++$scan{$nick}{'completed'}; --$threads; if ($status{$pid}) { $scan{$nick}{'unsecure'} = 1; $scan{$nick}{'proto'} = $scan{$nick}{'list'}{$idx}{'proto' +}; $scan{$nick}{'port'} = $scan{$nick}{'list'}{$idx}{'port'}; delete($status{$pid}); &del_threads($nick); $unsecure = 1; last; } } } if ($unsecure) { last; } if ($scan{$nick}{'list'}{$idx}{'id'} && ($ts - $scan{$nick}{'lis +t'}{$idx}{'start'} > 3)) { # 3 sec timeout, stop this process my $id = $scan{$nick}{'list'}{$idx}{'id'}; kill('SIGTERM', $id); $scan{$nick}{'list'}{$idx}{'id'} = 0; ++$scan{$nick}{'completed'}; --$threads; next; } if ($scan{$nick}{'list'}{$idx}{'queued'} && ($threads < $max)) { + # queued scans? my $id = &new_thread($nick, $scan{$nick}{'list'}{$idx}{'proto' +}, $scan{$nick}{'list'}{$idx}{'port'}); $scan{$nick}{'list'}{$idx}{'id'} = $id; $scan{$nick}{'list'}{$idx}{'queued'} = 0; $scan{$nick}{'list'}{$idx}{'start'} = $ts; } } } return(0); } for (;;) { &loop_socket(); &timer_online(); }


Connection to the IRC is fine, scanning threads are forked, but got an error when looping on sockets IF a scan is running in background or has finished (everything is fine if no scans are launched):
No children at mongers3.txt line 144
or
Interrupted system call at mongers3.txt line 144
if alarm(2) is reached

select() $idx is = -1 ???



I have no idea why this is happening...
Any ideas?


perl -v: v5.8.2 built for cygwin-thread-multi-64int

Thanks!

Replies are listed 'Best First'.
Re: mixing multisockets and forks
by tachyon (Chancellor) on Mar 29, 2004 at 00:12 UTC

    Have you heard of the concept of simplifying to a small test case? Anyway that said AFAIKS the problem is that in your incredibly misnamed new_thread routine you are doing this:

    if ( $pid = fork() ) { $threads++; # you mean kids return $pid } # this is kid code # kid does socket but.....then...... exit($result);

    So the child process is exiting but you are not decrementing the '$thread' count, at least in the code presented. Nor are you communicating its death to the parent. So the reason you are getting a no children error is simple -> *there are no children* because they have finished but the parent simply does not know it.

    At a glance I don't see how you think the IPC between parent and child is going to work, and given the length of your sample and what I find really inaccurate and annoying names (ie a forked kid is not a thread) a glance is all it is going to get. When you fork parent and child get copies of all data and handles. Independent* copies so if the kid does stuff to the data the parents data remains unchanged.

    * yes I understand COW.

    cheers

    tachyon

      Thanks for your reply!
      I'm a little confused...
      1st of all, yes, my "threads" could be renamed to children processes, sorry :)

      The $SIG{CHLD} is called when a child process has finished, so we can retrieve its exit($result) using waitpid() and put the $result into the $status{$pid} hash.
      use POSIX ":sys_wait_h"; $SIG{'CHLD'} = \&REAPER; # manage moribound children sub REAPER { my $pid = 0; while (($pid = waitpid(-1, &WNOHANG)) > 0) { $status{$pid} = $?; } $SIG{'CHLD'} = \&REAPER; }


      The $threads decrement is done in the &timer_online, comparing the $status $pid with the client's pid list.


      If you launch the 2nd portion of code (the fake "scan"), everything is running fine, the parent gets the finished child's $result using the &REAPER routine.

      Here's a simple code:

      use strict; use POSIX ":sys_wait_h"; $SIG{'CHLD'} = \&REAPER; sub REAPER { my $pid = 0; while (($pid = waitpid(-1, &WNOHANG)) > 0) { print STDOUT "$pid returned $?\n"; } $SIG{'CHLD'} = \&REAPER; } sub new_thread { my $result = 0; if (my $pid = fork()) { return($pid); } $result = 1; exit($result); } my $child = &new_thread(); print STDOUT "got a new child: $child\n"; for (;;) {} 1;


      This way we can retrieve the $result.

      If this works fine without the select() and vec() socket management, why are the fork()'s processes problematic when using them?


      The simple complete code mixing them:
      use strict; use POSIX ":sys_wait_h"; use IO::Socket::INET; $SIG{'CHLD'} = \&REAPER; sub REAPER { my $pid = 0; while (($pid = waitpid(-1, &WNOHANG)) > 0) { print STDOUT "$pid returned $?\n"; } $SIG{'CHLD'} = \&REAPER; } sub new_thread { my $result = 0; if (my $pid = fork()) { return($pid); } sleep(3); $result = 1; exit($result); } my %socklist = (); # hash table of sockets my $bit = ''; # connect to the IRC server my $socket = &open_socket("tcp", "irc.creatixnet.com", 6667, 3); sub open_socket { my ($proto, $host, $port, $timeout) = (shift, shift, shift, shift); my $socket = IO::Socket::INET->new( Proto => $proto, PeerAddr => $host, PeerPort => $port, Timeout => $timeout ); if (!$socket) { return(0); } return($socket); } if (!$socket) { die("can't connect"); } &add_socket($socket, "IRC"); sub add_socket { my ($socket, $type) = (shift, shift); $socket->autoflush(1); $socklist{$socket}{'sock'} = $socket; $socklist{$socket}{'type'} = $type; $socklist{$socket}{'fileno'} = $socket->fileno(); vec($bit, $socklist{$socket}{'fileno'}, 1) = 1; return(0); } print $socket "USER zxf sdf sdf sdf\n"; print $socket "NICK sdfsdfg\n"; print $socket "JOIN #fx\n"; my $child = &new_thread(); print STDOUT "got a new child: $child\n"; sub loop_socket { my $rin = $bit; $rin =~ /[^\0]/ || next; my $idx = select($rin, undef, undef, 1); my $buffer = ""; $idx || next; $idx > 0 || die($!); my %list = %socklist; while ($idx && (my ($socket, $value) = each(%list))) { $socket = $value->{'sock'}; if (vec($rin, $value->{'fileno'}, 1)) { $buffer = <$socket>; print + STDOUT "IRC: $buffer"; } } return(0); } for (;;) { &loop_socket(); } 1;

      When children exits: No children at test.txt line 82

      :(
      Cheers