Trouble getting CGI script to fail gracefully

[dsirrine]

I am using LWP and CGI::Carp in one script to acquire statistics on some of my web servers, however, if one of the hosts is down, the script fails and won't return any data. The basics of the script are as follows:

my $html_page = get("foo") or die "Couldn't fetch the page.";
$html_page =~ m{ReqPerSec: (\d+\.?\d+?)};
$Requests1 = $1;
$html_page =~ m{BusyWorkers: (\d+)};
$Connections1 = $1;
$html_page =~ m{IdleWorkers: (\d+)};
$IdleWorkers1 = $1;
$html_page =~ m{BytesPerReq: (\d+)};
$BytesPerRequest1 = $1;
$html_page =~ m{BytesPerSec: (\d+)};
$BytesPerSecond1 = $1;
print "Content-type: text/html\n\n";

Then it prints the information to an html file with a table to house the data. What I would like to accomplish is to check the status of the server first (possibly by using ->status_line) and have it print the error to the appropriate row and move onto the next block of code. I have not been able to get this to work because when ever it comes to a host that is unavailable the script hangs and won't give me an error. Any help would be GREATLY appreciated. Thank you in advance.

[Dabrowski]

Could you try a simple ping to test the server beforehand?

[perl_diver]

Look in the LWP documentation and see if there is a "timeout" option. If not you could probably use alarm() and set a limit yourself. If the alarm gets triggered you "die" or go to the next process. See the perl alarm() function for details. Or you could try pinging as Dabrowski suggests.

[dsirrine]

Thank you for the replies, I still can't seem to get the timeout function to work. Though I think I'm close. Basically, I've simplified a little and using only LWP::Simple and LWP::UserAgent. I've devised a simple script that does exactly what I need it to do, but when I extrapolate it out to the full application of the script, it still locks the script. Here's a sample of the script that works.

#!/usr/bin/perl -w

use LWP::Simple;
use LWP::UserAgent;

my $browser = LWP::UserAgent->new;
my $url = 'FOO';
my $response = $browser->get($url);
if ($response->status_line eq '200 OK') {
print "Everything's ok\n";
} else {
print $response->status_line;
print "\n"
}

where FOO = any kind of website or nothing at all and it gives me results I can work with... That is, until I try and use our IP. It works if the hose is live, but when I adjust the ip, it locks up... Any ideas?

[mark_roach]

Try adding the following line of code after the my $browser line:

$browser->timeout(30);

BTW I don't think you need LWP::Simple for the snippet of code above.

[dsirrine]

I have fixed the previous issue by changing the order of code, now I'm getting a new error... I'm using pring << "EOP"; and EOP to use code intermittently with HTML. Now I'm getting an error "Use of uninitialized value in concatenation (.) or string at ./test.cgi line 91." on the following code:

#!/usr/bin/perl -w

#########################################
#Includes#
#########################################

use LWP::Simple;# For 'get' module
use LWP::UserAgent;# For 'status_line' module

#########################################
#Variables#
#########################################

my ($Requests1, $Requests2, $Requests3, $Requests4, $Requests5, $Requests6, $Requests7, $Requests8, $Requests9, $Requests10)
= 'not found';
my ($Connections1, $Connections2, $Connections3, $Connections4, $Connections5, $Connections6, $Connections7, $Connections8,
$Connections9, $Connections10) = 'not found';
my ($IdleWorkers1, $IdleWorkers2, $IdleWorkers3, $IdleWorkers4, $IdleWorkers5, $IdleWorkers6, $IdleWorkers7, $IdleWorkers8,
$IdleWorkers9, $IdleWorkers10) = 'not found';
my ($BytesPerRequest1, $BytesPerRequest2, $BytesPerRequest3, $BytesPerRequest4, $BytesPerRequest5, $BytesPerRequest6,
$BytesPerRequest7, $BytesPerRequest8, $BytesPerRequest9, $BytesPerRequest10) = 'not found';
my ($BytesPerSecond1, $BytesPerSecond2, $BytesPerSecond3, $BytesPerSecond4, $BytesPerSecond5, $BytesPerSecond6,
$BytesPerSecond7, $BytesPerSecond8, $BytesPerSecond9, $BytesPerSecond10) = 'not found';
my $TotalRequests = 0;
my $TotalConnections = 0;
my $TotalIdleWorkers = 0;
my $TotalBytesPerRequests = 0;
my $TotalBytesPerSecond = 0;
my ($Second, $Minute, $Hour, $Day, $Month, $Year, $wday, $yday, $isdst) = localtime(time);

