Why Did This Stall the Server

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

I am a Perl newbie. I have a website (zggames.com). It has been running fine until now. I got an e-mail from my host today saying:

gmstrnk.pl was disabled today for following reasons:
continuous process running (when found it had been running for 76 minu
+tes) system processor utilization in excess of 90%

This script was locked for over an hour as stated above and jeopardizi
+ng other resources on the server. There is a problem with this script
+ that needs to be addressed before re-activating.
[download]

Gmstrnk looks like this:

#!/usr/local/bin/perl
# sets a page's rank and returns a thank you message

$aflag = 0;

$myquery = $ENV{'QUERY_STRING'};
($myvote,$mygametitle,$mybegin,$myend,$bypasscache) = split(/\&/,$myqu
+ery);
$mygametitle =~ tr/\+/ /;
$mylink =~ tr/\~/\'/;

if ($mybegin == 0) { $dbnumber = "1"; }
if ($mybegin != 0) { $dbnumber = "2"; }

open(FORLOCK,"gmlock.pl") or dienice("Rank set script could not open l
+ock file: $!");
flock(FORLOCK, 2) or dienice("Rank set script could not gain exclusive
+ lock on database: $!");

open(INF,"gmlist" . $dbnumber . ".pl") or dienice("Rank set script cou
+ld not open proper game database for reading: $!");
@ary = <INF>;
close(INF);

$i = -1;
$gamenumber = -1;

if ($mybegin != 0) { $i = $mybegin - 2; }

while ($gamenumber == -1) {
    $i++;
    $line = @ary[$i];
    chomp($line);
    ($gmtitle,$gmdescription,$gmurl,$totalvalue,$totalvotes,$averagevo
+te,$clicks,$visibility,$siteid,$timesince,$lastip) = split(/\|/,$line
+);
    if ($gmtitle eq $mygametitle) { $gamenumber = $i; }
}

$line = @ary[$gamenumber];
chomp($line);
($gmtitle,$gmdescription,$gmurl,$totalvalue,$totalvotes,$averagevote,$
+clicks,$visibility,$siteid,$timesince,$lastip) = split(/\|/,$line);

if ($lastip ne $ENV{'REMOTE_ADDR'}) {
    $totalvalue = $totalvalue + $myvote;
    $totalvotes++;
    $averagevote = $totalvalue / $totalvotes;
    $myavg = $averagevote;
}

$lastip = $ENV{'REMOTE_ADDR'};

if (($dbnumber == 1) && ($totalvotes > 2)) {

    @ary[$gamenumber] = "";
    
    open(OUTF,">gmlist" . $dbnumber . ".pl") or dienice("Rank set scri
+pt could not re-open proper database for writing: $!");
    print OUTF @ary;
    close(OUTF);
    
    $dbnumber = 2;
    
    open(INF2,"gmlist" . $dbnumber . ".pl") or dienice("Rank set scrip
+t could not open proper game database for reading: $!");;
    @ary = <INF2>;
    close(INF2);
    
    push(@ary,"this text will be replaced\n");
    
    $gamenumber = $#ary;

    $aflag = 1;
    
}



@ary[$gamenumber] = "$gmtitle|$gmdescription|$gmurl|$totalvalue|$total
+votes|$averagevote|$clicks|$visibility|$siteid|$timesince|$lastip\n";

if ($aflag == 1) {    # if the game is switching databases

    if ($gamenumber != 0) {
        
        $exitflag = -1;
        $i = $gamenumber;
    
        while ($exitflag == -1) {
    
            $i--;
            $line = @ary[$i];
            chomp($line);
            ($gmtitle,$gmdescription,$gmurl,$totalvalue,$totalvotes,$a
+veragevote,$clicks,$visibility,$siteid,$timesince,$lastip) = split(/\
+|/,$line);
            if ($myavg >= $averagevote) {
                $holder = @ary[$i];
                @ary[$i] = @ary[$gamenumber];
                @ary[$gamenumber] = $holder;
                $gamenumber--;
            } else {
                $exitflag = 2;
            }
            if ($i == 0) { $exitflag = 2; }
    
        }
    
    }

} else {

    if ($myvote >= $myavg) {
        
        if ($gamenumber != 0) {
        
            $exitflag = -1;
            $i = $gamenumber;
        
            while ($exitflag == -1) {
        
                $i--;
                $line = @ary[$i];
                chomp($line);
                ($gmtitle,$gmdescription,$gmurl,$totalvalue,$totalvote
+s,$averagevote,$clicks,$visibility,$siteid,$timesince,$lastip) = spli
+t(/\|/,$line);
                if ($myavg >= $averagevote) {
                    $holder = @ary[$i];
                    @ary[$i] = @ary[$gamenumber];
                    @ary[$gamenumber] = $holder;
                    $gamenumber--;
                } else {
                    $exitflag = 2;
                }
                if ($i == 0) { $exitflag = 2; }
        
            }
        
        }
        
    } else {
        
        $exitflag = -1;
        $i = $gamenumber;
        
        while ($exitflag == -1) {
        
            $i++;
            $line = @ary[$i];
            chomp($line);
            ($gmtitle,$gmdescription,$gmurl,$totalvalue,$totalvotes,$a
+veragevote,$clicks,$visibility,$siteid,$timesince,$lastip) = split(/\
+|/,$line);
            if ($myavg < $averagevote) {
                $holder = @ary[$i];
                @ary[$i] = @ary[$gamenumber];
                @ary[$gamenumber] = $holder;
                $gamenumber++;
            } else {
                $exitflag = 2;
            }
            if ($i == $#ary) { $exitflag = 2; }
        }
        
    }
    
}

open(OUTF2,">gmlist" . $dbnumber . ".pl") or dienice("Rank set script 
+could not re-open proper database for writing: $!");
print OUTF2 @ary;
close(OUTF2);

close(FORLOCK);

print <<END_of_Multiline_Text;
Content-type: text/html

<html>

<head>
<title>ZG Games</title>
</head>

<body bgcolor="#000000" text="#C0C0C0" link="#00FFFF"
vlink="#00FFFF" alink="#0000FF">

<p><font size="2" face="Verdana"><strong>Thanks! When you are
done playing the game, click 

END_of_Multiline_Text

if ($mybegin == 0) {
    print "<a href=\"gmnew.pl\" target=\"_top\">here</a>"; }
if ($mybegin != 0) {
    print "<a href=\"gmlist.pl\?$mybegin\-$myend\" target=\"_top\">her
+e</a>"; }

print <<END_of_Multiline_Text;

 to go back.</strong></font></p>
</body>
</html>


END_of_Multiline_Text

sub dienice {
    my($msg) = @_;
    print "Content-type: text/html\n\n";
    print "<h2>Error</h2>\n";
    print "<p>" . $msg . "</p>\n";
    print "<p>Please e-mail this error and the current time to \"rjahr
+man\@aol.com\" (no quotes).</p>\n";
    exit;
}
[download]

What's wrong? (Thanks!)

Fixed title per owner's request - dvergin 2002-06-10
Edit kudra, 2002-06-11 Added readmore tag

Comment on Why Did This Stall the Server Select or Download Code

Replies are listed 'Best First'.
Re: Why Did This by gav^ (Curate) on Jun 11, 2002 at 00:44 UTC
What's wrong: No use of strict or warnings - Use strict warnings and diagnostics or die No use of CGI.pm - use CGI or die; Vast amount of global variables Bad looping, you should be using foreach to iterate over arrays Using `@ary[$i]` instead of `$ary[$i]` Use of 'magic numbers' Using loops where the exit condition may not be met - `while ($gamenumber == -1)` Complete lack of any useful comments Repetitive code that suggests refactoring should occur Using an `$exitflag` variable instead of last to exit a loop Using `$#ary` to determine the end of the array rather than for/foreach (see #4) Using " to quote and being forced to escape (\") quotes, when q/qq would help I'm guessing that the real problem is something to do with an exit condition in one of your loops not being met. gav^	[reply] [d/l] [select]
Re: Why Did This by chromatic (Archbishop) on Jun 11, 2002 at 00:30 UTC
My guess is because one of your while loops never hits an end condition. You're probably walking off the end of @ary. If you had warnings enabled, Perl would tell you about this. Revise the code to use the warnings pragma or the -w flag, and you'll have an easier time tracking this down.	[reply]
Re: Why Did This Stall the Server by jarich (Curate) on Jun 11, 2002 at 08:23 UTC
First let me say that gav^ is 100% correct in his assessment of your problem. You SHOULD use strict, and CGI and warnings. However, if you had they probably still wouldn't have found your bug. gav^ also said you should use foreach to iterate over arrays and I think he hit the hammer on the head here when it comes to finding your problem. However, your code suggests that you're not a particularly strong Perl programmer and whilst we'd HOPE that you'd be interested enough to go and read the books I realise that sometimes that doesn't really help you solve the problem you have NOW. Being in a nice friendly mood, and not a little bored at work, I've spent a little time rewriting some aspects of your script. Read it carefully and test it HEAPS. It compiles, it follows most of gav^'s recommendations (but not the one about CGI - please consider making the changes to do this, it'll make your code much nicer) but I HAVE NOT TESTED IT. I don't have your game files, I can't be bothered working out what they should look like exactly. Even worse, I've made some pretty bold assumptions about what you want your code to be doing in certain circumstances. For example in your first `while` loop you have the following line: `if ($gmtitle eq $mygametitle) { $gamenumber = $i; }` [download] and I wonder... shouldn't that cause you to step out of the while loop? So read the code, learn from it, ask questions about it, and test it thoroughly before you upload it to your ISP! Oh, and next time, use strict, warnings and CGI. I hope this helps. jarich Read more... (8 kB)	[reply] [d/l] [select]
Re: Why Did This by Anonymous Monk on Jun 11, 2002 at 00:01 UTC
P.S. (it's me again) The thread is supposed to be named "Why Did This Stall the Server" but the server truncated it.	[reply]