version 1.11, 2003/07/31 19:18:16
|
version 1.15, 2003/08/05 12:52:23
|
Line 19 my %connectionstatus=();
|
Line 19 my %connectionstatus=();
|
my %perlvar=(); |
my %perlvar=(); |
|
|
my $mode; |
my $mode; |
|
my $concount=0; |
|
|
sub select_form { |
sub select_form { |
my ($def,$name,%hash) = @_; |
my ($def,$name,%hash) = @_; |
Line 47 sub hidden {
|
Line 48 sub hidden {
|
|
|
sub request { |
sub request { |
my ($local,$url,$cachetime)=@_; |
my ($local,$url,$cachetime)=@_; |
|
$cachetime*=(0.5+rand); |
my $key=&key($local,$url); |
my $key=&key($local,$url); |
my $reply=''; |
my $reply=''; |
if ($FORM{$key.'_time'}) { |
if ($FORM{$key.'_time'}) { |
Line 61 sub request {
|
Line 63 sub request {
|
$reply='local_unknown'; |
$reply='local_unknown'; |
} else { |
} else { |
|
|
my $ua=new LWP::UserAgent(timeout => 20); |
my $ua=new LWP::UserAgent(timeout => 10); |
|
|
my $request=new HTTP::Request('GET', |
my $request=new HTTP::Request('GET', |
"http://".$hostname{$local}.$url); |
"http://".$hostname{$local}.$url); |
Line 91 sub connected {
|
Line 93 sub connected {
|
unless ($hostname{$remote}) { return 'remote_unknown'; } |
unless ($hostname{$remote}) { return 'remote_unknown'; } |
my $url='/cgi-bin/ping.pl?'.$remote; |
my $url='/cgi-bin/ping.pl?'.$remote; |
# |
# |
# Slowly phase this in: if not cached, only do 10 percent of the cases |
# Slowly phase this in: if not cached, only do 5 percent of the cases, |
|
# but always do the first five. |
# |
# |
unless ($FORM{&key($local,$url)}) { |
unless ($FORM{&key($local,$url)}) { |
unless (rand>0.9) { return 'not_yet'; } |
unless (($concount<=5) || (rand>0.95)) { |
|
return 'not_yet'; |
|
} else { |
|
$concount++; |
|
} |
} |
} |
# |
# |
# Actually do the query |
# Actually do the query |
Line 199 ENDHEADER
|
Line 206 ENDHEADER
|
print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>"); |
print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>"); |
} |
} |
print "<tr><td bgcolor='#BBBBBB'>"; |
print "<tr><td bgcolor='#BBBBBB'>"; |
|
# version |
|
if ($host{$local.'_version'}) { |
|
print "<br />Version: ".$host{$local.'_version'} |
|
} |
# load |
# load |
if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) { |
if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) { |
print "<br />Load: ".$host{$local.'_load'} |
print "<br />Load: ".$host{$local.'_load'} |
Line 386 foreach $local (sort keys %hostname) {
|
Line 397 foreach $local (sort keys %hostname) {
|
$host{$local.'_errors'}=$loncron{'errors'}; |
$host{$local.'_errors'}=$loncron{'errors'}; |
} |
} |
} |
} |
|
# -- Check version |
|
&statuslist($local,'Version'); |
|
my $version=&request($local,'/lon-status/version.txt',7200); |
|
if ($version eq 'local_error') { |
|
$host{$local.'_version'}='Could not determine.'; |
|
$host{$local.'_unresponsive_doomed'}++; |
|
} else { |
|
$host{$local.'_version'}=$version; |
|
} |
# -- Check user status |
# -- Check user status |
&statuslist($local,'Users'); |
&statuslist($local,'Users'); |
my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600); |
my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600); |
Line 482 foreach $local (sort keys %hostname) {
|
Line 502 foreach $local (sort keys %hostname) {
|
print '<tr><th bgcolor="#DDDDBB">'.$local.'</th>'; |
print '<tr><th bgcolor="#DDDDBB">'.$local.'</th>'; |
foreach my $remote (sort keys %hostname) { |
foreach my $remote (sort keys %hostname) { |
if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') { |
if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') { |
print '<td bgcolor="#FFFFFF"> </td>'; |
my $cellcolor='#FFFFFF'; |
|
if ($local eq $remote) { $cellcolor='#DDDDDD'; } |
|
print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>'; |
} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') { |
} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') { |
|
my $cellcolor='#BBDDBB'; |
|
if ($local eq $remote) { $cellcolor='#99DD99'; } |
print |
print |
'<td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>ok</b></td>'; |
'<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>'; |
} else { |
} else { |
|
my $cellcolor='#DDBBBB'; |
|
if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') { |
|
if ($local eq $remote) { |
|
$cellcolor='#DD88AA'; |
|
} else { |
|
$cellcolor='#DDAACC'; |
|
} |
|
} else { |
|
if ($local eq $remote) { $cellcolor='#DD9999'; } |
|
} |
print |
print |
'<td bgcolor="#DDBBBB"><font color="#552222" size="-2">'. |
'<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'. |
$connectionstatus{$local.'_TO_'.$remote}.'<br />'; |
$connectionstatus{$local.'_TO_'.$remote}.'<br />'; |
&lonc($local); &lond($remote); |
&lonc($local); &lond($remote); |
print '</td>'; |
print '</td>'; |
Line 509 foreach $local (sort keys %hostname) {
|
Line 543 foreach $local (sort keys %hostname) {
|
print |
print |
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local. |
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local. |
'</font></th><td bgcolor="#DDDDBB">'; |
'</font></th><td bgcolor="#DDDDBB">'; |
&users(); |
&users($local); |
print |
print |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
$host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"'; |
$host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"'; |
Line 533 foreach $local (sort keys %hostname) {
|
Line 567 foreach $local (sort keys %hostname) {
|
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'. |
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'. |
$local. |
$local. |
'</font></th><td bgcolor="#DDDDBB">'; |
'</font></th><td bgcolor="#DDDDBB">'; |
&server(); |
&server($local); |
print |
print |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
$host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"'; |
$host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"'; |
Line 549 foreach $local (sort keys %hostname) {
|
Line 583 foreach $local (sort keys %hostname) {
|
my $count=0; |
my $count=0; |
foreach $local (sort keys %hostname) { |
foreach $local (sort keys %hostname) { |
my $trouble=''; |
my $trouble=''; |
|
if ($host{$local.'_unresponsive_doomed'}>3) { |
|
$trouble='Does not respond to several queries.<br />'; |
|
} |
if ($host{$local.'_errors'}) { |
if ($host{$local.'_errors'}) { |
$trouble='Has loncron errors.<br />'; |
$trouble='Has loncron errors.<br />'; |
} elsif ($host{$local.'_loncron_doomed'}>600) { |
} elsif ($host{$local.'_loncron_doomed'}>600) { |
Line 573 foreach $local (sort keys %hostname) {
|
Line 610 foreach $local (sort keys %hostname) {
|
# ============================================================== Close, refresh |
# ============================================================== Close, refresh |
print "</form><script>"; |
print "</form><script>"; |
$runtime=time-$starttime; |
$runtime=time-$starttime; |
if ($runtime>=$refresh) { |
if (($refresh-$runtime)<30) { |
print 'document.status.submit();'; |
print "setTimeout('document.status.submit()',30000);\n". |
|
"document.prgstat.progress.value='Will automatically refresh.'"; |
} else { |
} else { |
$refreshtime=int(1000*($refresh-$runtime)); |
$refreshtime=int(1000*($refresh-$runtime)); |
print "setTimeout('document.status.submit()',$refreshtime);\n". |
print "setTimeout('document.status.submit()',$refreshtime);\n". |