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();
}

[download]

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();
}

[download]


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();
}

[download]


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!

In reply to mixing multisockets and forks by fxmakers

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.