• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 229
  • Last Modified:

Problem with core dumps.

Hi there:
  I did a perl program that reads from a spread daemon data and then create child processes that fetches a httpd daemon. Cause I don't want more than 20 children I use a buffer and a children count. Here goes the main part of the code I'm ussing and then a reduced (Pseudocode version). My problem is this:
  Sometimes when there is a heavy load my program crases and generates a core.
  1st: How can I debug the core bumped?
  2nd: Is my code right?
  Please help me as soon as you can cause it's very important.
  Sorry for my damn english.

      Xabi

------- main code -------------------
...
...
$process_total = 0;
$max_process   = 20;
# SIGNALS ------------------
$SIG{CHLD} = \&vanhelsing;
sub vanhelsing {
    my $pidchild;
    while (($pidchild = waitpid(-1, &WNOHANG)) > 0) {
      $process_total--;
    };
    $SIG{CHLD} = \&vanhelsing;
}

# Let's go -----------------
while(($st, $s, $g, $mt, $e, $mess) = Spread::receive($mbox)) {
  if (!defined($st)) {
    error_log("ERR", "Disconected.");
    grep (Spread::leave($mbox, $_) , @joined); # Try to leave the groups
    Spread::disconnect($mbox);                 # Try to disconect
    do {
      sleep($reconect_timeout);
      ($mbox, $privategroup) = Spread::connect( \%args );
    } until defined($mbox);
    @joined = grep (Spread::join($mbox, $_), @groups);
    error_log("INF", "Connected.");
  } else {
    if (@buffer_array && $process_total<$max_process) {
      $data = shift(@buffer_array);
      $process_total++;
      $pid = fork();
      if (defined($pid)) {
        if ($pid == 0) {
          info_log("INF", "($$) FETCH [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
          $actual_time = time();
          $sock = new IO::Socket::INET (PeerAddr => $data->{'host'}, PeerPort => $data->{'port'}, Proto => 'tcp',);
          if ($sock) {
            print $sock "GET ".$data->{'url'}." HTTP/1.0\nHOST: ".$data->{'host'}."\n\n";
            $result = "";
            while ($buf = <$sock>) {
              $buf =~ s/\n//;
              $result = $buf if ($buf ne "");
            }
            close($sock);
            $total_time = time() - $actual_time;
            info_log("INF", "($$) OK getting [http://$data->{'host'}:$data->{'port'}$data->{'url'}] [TIME=$total_time] [RES=$result]");
          } else {
            info_log("ERR", "Cannot open socket: URL [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
          }
          exit(0);
        }
      } else {
        info_log("ERR", "Cannot fork(): URL [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
        $process_total--;
      }
    }
    ($remote_host, $remote_logname, $remote_username, $request_time, $request_year, $request_month, $request_day, $request_hour, $request_minute, $request_seconds, $request_method, $request_line, $request_protocol, $request_status, $request_bytes, $request_referer, $request_user_agent, $request_cookie_i, $request_cookie_o, $request_querystring) = ($mess =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+\[(.*?)\]\s+(..)(..)(..)(..)(..)(..)\s+\"(\S+)\s+(.*?)\s+(\S+)\"\s+(\S+)\s+(\S+)\s+\"(.*?)\"\s+\"(.*?)\"\s+\"(.*?)\"\s+\"(.*?)\"\s+\?*(.*)/);
    if ($request_cookie_i =~ /uid/) {
      $user_id = "";
      foreach $pattern (@pattern_data) {
        if ($request_line =~ /$pattern->{'pattern'}/) {
          if ($user_id eq "") {
            @cookies = split(/\;\ /, $request_cookie_i);
            foreach $cookie (@cookies) {
              if ($cookie =~ /__em_p=(.*)\;*/) {
                ($valor = $1) =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
                @campos_values = split(/\&/, $valor);
                @values        = split(/\|/, $campos_values[0]);
                @campos        = split(/\|/, $campos_values[1]);
                for ($i = 0; $i < @campos; $i++) {
                  $user_id  = $values[$i] if ($campos[$i] eq "uid");
                }
              }
            }
          }
          if ($user_id ne "" && $user_id !~ /\@/) {
            info_log("INF", "[N:$process_total B:$#buffer_array] Pattern found [$pattern->{'pattern'}] in [$request_line]");
            push(@buffer_array, {
                     "host" => $pattern->{'host'},
                     "port" => $pattern->{'port'},
                     "url"  => $pattern->{'url'}."?eventID=".$pattern->{'event'}."&userID=".$user_id.$pattern->{'extra'}
                 });
          }
          last if ($pattern->{'cont'} == 0);
        }
      }
    }
  }
}

-------- PSEUDOCODE VERSION ----------------
...
...
$process_total = 0;
$max_process   = 20;
@buffer_array  = ();
# SIGNALS ------------------
$SIG{CHLD} = \&vanhelsing;
sub vanhelsing {
    my $pidchild;
    while (($pidchild = waitpid(-1, &WNOHANG)) > 0) {
      $process_total--;
    };
    $SIG{CHLD} = \&vanhelsing;
}

# Let's go -----------------
while($DATA = GET_DATA) {
  if (!defined($DATA)) {
    RECONNECT;
  } else {
    if (@buffer_array && $process_total<$max_process) {
      $data = shift(@buffer_array);
      $process_total++;
      $pid = fork();
      if (defined($pid)) {
        if ($pid == 0) {
          info_log("INF", "($$) FETCH [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
          $actual_time = time();
          $sock = new IO::Socket::INET (PeerAddr => $data->{'host'}, PeerPort => $data->{'port'}, Proto => 'tcp',);
          if ($sock) {
            print $sock "GET ".$data->{'url'}." HTTP/1.0\nHOST: ".$data->{'host'}."\n\n";
            $result = "";
            while ($buf = <$sock>) {
              $buf =~ s/\n//;
              $result = $buf if ($buf ne "");
            }
            close($sock);
            $total_time = time() - $actual_time;
            info_log("INF", "($$) OK getting [http://$data->{'host'}:$data->{'port'}$data->{'url'}] [TIME=$total_time] [RES=$result]");
          } else {
            info_log("ERR", "Cannot open socket: URL [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
          }
          exit(0);
        }
      } else {
        info_log("ERR", "Cannot fork(): URL [http://$data->{'host'}:$data->{'port'}$data->{'url'}]");
        $process_total--;
      }
    }
    push(@buffer_array, {"host"=>$pattern->{'host'}, "port"=>$pattern->{'port'}, "url"=>$pattern->{'url'}});
  }
}

0
xabi
Asked:
xabi
1 Solution
 
xabiAuthor Commented:
As you can see I check if there is something in the buffer and there is less children than the max process this way:
 
   if (@buffer_array && $process_total<$max_process) {

and every fetch I want do do I do this:
   
   push(@buffer_array, {"host"=>$pattern->{'host'}, "port"=>$pattern->{'port'}, "url"=>$pattern->{'url'}});

0
 
mrmickyCommented:
The first thing you should do is:

use strict;

to weed out any potential problems.  You'll find that you will be using the 'my', and 'our' keywords a lot for lexical scoping but it will help you greatly in the long run.  

NOTE:  Always use strict when writing a Perl program.  It can save you hours (or even days) of debugging.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now