version 1.3, 2002/05/11 21:29:42
|
version 1.8, 2003/07/30 21:20:16
|
Line 6 $|=1;
|
Line 6 $|=1;
|
# (Running loncron |
# (Running loncron |
# 09/06/01 Gerd Kortemeyer) |
# 09/06/01 Gerd Kortemeyer) |
# 02/18/02,02/19/02 Gerd Kortemeyer) |
# 02/18/02,02/19/02 Gerd Kortemeyer) |
# 5/11/2002 Scott Harrison |
|
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
Line 14 use LONCAPA::Configuration;
|
Line 13 use LONCAPA::Configuration;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Headers; |
use HTTP::Headers; |
use IO::File; |
use IO::File; |
use Net::Ping; |
|
|
|
sub online { |
my %host=(); |
my $host=shift; |
my $oneday=60*60*24; |
my $p=Net::Ping->new("tcp",10); |
|
my $online=$p->ping("$host"); |
my %connectionstatus=(); |
$p->close(); |
|
undef ($p); |
sub key { |
return $online; |
my ($local,$url)=@_; |
|
my $key=$local.'_'.$url; |
|
$key=~s/\W/\_/gs; |
|
return $key; |
|
} |
|
|
|
sub hidden { |
|
my ($name,$value)=@_; |
|
print "\n<input type='hidden' name='$name' value='$value' />"; |
|
} |
|
|
|
sub request { |
|
my ($local,$url,$cachetime)=@_; |
|
my $key=&key($local,$url); |
|
my $reply=''; |
|
if ($FORM{$key.'_time'}) { |
|
if ((time-$FORM{$key.'_time'})<$cachetime) { |
|
$reply=$FORM{$key}; |
|
&hidden($key.'_time',$FORM{$key.'_time'}); |
|
&hidden($key.'_fromcache',1); |
|
} |
|
} |
|
unless ($reply) { |
|
unless ($hostname{$local}) { |
|
$reply='local_unknown'; |
|
} else { |
|
|
|
my $ua=new LWP::UserAgent(timeout => 20); |
|
|
|
my $request=new HTTP::Request('GET', |
|
"http://".$hostname{$local}.$url); |
|
$request->authorization_basic('lonadm','litelite'); |
|
|
|
my $response=$ua->request($request); |
|
|
|
unless ($response->is_success) { |
|
$reply='local_error'; |
|
} else { |
|
$reply=$response->content; |
|
chomp($reply); |
|
} |
|
} |
|
&hidden($key.'_time',time); |
|
} |
|
&hidden($key,$reply); |
|
return $reply; |
} |
} |
|
|
|
# ============================================= Are local and remote connected? |
sub connected { |
sub connected { |
my ($local,$remote)=@_; |
my ($local,$remote)=@_; |
$local=~s/\W//g; |
$local=~s/\W//g; |
$remote=~s/\W//g; |
$remote=~s/\W//g; |
|
|
unless ($hostname{$local}) { return 'local_unknown'; } |
|
unless ($hostname{$remote}) { return 'remote_unknown'; } |
unless ($hostname{$remote}) { return 'remote_unknown'; } |
|
my $url='/cgi-bin/ping.pl?'.$remote; |
|
# |
|
# Slowly phase this in: if not cached, only do 10 percent of the cases |
|
# |
|
unless ($FORM{&key($local,$url)}) { |
|
unless (rand>0.9) { return 'not_yet'; } |
|
} |
|
# |
|
# Actually do the query |
|
# |
|
&statuslist($local,'connecting '.$remote); |
|
my $reply=&request($local,$url,1800); |
|
$reply=(split("\n",$reply))[0]; |
|
$reply=~s/\W//g; |
|
if ($reply ne $remote) { return $reply; } |
|
return 'ok'; |
|
} |
|
# ============================================================ Get a reply hash |
|
|
unless (&online($hostname{$local})) { return 'local_offline'; } |
sub replyhash { |
|
my %returnhash=(); |
|
foreach (split(/\&/,&request(@_))) { |
|
my ($name,$value)=split(/\=/,$_); |
|
if ($name) { |
|
unless ($value) { $value=''; } |
|
$returnhash{$name}=$value; |
|
} |
|
} |
|
return %returnhash; |
|
} |
|
|
my $ua=new LWP::UserAgent; |
# ========================================================== Show server status |
|
|
my $request=new HTTP::Request('GET', |
|
"http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote); |
|
|
|
my $response=$ua->request($request); |
sub otherwindow { |
|
my ($local,$url,$label)=@_; |
|
return |
|
"<a href='http://$hostname{$local}$url' target='newwin$local'>$label</a>"; |
|
} |
|
|
unless ($response->is_success) { return 'local_error'; } |
sub serverstatus { |
|
my $local=shift; |
|
print "\n<hr /><h3>$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})</h3>\n"; |
|
# checkrpms |
|
if ($host{$local.'_checkrpms'}) { |
|
print "<br />RPMs: ".$host{$local.'_checkrpms'} |
|
} |
|
# mysql |
|
if ($host{$local.'_mysql'}) { |
|
print "<br />MySQL Database: ".$host{$local.'_mysql'} |
|
} |
|
} |
|
|
my $reply=$response->content; |
# ====================================================================== Status |
$reply=(split("\n",$reply))[0]; |
sub statuslist { |
$reply=~s/\W//g; |
my ($local,$what)=@_; |
if ($reply ne $remote) { return $reply; } |
print |
return 'ok'; |
"<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n"; |
} |
} |
|
|
|
# |
|
# Main program |
|
# |
|
# ========================================================= Get form parameters |
|
my $buffer; |
|
|
|
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); |
|
my @pairs=split(/&/,$buffer); |
|
my $pair; my $name; my $value; |
|
undef %FORM; |
|
%FORM=(); |
|
foreach $pair (@pairs) { |
|
($name,$value) = split(/=/,$pair); |
|
$value =~ tr/+/ /; |
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
$FORM{$name}=$value; |
|
} |
|
|
|
$buffer=$ENV{'QUERY_STRING'}; |
|
@pairs=split(/&/,$buffer); |
|
foreach $pair (@pairs) { |
|
($name,$value) = split(/=/,$pair); |
|
$value =~ tr/+/ /; |
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
$FORM{$name}=$value; |
|
} |
|
|
|
# ====================================================== Determine refresh rate |
|
|
|
my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:60); |
|
if ($refresh<30) { $refresh=30; } |
|
my $starttime=time; |
|
# ================================================================ Send Headers |
print "Content-type: text/html\n\n". |
print "Content-type: text/html\n\n". |
"<html><body bgcolor=#FFFFFF>\n"; |
"<html><body bgcolor=#FFFFFF>\n"; |
# ------------------------------------------- Read access.conf and loncapa.conf |
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
my $perlvarref=LONCAPA::Configuration::read_conf('access.conf','loncapa.conf'); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my %perlvar=%{$perlvarref}; |
my %perlvar=%{$perlvarref}; |
undef $perlvarref; # remove since sensitive and not needed |
undef $perlvarref; # remove since sensitive and not needed |
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
Line 67 delete $perlvar{'lonSqlAccess'}; # remov
|
Line 182 delete $perlvar{'lonSqlAccess'}; # remov
|
|
|
$total=0; |
$total=0; |
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
|
$configline=~s/#.*$//; |
|
unless ($configline=~/\w/) { next; } |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
$hostname{$id}=$name; |
$hostname{$id}=$name; |
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
Line 79 delete $perlvar{'lonSqlAccess'}; # remov
|
Line 196 delete $perlvar{'lonSqlAccess'}; # remov
|
} |
} |
} |
} |
|
|
print |
print "<h1>Cluster Status ".localtime()."</h1>"; |
"<h1>Cluster Status</h1>"; |
print "<form name='prgstat'>\n". |
print "Please be patient while building cluster status ...<p>\n"; |
"<input type='text' name='progress' value='Starting ...' size='100' /><br />". |
$table=''; |
"</form>\n";; |
|
print "<form name='status' method='post'>\n"; |
$table.="<table border=2><tr><th rowspan=2>From (local)</th>". |
&hidden('refresh',$refresh); |
"<th colspan=$total>To (remote)</th></tr><tr>"; |
|
foreach $remote (sort keys %hostname) { |
# ==================================================== Main Loop over all Hosts |
$table.="<th"; |
|
if ($remote eq $perlvar{'lonHostID'}) { |
|
$table.=" bgcolor=#CCFFBB"; |
|
} else { |
|
if ($libserv{$remote}) { $table.=" bgcolor=#FFFF99"; } |
|
} |
|
$table.= |
|
"><a href=http://".$hostname{$remote}."/lon-status/>$remote</a></th>"; |
|
} |
|
$table.="</tr>"; |
|
foreach $local (sort keys %hostname) { |
foreach $local (sort keys %hostname) { |
print "Checking $local "; |
# -- Check general status |
$table.="<tr><td"; |
&statuslist($local,'General'); |
if ($local eq $perlvar{'lonHostID'}) { |
my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200); |
$table.=" bgcolor=#CCFFBB"; |
if (defined($loncron{'local_error'})) { |
} else { |
$host{$local.'_loncron'}='Could not determine.'; |
if ($libserv{$local}) { $table.=" bgcolor=#FFFF99"; } |
} else { |
} |
if ((time-$loncron{'time'})>$oneday) { |
$table.= |
$host{$local.'_loncron'}='Stale.'; |
"><b><a href=http://".$hostname{$local}."/lon-status/>$local</a></b><br>". |
} else { |
$hostrole{$local}.' '.$hostdom{$local}.'<br>'. |
} |
"<tt><a href=http://".$hostname{$local}."/server-status/>". |
} |
$hostname{$local}."</a></tt><br>". |
# -- Check user status |
"<a href=http://".$hostname{$local}."/cgi-bin/loncron.pl>New Report</a>". |
&statuslist($local,'Users'); |
"</td>"; |
my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600); |
if (&online($hostname{$local})) { |
if (defined($userstatus{'local_error'})) { |
foreach $remote (sort keys %hostname) { |
$host{$local.'_userstatus'}='Could not determine.'; |
$status=&connected($local,$remote); |
} else { |
if ($status eq 'ok') { |
} |
$table.="<td"; |
# -- Check mysql status |
if ($libserv{$remote}) { |
&statuslist($local,'Database'); |
if ($libserv{$local}) { |
my %mysql=&replyhash($local,'/lon-status/mysql.txt',1200); |
$table.=" bgcolor=#FFFF44"; |
if (defined($mysql{'local_error'})) { |
} else { |
$host{$local.'_mysql'}='Could not determine.'; |
$table.=" bgcolor=#FFFF99"; |
} else { |
} |
if ((time-$mysql{'time'})>(7*$oneday)) { |
} elsif ($libserv{$local}) { |
if ($hostrole{$local} eq 'library') { |
$table.=" bgcolor=#FFFF99"; |
$host{$local.'_mysql'}='Stale.'; |
} |
$host{$local.'_mysql_doomed'}=1; |
$table.="><b><font color=#00FF00>OK</font></b></td>"; |
} |
print "."; |
if ($mysql{'mysql'} eq 'defunct') { |
} else { |
$host{$local.'_mysql'}='Defunct (maybe stale).'; |
print "X"; |
$host{$local.'_mysql_doomed'}=2; |
$table.="<td><b><font color=#FF0000>".$status."</font></b><br>". |
} |
"<a href=http://".$hostname{$local}. |
} elsif ($mysql{'mysql'} eq 'defunct') { |
"/lon-status/loncstatus.txt>lonc</a>"; |
$host{$local.'_mysql'}='Defunct.'; |
if (&online($hostname{$remote})) { |
$host{$local.'_mysql_doomed'}=3; |
$table.=" <a href=http://".$hostname{$remote}. |
} |
"/lon-status/londstatus.txt>lond</a>". |
} |
"</td>"; |
# -- Check rpm status |
} else { |
&statuslist($local,'RPMs'); |
$table.=' offline'; |
my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',2400); |
} |
if (defined($checkrpms{'local_error'})) { |
|
$host{$local.'_checkrpms'}='Could not determine.'; |
} |
} else { |
} |
if ((time-$checkrpms{'time'})>(4*$oneday)) { |
} else { |
$host{$local.'_checkrpms'}='Stale.'; |
print "offline"; |
$host{$local.'_checkrpms_doomed'}=50; |
$table.='<th colspan='.$total.'><font color=#FF0000>Offline</font></th>'; |
} elsif ($checkrpms{'status'} eq 'fail') { |
} |
$host{$local.'_checkrpms'}='Could not checked RPMs.'; |
$table.="</tr>\n"; |
$host{$local.'_checkrpms_doomed'}=100; |
print "<br>\n"; |
} elsif ($checkrpms{'rpmcount'}) { |
} |
$host{$local.'_checkrpms'}='Outdated RPMs: '. |
$table.="</table>"; |
$checkrpms{'rpmcount'}; |
print $table; |
$host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'}; |
print "</body></html>"; |
} |
|
} |
|
# -- Check connections |
|
&statuslist($local,'Connections'); |
|
$host{$local.'_notconnected'}=''; |
|
$host{$local.'_notconnected_doomed'}=0; |
|
foreach $remote (sort keys %hostname) { |
|
my $status=&connected($local,$remote); |
|
$connectionstatus{$local.'_TO_'.$remote}=$status; |
|
unless (($status eq 'ok') || ($status eq 'not_yet')) { |
|
$host{$local.'_notconnected'}.=' '.$remote; |
|
$host{$local.'_notconnected_doomed'}++; |
|
} |
|
} |
|
# Eventually, use doomed count |
|
&serverstatus($local); |
|
} |
|
|
|
# =============================================================== End Mail Loop |
|
print "</form><script>"; |
|
$runtime=time-$starttime; |
|
if ($runtime>=$refresh) { |
|
print 'document.status.submit();'; |
|
} else { |
|
$refreshtime=int(1000*($refresh-$runtime)); |
|
print "setTimeout('document.status.submit()',$refreshtime);"; |
|
} |
|
print "</script></body></html>"; |
|
exit 0; |