Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 228
  • 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

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

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