if ($Hour <10) {
$Hour = ("0" . $Hour);
}
if ($Minute < 10) {
$Minute = ("0" . $Minute);
}
$Month++;

#################################################
# Create start of table #
# And IF OK #
#################################################

print "Content-type: text/html\n\n";
print << "EOP";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Stats for static webservers</title>
</head>
<body>
<br><font face="arial,helvetica,sans-serif" size="3">Stats for static webservers</font><br>
<font face="arial,helvetica,sans-serif" size="2">As of: $Month/$Day - $Hour:$Minute:$Second</font><br>
<br>
<table cellpadding="2" cellspacing="0" border="1" class="tableshape">
<tr>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Server</font></b></td>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Requests / sec</font></b></td>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Connections</font></b></td>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Idle workers</font></b></td>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Bytes / req</font></b></td>
<td align="center"><b><font face="arial,helvetica,sans-serif" size="2">Bytes / sec</font></b></td>
</tr>
EOP

#################################################
#Status Check#
#################################################

my $browser = LWP::UserAgent->new;
my $html_page = 'FOO';
my $response = $browser->get($html_page);

$response =~ m{ReqPerSec: (\d+\.?\d+?)};
$Requests1 = $1;
$browser =~ m{BusyWorkers: (\d+)};
$Connections1 = $1;
$browser =~ m{IdleWorkers: (\d+)};
$IdleWorkers1 = $1;
$browser =~ m{BytesPerReq: (\d+)};
$BytesPerRequest1 = $1;
$browser =~ m{BytesPerSec: (\d+)};
$BytesPerSecond1 = $1;

if ($response->status_line eq '200 OK') {

#################################################
# Checi if OK #
#################################################

print << "EOP";
<tr>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">Server1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$Requests1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$Connections1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$IdleWorkers1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$BytesPerRequest1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$BytesPerSecond1</font></td>
</tr>
EOP

} else {

#########################################################
#Print status_line if NOT OK#
#########################################################

my $StatusLine = $response->status_line;
print << "EOP";
<tr>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">Server1</font></td>
<td align="center"><font face="arial,helvetica,sans-serif" size="2">$StatusLine</font></td>
</tr>
EOP
}

#########################################
#End of Table#
#########################################

print << "EOP";
</table>
</body>
</html>
EOP
print "\n";

I apologize for the sheer volume of code in this thread.

[perl_diver]

Thats a warning, not an error, it means a variable you are printing has no defined value. You can give variables a value like:

$foo = $bar ¦¦ ' ';

to avoid the warning. Or use the warnings pragma "use warnings" instead of the -w switch and use "no warnings" in blocks where you don't want to the warnings to be generated.

[Dabrowski]

I also use the [perl] print <<END;[/perl] method in CGI.

Firstly, you have a slightly different syntax, your marker is in double quotes. I really don't know if that makes a difference but I don't use them (as above).

perl_diver is quite right, the value in question is most likely one of the varibles inside your print block, [perl] $StatusLine[/perl] for example.

A print block in this format is the same as a double quoted string, so:
[perl] print <<END;
Line 1
Line $something
Line 2
END[/perl]

I believe is the same as:
[perl] print "Line 1\n"."Line ".$something."\n"."Line 2\n";[/perl]

