version 1.15, 2003/08/05 12:52:23
|
version 1.24, 2005/04/13 18:30:46
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
$|=1; |
$|=1; |
# The LearningOnline Network with CAPA |
# Generates a html page showing various sataus reports about the cluster |
# Cluster Status |
|
# |
|
# $Id$ |
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use strict; |
|
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Headers; |
use HTTP::Headers; |
Line 20 my %perlvar=();
|
Line 42 my %perlvar=();
|
|
|
my $mode; |
my $mode; |
my $concount=0; |
my $concount=0; |
|
my $fromcache; |
|
|
|
my %domaindescription = (); |
|
my %domain_auth_def = (); |
|
my %domain_auth_arg_def = (); |
|
my %domain_lang_def=(); |
|
my %domain_city=(); |
|
my %domain_longi=(); |
|
my %domain_lati=(); |
|
|
|
my %hostname=(); |
|
my %hostip=(); |
|
my %hostdom=(); |
|
my %hostrole=(); |
|
my %libserv=(); |
|
|
|
my $maxusers=0; |
|
my $maxload=0; |
|
my $totalusers=0; |
|
|
|
my %FORM=(); |
|
|
|
my $stat_total=0; |
|
my $stat_notyet=0; |
|
my $stat_fromcache=0; |
|
|
sub select_form { |
sub select_form { |
my ($def,$name,%hash) = @_; |
my ($def,$name,%hash) = @_; |
Line 51 sub request {
|
Line 98 sub request {
|
$cachetime*=(0.5+rand); |
$cachetime*=(0.5+rand); |
my $key=&key($local,$url); |
my $key=&key($local,$url); |
my $reply=''; |
my $reply=''; |
|
$stat_total++; |
|
# if fromcache flag is set, only return cached values |
|
if ($fromcache) { |
|
if ($FORM{$key.'_time'}) { |
|
return $FORM{$key}; |
|
$stat_fromcache++; |
|
} else { |
|
return 'not_yet'; |
|
$stat_notyet++; |
|
} |
|
} |
|
# normal mode, refresh when expired or not yet present |
if ($FORM{$key.'_time'}) { |
if ($FORM{$key.'_time'}) { |
if ((time-$FORM{$key.'_time'})<$cachetime) { |
if ((time-$FORM{$key.'_time'})<$cachetime) { |
$reply=$FORM{$key}; |
$reply=$FORM{$key}; |
&hidden($key.'_time',$FORM{$key.'_time'}); |
&hidden($key.'_time',$FORM{$key.'_time'}); |
&hidden($key.'_fromcache',1); |
$stat_fromcache++; |
} |
} |
} |
} |
unless ($reply) { |
unless ($reply) { |
Line 97 sub connected {
|
Line 156 sub connected {
|
# but always do the first five. |
# but always do the first five. |
# |
# |
unless ($FORM{&key($local,$url)}) { |
unless ($FORM{&key($local,$url)}) { |
unless (($concount<=5) || (rand>0.95)) { |
unless (($concount<=5) || (rand>0.95)) { |
|
$stat_total++; |
|
$stat_notyet++; |
return 'not_yet'; |
return 'not_yet'; |
} else { |
} else { |
$concount++; |
$concount++; |
Line 176 sub server {
|
Line 237 sub server {
|
print &otherwindow($local,'/server-status','Server Status'); |
print &otherwindow($local,'/server-status','Server Status'); |
} |
} |
|
|
|
sub announcement { |
|
my $local=shift; |
|
print &otherwindow($local,'/announcement.txt','Announcement'); |
|
} |
|
|
|
sub takeonline { |
|
my $local=shift; |
|
print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online'); |
|
} |
|
|
|
sub takeoffline { |
|
my $local=shift; |
|
print &otherwindow($local,'/cgi-bin/takeoffline.pl','Take offline'); |
|
} |
|
|
|
sub reroute { |
|
my ($local,$remote)=@_; |
|
print &otherwindow($local,'/cgi-bin/takeoffline.pl?'. |
|
$hostname{$remote}.'&'.$hostdom{$local} |
|
,$remote)."\n"; |
|
} |
|
|
|
sub allreroutes { |
|
my $local=shift; |
|
&takeoffline($local); |
|
print ' Reroute to: <font size="1">'; |
|
foreach my $remote (sort keys %hostname) { |
|
unless ($local eq $remote) { |
|
&reroute($local,$remote); |
|
} |
|
} |
|
print '</font>'; |
|
} |
|
|
# ========================================================= Produce a green bar |
# ========================================================= Produce a green bar |
sub bar { |
sub bar { |
my $parm=shift; |
my $parm=shift; |
Line 197 sub serverstatus {
|
Line 292 sub serverstatus {
|
<tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b> |
<tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b> |
$local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt> |
$local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt> |
<br />$domaindescription{$hostdom{$local}} |
<br />$domaindescription{$hostdom{$local}} |
|
$domain_city{$hostdom{$local}} |
</font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522"> |
</font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522"> |
ENDHEADER |
ENDHEADER |
&login($local);&server($local);&users($local);&versions($local); |
&login($local);&server($local);&users($local);&versions($local); |
|
&announcement($local); |
&loncron($local);&lond($local);&lonc($local);&runloncron($local); |
&loncron($local);&lond($local);&lonc($local);&runloncron($local); |
print "</font></td></tr>"; |
print "</font></td></tr>"; |
if ($trouble) { |
if ($trouble) { |
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'>"; |
|
# re-routing |
|
if ($host{$local.'_reroute'}) { |
|
print "<br />Reroute: ".$host{$local.'_reroute'}; |
|
&takeonline($local); |
|
} |
# version |
# version |
if ($host{$local.'_version'}) { |
if ($host{$local.'_version'}) { |
print "<br />Version: ".$host{$local.'_version'} |
print "<br />Version: ".$host{$local.'_version'} |
Line 240 ENDHEADER
|
Line 342 ENDHEADER
|
if ($host{$local.'_errors'}) { |
if ($host{$local.'_errors'}) { |
print "<br />loncron errors: ".$host{$local.'_errors'}; |
print "<br />loncron errors: ".$host{$local.'_errors'}; |
} |
} |
|
print "</td></tr><tr><td bgcolor='#DDDDDD'>"; |
|
&allreroutes($local); |
print "</td></tr></table><br />"; |
print "</td></tr></table><br />"; |
} |
} |
|
|
Line 260 sub doomedness {
|
Line 364 sub doomedness {
|
return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts; |
return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts; |
} |
} |
|
|
# ====================================================================== Status |
sub resetvars { |
sub statuslist { |
$maxusers=0; |
my ($local,$what)=@_; |
$maxload=0; |
print |
$totalusers=0; |
"<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n"; |
$stat_total=0; |
|
$stat_notyet=0; |
|
$stat_fromcache=0; |
|
$concount=0; |
|
undef %host; |
|
%host=(); |
} |
} |
|
|
# |
sub mainloop { |
# Main program |
&resetvars(); |
# |
|
# ========================================================= 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'}:120); |
|
if ($refresh<30) { $refresh=30; } |
|
my $starttime=time; |
|
|
|
# ============================================================== Determine mode |
|
|
|
my %modes=('trouble' => 'Trouble', |
|
'users_doomed' => 'Doomed: Users', |
|
'loncron_doomed' => 'Doomed: General (loncron)', |
|
'mysql_doomed' => 'Doomed: Database (mysql)', |
|
'notconnected_doomed' => 'Doomed: Connections', |
|
'checkrpms_doomed' => 'Doomed: RPMs', |
|
'load_doomed' => 'Doomed: Load', |
|
'unresponsive_doomed' => 'Doomed: Status could not be determined', |
|
'users' => 'User Report', |
|
'load' => 'Load Report', |
|
'connections' => 'Connections Matrix'); |
|
|
|
$mode=$FORM{'mode'}; |
|
unless ($modes{$mode}) { $mode='trouble'; } |
|
# ================================================================ Send Headers |
|
print "Content-type: text/html\n\n". |
|
"<html><body bgcolor='#FFFFFF'>\n"; |
|
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
|
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
%perlvar=%{$perlvarref}; |
|
undef $perlvarref; # remove since sensitive and not needed |
|
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
|
delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
|
|
|
# ------------------------------------------------------------- Read hosts file |
|
{ |
|
my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
|
|
|
$total=0; |
|
while (my $configline=<$config>) { |
|
$configline=~s/#.*$//; |
|
unless ($configline=~/\w/) { next; } |
|
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
|
$hostname{$id}=$name; |
|
$hostdom{$id}=$domain; |
|
$hostrole{$id}=$role; |
|
$hostip{$id}=$ip; |
|
$total++; |
|
if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { |
|
$libserv{$id}=$name; |
|
} |
|
} |
|
} |
|
# ------------------------------------------------------------ Read domain file |
|
{ |
|
my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab'); |
|
%domaindescription = (); |
|
%domain_auth_def = (); |
|
%domain_auth_arg_def = (); |
|
if ($fh) { |
|
while (<$fh>) { |
|
next if (/^(\#|\s*$)/); |
|
chomp; |
|
my ($domain, $domain_description, $def_auth, $def_auth_arg) |
|
= split(/:/,$_,4); |
|
$domain_auth_def{$domain}=$def_auth; |
|
$domain_auth_arg_def{$domain}=$def_auth_arg; |
|
$domaindescription{$domain}=$domain_description; |
|
} |
|
} |
|
} |
|
|
|
print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>"; |
|
print "<form name='prgstat'>\n". |
|
"<input type='text' name='progress' value='Starting ...' size='100' /><br />". |
|
"</form>\n";; |
|
print "<form name='status' method='post'>\n"; |
|
print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />'; |
|
&hidden('refresh',$refresh); |
|
|
|
# ==================================================== Main Loop over all Hosts |
# ==================================================== Main Loop over all Hosts |
|
|
my $maxusers=0; |
foreach my $local (sort keys %hostname) { |
my $maxload=0; |
|
my $totalusers=0; |
|
|
|
foreach $local (sort keys %hostname) { |
|
$host{$local.'_unresponsive_doomed'}=0; |
$host{$local.'_unresponsive_doomed'}=0; |
# -- Check general status |
# -- Check general status |
&statuslist($local,'General'); |
&statuslist($local,'General'); |
Line 427 foreach $local (sort keys %hostname) {
|
Line 429 foreach $local (sort keys %hostname) {
|
} |
} |
$host{$local.'_load'}=$userstatus{'loadavg'}; |
$host{$local.'_load'}=$userstatus{'loadavg'}; |
} |
} |
|
# -- Check reroute status |
|
&statuslist($local,'Reroute'); |
|
my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800); |
|
if ($reroute{'status'} eq 'rerouting') { |
|
if ($reroute{'server'}) { |
|
$host{$local.'_reroute'}= |
|
'Rerouting to <tt>'.$reroute{'server'}. |
|
'</tt>, domain: '.$reroute{'domain'}. |
|
' (since '.localtime($reroute{'time'}).')'; |
|
} else { |
|
$host{$local.'_reroute'}='offline'; |
|
} |
|
} |
# -- Check mysql status |
# -- Check mysql status |
&statuslist($local,'Database'); |
&statuslist($local,'Database'); |
my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600); |
my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600); |
Line 472 foreach $local (sort keys %hostname) {
|
Line 487 foreach $local (sort keys %hostname) {
|
&statuslist($local,'Connections'); |
&statuslist($local,'Connections'); |
$host{$local.'_notconnected'}=''; |
$host{$local.'_notconnected'}=''; |
$host{$local.'_notconnected_doomed'}=0; |
$host{$local.'_notconnected_doomed'}=0; |
foreach $remote (sort keys %hostname) { |
foreach my $remote (sort keys %hostname) { |
my $status=&connected($local,$remote); |
my $status=&connected($local,$remote); |
$connectionstatus{$local.'_TO_'.$remote}=$status; |
$connectionstatus{$local.'_TO_'.$remote}=$status; |
unless (($status eq 'ok') || ($status eq 'not_yet')) { |
unless (($status eq 'ok') || ($status eq 'not_yet')) { |
Line 480 foreach $local (sort keys %hostname) {
|
Line 495 foreach $local (sort keys %hostname) {
|
$host{$local.'_notconnected_doomed'}++; |
$host{$local.'_notconnected_doomed'}++; |
} |
} |
} |
} |
# =============================================================== End Mail Loop |
# =============================================================== End Main Loop |
} |
} |
&statuslist('Done.'); |
|
|
} |
|
|
|
sub reports { |
# ====================================================================== Output |
# ====================================================================== Output |
if ($mode=~/\_doomed$/) { |
if ($mode=~/\_doomed$/) { |
# Output by doomedness |
# Output by doomedness |
Line 494 foreach $local (sort keys %hostname) {
|
Line 512 foreach $local (sort keys %hostname) {
|
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>". |
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>". |
"<tr><td bgcolor='#225522'> </td>"; |
"<tr><td bgcolor='#225522'> </td>"; |
foreach my $remote (sort keys %hostname) { |
foreach my $remote (sort keys %hostname) { |
print '<th bgcolor="#DDDDBB">'.$remote.'</th>'; |
print '<td bgcolor="#DDDDBB">'.$remote.'</td>'; |
} |
} |
print "</tr>\n"; |
print "</tr>\n"; |
# connection matrix |
# connection matrix |
foreach my $local (sort keys %hostname) { |
foreach my $local (sort keys %hostname) { |
print '<tr><th bgcolor="#DDDDBB">'.$local.'</th>'; |
print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>'; |
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') { |
my $cellcolor='#FFFFFF'; |
my $cellcolor='#FFFFFF'; |
Line 511 foreach $local (sort keys %hostname) {
|
Line 529 foreach $local (sort keys %hostname) {
|
print |
print |
'<td bgcolor="'.$cellcolor.'"><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'; |
my $cellcolor='#DDCCAA'; |
if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') { |
if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') { |
if ($local eq $remote) { |
if ($local eq $remote) { |
$cellcolor='#DD88AA'; |
$cellcolor='#DD88AA'; |
Line 519 foreach $local (sort keys %hostname) {
|
Line 537 foreach $local (sort keys %hostname) {
|
$cellcolor='#DDAACC'; |
$cellcolor='#DDAACC'; |
} |
} |
} else { |
} else { |
if ($local eq $remote) { $cellcolor='#DD9999'; } |
if ($local eq $remote) { $cellcolor='#DDBB77'; } |
} |
} |
print |
print |
'<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'. |
'<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'. |
Line 538 foreach $local (sort keys %hostname) {
|
Line 556 foreach $local (sort keys %hostname) {
|
print "<h3>Total active user(s): $totalusers</h3>". |
print "<h3>Total active user(s): $totalusers</h3>". |
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>"; |
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>"; |
|
|
foreach $local (sort keys %hostname) { |
foreach my $local (sort keys %hostname) { |
if (defined($host{$local.'_users'})) { |
if (defined($host{$local.'_users'})) { |
print |
print |
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local. |
'<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local. |
'</font></th><td bgcolor="#DDDDBB">'; |
'</font><br /><font size="-2">'. |
|
$domaindescription{$hostdom{$local}}. |
|
'</font></td><td bgcolor="#DDDDBB">'; |
&users($local); |
&users($local); |
print |
print |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
Line 561 foreach $local (sort keys %hostname) {
|
Line 581 foreach $local (sort keys %hostname) {
|
my $factor=50/$maxload; |
my $factor=50/$maxload; |
print |
print |
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>"; |
"<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>"; |
foreach $local (sort keys %hostname) { |
foreach my $local (sort keys %hostname) { |
if (defined($host{$local.'_load_doomed'})) { |
if (defined($host{$local.'_load_doomed'})) { |
print |
print |
'<tr><th bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'. |
'<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'. |
$local. |
$local. |
'</font></th><td bgcolor="#DDDDBB">'; |
'</font><br /><font size="-2">'. |
|
$domaindescription{$hostdom{$local}}. |
|
'</font></td><td bgcolor="#DDDDBB">'; |
&server($local); |
&server($local); |
print |
print |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
'</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'. |
Line 581 foreach $local (sort keys %hostname) {
|
Line 603 foreach $local (sort keys %hostname) {
|
} |
} |
} elsif ($mode eq 'trouble') { |
} elsif ($mode eq 'trouble') { |
my $count=0; |
my $count=0; |
foreach $local (sort keys %hostname) { |
foreach my $local (sort keys %hostname) { |
my $trouble=''; |
my $trouble=''; |
if ($host{$local.'_unresponsive_doomed'}>3) { |
if ($host{$local.'_unresponsive_doomed'}>3) { |
$trouble='Does not respond to several queries.<br />'; |
$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'}>2500) { |
$trouble='High loncron count.<br />'; |
$trouble='High loncron count.<br />'; |
} |
} |
if ($host{$local.'_load_doomed'}>5) { |
if ($host{$local.'_load_doomed'}>5) { |
Line 603 foreach $local (sort keys %hostname) {
|
Line 625 foreach $local (sort keys %hostname) {
|
if ($host{$local.'_checkrpms_doomed'}>100) { |
if ($host{$local.'_checkrpms_doomed'}>100) { |
$trouble='RPMs outdated.<br />'; |
$trouble='RPMs outdated.<br />'; |
} |
} |
|
if ($host{$local.'_reroute'}) { |
|
$trouble='Rerouting<br >'; |
|
} |
if ($trouble) { $count++; &serverstatus($local,$trouble); } |
if ($trouble) { $count++; &serverstatus($local,$trouble); } |
} |
} |
unless ($count) { print "No mayor trouble."; } |
unless ($count) { print "No mayor trouble."; } |
} |
} |
|
} |
|
|
|
# ====================================================================== Status |
|
sub statuslist { |
|
my ($local,$what)=@_; |
|
print |
|
"<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'}:30); |
|
if ($refresh<30) { $refresh=30; } |
|
my $starttime=time; |
|
|
|
# ============================================================== Determine mode |
|
|
|
my %modes=('trouble' => 'Trouble', |
|
'users_doomed' => 'Doomed: Users', |
|
'loncron_doomed' => 'Doomed: General (loncron)', |
|
'mysql_doomed' => 'Doomed: Database (mysql)', |
|
'notconnected_doomed' => 'Doomed: Connections', |
|
'checkrpms_doomed' => 'Doomed: RPMs', |
|
'load_doomed' => 'Doomed: Load', |
|
'unresponsive_doomed' => 'Doomed: Status could not be determined', |
|
'users' => 'User Report', |
|
'load' => 'Load Report', |
|
'connections' => 'Connections Matrix'); |
|
|
|
$mode=$FORM{'mode'}; |
|
unless ($modes{$mode}) { $mode='trouble'; } |
|
# ================================================================ Send Headers |
|
print "Content-type: text/html\n\n". |
|
"<html><body bgcolor='#FFFFFF'>\n"; |
|
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). |
|
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
%perlvar=%{$perlvarref}; |
|
undef $perlvarref; # remove since sensitive and not needed |
|
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
|
delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
|
|
|
# ------------------------------------------------------------- Read hosts file |
|
{ |
|
my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
|
|
|
while (my $configline=<$config>) { |
|
$configline=~s/#.*$//; |
|
unless ($configline=~/\w/) { next; } |
|
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
|
$hostname{$id}=$name; |
|
$hostdom{$id}=$domain; |
|
$hostrole{$id}=$role; |
|
$hostip{$id}=$ip; |
|
if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { |
|
$libserv{$id}=$name; |
|
} |
|
} |
|
} |
|
# ------------------------------------------------------------ Read domain file |
|
{ |
|
my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab'); |
|
if ($fh) { |
|
while (<$fh>) { |
|
next if (/^(\#|\s*$)/); |
|
chomp; |
|
my ($domain, $domain_description, $def_auth, $def_auth_arg, |
|
$def_lang, $city, $longi, $lati) = split(/:/,$_); |
|
$domain_auth_def{$domain}=$def_auth; |
|
$domain_auth_arg_def{$domain}=$def_auth_arg; |
|
$domaindescription{$domain}=$domain_description; |
|
$domain_lang_def{$domain}=$def_lang; |
|
$domain_city{$domain}=$city; |
|
$domain_longi{$domain}=$longi; |
|
$domain_lati{$domain}=$lati; |
|
} |
|
} |
|
} |
|
|
|
print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>"; |
|
print "<form name='prgstat'>\n". |
|
"<input type='text' name='progress' value='Starting ...' size='100' /><br />". |
|
"</form>\n";; |
|
print "<form name='status' method='post'>\n"; |
|
print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />'; |
|
&hidden('refresh',$refresh); |
|
|
|
if (!$FORM{'runonetime'}) { |
|
print |
|
"<h3>Gathering initial cluster data</h3>This may take some time ...<br />"; |
|
$fromcache=0; |
|
&mainloop(); |
|
&statuslist('Done initial run.'); |
|
&reports(); |
|
} else { |
|
$fromcache=1; |
|
&mainloop(); |
|
&statuslist('Done gathering cached data'); |
|
&reports(); |
|
$fromcache=0; |
|
&mainloop(); |
|
} |
|
&hidden('runonetime',1); |
|
print '<tt><br />Total number of queries: '.$stat_total. |
|
'<br />Percent complete: '. |
|
int(($stat_total-$stat_notyet)/$stat_total*100.). |
|
'<br />Percent from cache: '. |
|
int($stat_fromcache/$stat_total*100.).'</tt>'; |
|
|
# ============================================================== Close, refresh |
# ============================================================== Close, refresh |
print "</form><script>"; |
print "</form><script>"; |
$runtime=time-$starttime; |
my $runtime=time-$starttime; |
if (($refresh-$runtime)<30) { |
if (($refresh-$runtime)<0) { |
print "setTimeout('document.status.submit()',30000);\n". |
print "document.status.submit();"; |
"document.prgstat.progress.value='Will automatically refresh.'"; |
|
} else { |
} else { |
$refreshtime=int(1000*($refresh-$runtime)); |
my $refreshtime=int(1000*($refresh-$runtime)); |
print "setTimeout('document.status.submit()',$refreshtime);\n". |
print "setTimeout('document.status.submit()',$refreshtime);\n". |
"document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'"; |
"document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'"; |
} |
} |