Solved

Problem with core dumps.

Posted on 2001-06-18
2
204 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Using Perl to parse rows 7 101
Parse csv file and generate graphs in HTML in bash 8 277
PERL - Find newest folder 12 166
Internal Server Error on 1&1 Apache Server running PERL 3 64
I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
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…

762 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