So you see, if $something was not just empty, but not defined that would throw the error you're seeing.

Incidentally, instead of this:
[perl] my ($Requests1, $Requests2, $Requests3, $Requests4, $Requests5, $Requests6, $Requests7, $Requests8, $Requests9, $Requests10) = 'not found'; [/perl]

Wouldn't it be better to use [perl]my @requests;[/perl] and run a [perl] for( 1 .. 10)[/perl] loop? Same for the others?

[perl_diver]

Firstly, you have a slightly different syntax, your marker is in double quotes. I really don't know if that makes a difference but I don't use them (as above).

The use of quotes with the heredoc label does have an affect, but no quotes is the same as double-quotes. If you use single-quotes, it's the same as a single-quoted construct (no variable interpolation):

$test = 'foo';
print <<'EOP';
my name is "$test"
EOP

will print the literal string:

my name is "$test"

instead of:

my name is "foo"

I much prefer q and qq over heredocs or quotes.

[perl_diver]

Wouldn't it be better to use my @requests; and run a for( 1 .. 10) loop? Same for the others?

Good point, would also reduce some code bloat.

[dsirrine]

I used the array and it worked perfectly, thanks for that. In regards to the timeout() function, how could I incorporate that into an if statement where if the get() times out execute a separate line of code? Again, thanks for all the help.

[Dabrowski]

It's been a while since I used LWP, but if I remember you can set a timeout option, I think the default is about 3 minutes or something.

So then you just use your GET as normal and check the output?

[phranque]

i think your cgi script is timing out before the request times out.

$browser->timeout(20);

would reset the request timeout to 20 seconds.

[dsirrine]

Thanks phranque and everyone else. That worked. Though now I'm having a little quirk when I'm testing. I mangled the ip of the first server to make sure it will time out properly and give me the http status_line which works flawlessly. It moves on to the next server without a problem. But the 3rd server (which works fine under normal circumstances) hangs, doesn't respect the timeout() I set and returns nothing. Once the script gets past that (about 20 seconds) the rest of the script runs fine. Any ideas as to how that happens?

my $browser = LWP::UserAgent->new;
$browser->timeout(1);
my $response = $browser->get($MGIStatic1);
if ($response->status_line eq '200 OK') {

That's how I set it up.

[phranque]

the timeout is for "no activity on the connection".
1 second may be too impatient.

[dsirrine]

I bumped it up to 5 seconds per connection and it's still giving me the same effect.

[phranque]

i'm not sure what "which works fine under normal circumstances" means.

do you know what the response status chain normally is for the 3rd server?

(any redirects?)
does it always work at the default timeout?
does it always fail with the short timeout?

[dsirrine]

Basically, the short and skinny of it is that the third server should send a '200 OK' message, and does when none of the preceding servers time out. However, when I force a timeout on the first server, it responds with the appropriate error code '500 Can't connect to #*$!.#*$!.#*$!.#*$!:80 (connect: timeout)' then the second server responds '200 OK', but then the third server fails completely and doesn't respond anything. The script continues to run without issue after that.

[phranque]

is $response actually a HTTP::Response object?
what does $response->code return?
perhaps you could create a HTTP::Request and try something like:

my $response = $browser->simple_request($request);

and see if that gives any clues...

[dsirrine]

Not totally clear what using the "Request" method would accomplish. The "Code" method returns the response code from the page, i.e. 200 for OK 404 for page not found, etc. And that's exactly what I need. However, for some reason, the script is locking up on the third server when the first one times out and gives me the response code, the second one runs normally, and the third one waits around 30 seconds ane returns nothing and the rest runs normally (returns the page results). However, when all servers are working, they all run normally.

[phranque]

you haven't really answered my first question about the response status chain for that third request.
simple_request would be one way to break down the transaction into individual http requests and see which one is causing the problem or see if it is the overall transaction that is the problem.

i'm not suggesting this is a solution, but if you run out of things to try it may tell you more than we know now...