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

Basically i have a port scanner. It uses Socket to connect. I need to loop through a list of IP's and for each IP loop through a list of ports. Each port is checked to see if a tcp connection can be made. To add a time out facility for unreachable or fire walled servers I fork each IP check to a new process. this new process includes 
$SIG{ "ALRM"} = sub { print "TIME_OUT! at $timeout\n"; exit; };
alarm ($timeout);

[download]
I need to be able to make the main program wait until the child process has either died a natural death or has been killed by it's alarm/exit call. Using  wait(); sort of works ... that is the main program seems to run through the loops forking a new process for each IP check (this could be thousands of processes) and then each child seems to get on with it's stuff one at a time. I don't understand why the loops don't just wait for the child to die before starting a new one. I suspect I am using wait() all wrong. A simple way would be to put the IP check part of the script in a separate file and call it with system("./check.pl $ip $port");. But I cant believe it's not possible to do this in one script! A simplified copy of the code so far:- 
require 5.002;
require DBI;
use strict;
use Socket;
use POSIX "sys_wait_h";

my ($pid, @port_range, @ip_list, $remote, $port, $timeout, $wait);

#----------- config -----------#

$timeout = 10;
@port_range = qw (8080 6969 80 8081 8080 8000 3128 555 657 889
  1180 1181 1182 1183 1184 1185 11012 25318 25719 6969 886);

@ip_list = qw (196.2.49.19 grunt.mweb.co.za mweb.co.za); #this will be
+ populated dynamically from a DB

#----------- config -----------#


foreach $remote (@ip_list)
{
      foreach (@port_range)
      {
        if ($pid = fork)
          {
            $wait = wait ();
            print
              "Running with port $_ and \$pid $pid \$wait  $wait \$?  
+$? \n";
            $port = $_;

            test ($remote, $port, $pid, $timeout);

            kill 9, $pid or die "KILL FAILED"; #not necessary?
            exit;
          }
      }
}
###########################################################
##                     SUB ROUTINES                      ##
###########################################################

sub test
{
  my $remote =   shift;
  my $port =     shift;
  my $pid =      shift;
  my $timeout =  shift;

  my ($iaddr, $paddr, $proto);

  $SIG{"ALRM"} = sub { print "TIME_OUT! at $timeout\n"; exit; };
  alarm ($timeout);

  $iaddr = inet_aton ($remote) or die "no host: $remote";
  $paddr = sockaddr_in ($port, $iaddr);
  $proto = getprotobyname ('tcp');
  socket (SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";

  if (connect (SOCK, $paddr))
  {
    print "WE HAVE A CONNECTION!\n"
  } 
  else { die "connect: $!"; }

  close (SOCK) or die "close: $!";

}

exit;

[download]

edited: Fri Apr 25 05:01:24 2003 by jeffa - added readmore tag

Replies are listed 'Best First'.
Re: New Child to Wait for First Child to Die
by mugwumpjism (Hermit) on Apr 24, 2003 at 08:16 UTC

    The `normal' approach to reap children is to use: 

    while (defined (my $rc = waitpid(-1, &WNOHANG))) {
    #some child has finished
}

    [download]

    Check the perlfunc:waitpid man page for more. 

    $h=$ENV{HOME};my@q=split/\n\n/,`cat $h/.quotes`;$s="$h/."
."signature";$t=`cat $s`;print$t,"\n",$q[rand($#q)],"\n";

    [download]
[reply]
[d/l]
[select]
      while (defined (my $rc = waitpid(-1, &WNOHANG))) { #some child has finished } I don't understand how to use this to stop the main program launching another child untill the first child is dead. Thanks
[reply]
Re: New Child to Wait for First Child to Die
by nothingmuch (Priest) on Apr 24, 2003 at 10:28 UTC
    It seems to me like you've got something in reverse. fork returns undef on failure, 0 to the child, and a pid to the parent. The child, in your code, does nothing.
    This is a semaphore like solution to your code: 
    
my $i = 3; # how many simultaneous checks

$SIG{CHLD} = sub { $i++; wait } # or something

# if your signals are safe you may
# want to keep a hash of PIDs and
# the ip's they're associated with,
# and have SIGCHLD's handler print
# out the info and test result based
# on $? and the return value from wait.
# You should exit the child with a
# status which you may check. if the
# open failed exit with a nonzero value.

have running
foreach $remote (@iplist){
    sleep until ($i); # SIGCHLD will wake us. if it wasn't sigchld we 
+should go back to sleep.
    foreach $port (@port_range){
        if (fork){
            $i--; # empty the reservoir
        } else {
            # ping something
            exit ($test_failed) ? 1 : 0; # exit with a proper value
        }
    }
}

    [download]
    And a regular one: 
    foreach my $remote (@iplist){
    foreach my $port (@iprange){
        if (my $pid = fork){
            waitpid, $pid;
            print "$remote on $port test finished...";
            # check $?
        } else {
            # check stuff
            exit ( $test_succeeded ) ? 1 : 0;
        }
    }
}

    [download]


    Update: Suddenly I wondered - if you don't need to check for many at a time, why are you forking?

    -nuffin
    zz zZ Z Z #!perl
[reply]
[d/l]
[select]
      Good point! Only so that I can have 
        $SIG{"ALRM"} = sub { print "TIME_OUT! at $timeout\n"; exit; };
  alarm ($timeout);

      [download]
      timeout the (child) process if the connection hangs. I don't really want to fork at all but I need a way of terminating the port check after a number of seconds and to jump to the next port. I tried something like 
        $SIG{"ALRM"} = sub { next; };
  alarm($timeout);

      [download]
      But the SIG does not "happen" inside the loop so the  next fails. timeout the (child) proccess if the connection hangs. I don't realy want to fork at all but I need a way of terminating the port check after a number of secconds and to jump to the next port. I tried something like 
        $SIG{"ALRM"} = sub { next; };
  alarm($timeout);

      [download]
      But the SIG does not "happen" inside the loop so the  nect fails.
[reply]
[d/l]
[select]
        Peek inside Net::Ping's source code, and see how tcp pings are implemented. That's the idiom for tcp timeouts, and is an elegant way of doing them safely.

        -nuffin
        zz zZ Z Z #!perl
[reply]
(IO::Socket::INET) Re: New Child to Wait for First Child to Die
by bbfu (Curate) on Apr 24, 2003 at 19:53 UTC

    Instead of forking, why not use IO::Socket::INET and the Timeout option? It's a standard module, so you should already have it. It'll make things much easier... Like, this easy: 

    #!/usr/bin/perl
use warnings;
use strict;

use IO::Socket::INET;

our @port_range = qw(
  8080 6969 80 8081 8080 8000 3128 555 657 889 1180
  1181 1182 1183 1184 1185 11012 25318 25719 6969 886
);

# this will be populated dynamically from a DB
our @ip_list = qw(
  196.2.49.19
  grunt.mweb.co.za mweb.co.za
);

foreach my $host (@ip_list) {
  foreach my $port (@port_range) {
    my $sock = IO::Socket::INET->new(
      PeerAddr => $host,
      PeerPort => $port,
      Proto    => 'tcp',
      Timeout  => 10,     # 10 second time-out
    ) or next;         # Didn't work, so try next port

    print "Connection established to $host on $port.\n";
    $sock->close();
  }
}

    [download]

    bbfu
    Black flowers blossom
    Fearless on my breath

[reply]
[d/l]

Back to Seekers of Perl Wisdom