Click here " .
"to return to the top level of the website. If the problem " .
"persists, contact the webmaster.\n";
# If the query was a GET, we can easily provide a link back to ourselves.
# If it's a POST, that's much harder, and not worth trying.
if ($ENV{REQUEST_METHOD} eq 'GET')
{
$Error{'ErrLink'} =
"Please click " .
"here to try your query again, or try again in a few minutes.\n";
}
elsif ($ENV{REQUEST_METHOD} eq 'POST')
{
$Error{'ErrLink'} =
"Please click here to return to " .
"the previous page and try again in a few minutes.\n";
}
# This'll set MAX_TOTAL arbitrarily low (to deliberately trigger the
# sorry-please-try-again code) if the calling script name contains 'test'
#if ($0 =~ m/test/) { $MAX_TOTAL = 60; };
# This is the optional interface to set the load limits to something
# different. Call passing key/value pairs with any/all of
# 'LOAD', 'RUNNING', and 'TOTAL' as keys, and numeric values, such
# as SetLimit('LOAD', 4, 'RUNNING', 20);
sub SetLimit
{
my %Limits = @_;
$MAX_LOAD = $Limits{LOAD} if ($Limits{LOAD});
$MAX_RUNNING = $Limits{RUNNING} if ($Limits{RUNNING});
$MAX_TOTAL = $Limits{TOTAL} if ($Limits{TOTAL});
}
# This function gets the load best it can and:
# -calls PrintError if the load is too high, or
# -returns a load avg associative array with keys LOAD, RUNNING,
# and TOTAL if called with the parameter "checkonly"
# -if load isn't too high, return the above assoc array (hey, why not?)
sub CheckLoad
{
# If not a POST or a GET with an actual query, we've already done 90%
# of the work we're gonna just by starting up; we may as well continue
return 1 unless (($ENV{QUERY_STRING} and $ENV{REQUEST_METHOD} eq 'GET') or
($ENV{REQUEST_METHOD} eq 'POST'));
# allow cgis to load LoadLimit and call CheckLoad directly,
# preempting a default call to CheckLoad in cgi-lib.pl
$LOADLIMIT_INSTALLED ? return : $LOADLIMIT_INSTALLED++;
# allow cgis to call CheckLoad telling it to only return the
# load info to the caller, instead of automagically printing
# an error and exiting if the load is too high
my $checkonly = (scalar(@_) && $_[0] =~ /checkonly/i) ? 1 : 0;
my(@today) = localtime;
$today[4]++; $today[5]+=1900;
$date = sprintf("%4d-%02d-%02d_%02d:%02d:%02d",$today[5],$today[4],
$today[3],$today[2],$today[1],$today[0]);
my ($load,$curload,$running,$total,$uptime);
if ( (open(LOAD, " and
# the line looks like: 0.03 0.08 0.03 2/81 11365
# we'll snag these: ^ ^ ^
$load =~ m%^([0-9]+)\.[0-9]+ [0-9.]+ [0-9.]+ ([0-9]+)/([0-9]+) [0-9]+$%
) or (
local($ENV{PATH})=undef and # prevent a warning under -T
$load = `/usr/bin/uptime` and # more portable than /proc
# the line looks like:
# 4:43pm up 5 days, 21:20, 1 user, load average: 0.05, 0.08, 0.03
# we'll snag these: ^ ^
$load =~ m%([0-9]+) users?, *load average: ([0-9]+)\.%
)
)
{
close(LOAD);
if (defined($3))
{
$curload = $1; $running = $2; $total = $3;
}
else
{
$curload = $2; $running = $2; $total = $1;
}
if ($curload > $MAX_LOAD or
$running > $MAX_RUNNING or
$total > $MAX_TOTAL)
{
# We're probably being DOSed; log an error and either kill
# ourselves, or return the load numbers to the caller
chomp $load;
print STDERR "[$date] ${0}[$$]: Abnormal load: $load for ",
"$ENV{'REMOTE_HOST'}:$ENV{'REQUEST_URI'}\n";
$checkonly ? return('LOAD',$curload,'RUNNING',$running,'TOTAL',$total)
: &PrintError;
}
}
else
{
print STDERR "[$date] ${0}[$$]: Error checking load: $! for ",
"$ENV{'REMOTE_HOST'}:$ENV{'REQUEST_URI'}\n";
close(LOAD);
$checkonly ? return(undef) : &PrintError;
}
return('LOAD',$curload,'RUNNING',$running,'TOTAL',$total);
}
# This is the optional interface to set the error strings to something
# different. Call passing key/value pairs with any/all of
# Title, BodyScheme, ErrTop, ErrLink, ErrBot, and strings, such as:
# SetError('Title', 'Problem trying to send email'), etc.
sub SetError
{
my %err = @_;
foreach my $key (%err)
{
$Error{$key} = $err{$key} if ($Error{$key});
}
}
# The error-printing function. Note that this assumes that the HTTP
# header has not yet been printed. If a script wants to issue custom
# messages to the user that don't fit into the %Error message array,
# it can't use this.
sub PrintError
{
print <