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:
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:
Everything is OK too, so what's the problem?
Now I'm going to mix these 2 portions:
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!
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 | |
by fxmakers (Friar) on Mar 29, 2004 at 00:50 UTC |
Back to
Seekers of Perl Wisdom