Solved

Problem with core dumps.

Posted on 2001-06-18
2
216 Views
Last Modified: 2006-11-17
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
Comment
Question by:xabi
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 8

Author Comment

by:xabi
ID: 6201329
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
 
LVL 1

Accepted Solution

by:
mrmicky earned 300 total points
ID: 6207285
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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

On Microsoft Windows, if  when you click or type the name of a .pl file, you get an error "is not recognized as an internal or external command, operable program or batch file", then this means you do not have the .pl file extension associated with …
A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans

630 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question