File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.26: download - view: text, annotated - select for diffs
Thu Dec 25 01:56:03 2008 UTC (15 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_7_99_1, version_2_7_99_0, HEAD
- Changes resulting from movement of subroutines from loncgi.pm
  to lonauthcgi.pm.

    1: #!/usr/bin/perl
    2: $|=1;
    3: # Generates a html page showing various status reports about the domain or cluster
    4: # $Id: clusterstatus.pl,v 1.26 2008/12/25 01:56:03 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: 
   29: use strict;
   30: 
   31: use lib '/home/httpd/lib/perl/';
   32: use Apache::lonnet;
   33: use Apache::lonlocal;
   34: use LONCAPA::Configuration;
   35: use LONCAPA::loncgi;
   36: use LONCAPA::lonauthcgi;
   37: use LWP::UserAgent();
   38: use HTTP::Headers;
   39: use IO::File;
   40: 
   41: my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
   42: 
   43: my %host=();
   44: my $oneday=60*60*24;
   45: 
   46: my %connectionstatus=();
   47: my %perlvar=();
   48: 
   49: my $mode;
   50: my $concount=0;
   51: my $fromcache;
   52: 
   53: my %domaininfo = &Apache::lonnet::domain_info();
   54: my %allhostname = &Apache::lonnet::all_hostnames();
   55: my (%hostname,%hostip);
   56: my %hostdom = &Apache::lonnet::all_host_domain();
   57: my %iphost = &Apache::lonnet::get_iphost();
   58: my %libserv= &Apache::lonnet::all_library();
   59: 
   60: foreach my $ip (keys(%iphost)) {
   61:     $hostip{$iphost{$ip}} = $ip;
   62: }
   63: 
   64: my $maxusers=0;
   65: my $maxload=0;
   66: my $totalusers=0;
   67: 
   68: my %FORM=();
   69: 
   70: my $stat_total=0;
   71: my $stat_notyet=0;
   72: my $stat_fromcache=0;
   73: 
   74: sub select_form {
   75:     my ($def,$name,%hash) = @_;
   76:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
   77:     foreach my $key (sort(keys(%hash))) {
   78:         $selectform.="<option value=\"$key\" ".
   79:             ($key eq $def? 'selected' : '').
   80:                 ">".$hash{$key}."</option>\n";
   81:     }
   82:     $selectform.="</select>";
   83:     return $selectform;
   84: }
   85: 
   86: 
   87: sub key {
   88:     my ($local,$url)=@_;
   89:     my $key=$local.'_'.$url;
   90:     $key=~s/\W/\_/gs;
   91:     return $key;
   92: }
   93: 
   94: sub hidden {
   95:     my ($name,$value)=@_;
   96:     print("\n<input type='hidden' name='$name' value='$value' />");
   97: }
   98: 
   99: sub request {
  100:     my ($local,$url,$cachetime)=@_;
  101:     $cachetime*=(0.5+rand);
  102:     my $key=&key($local,$url);
  103:     my $reply='';
  104:     $stat_total++;
  105: # if fromcache flag is set, only return cached values
  106:     if ($fromcache) {
  107: 	if ($FORM{$key.'_time'}) {
  108:             $stat_fromcache++;
  109: 	    return $FORM{$key};
  110: 	} else {
  111:             $stat_notyet++;
  112: 	    return 'not_yet';
  113: 	}
  114:     }
  115: # normal mode, refresh when expired or not yet present
  116:     if ($FORM{$key.'_time'}) {
  117: 	if ((time-$FORM{$key.'_time'})<$cachetime) {
  118: 	    $reply=$FORM{$key};
  119: 	    &hidden($key.'_time',$FORM{$key.'_time'});
  120: 	    $stat_fromcache++;
  121: 	}
  122:     }
  123:     unless ($reply) {
  124:         if ($hostname{$local}) {
  125: 	    my $ua=new LWP::UserAgent(timeout => 20);
  126: 	    my $request=new HTTP::Request('GET',
  127: 					  "http://".$hostname{$local}.$url);
  128: 	    my $response=$ua->request($request);
  129: 	    if ($response->is_success) {
  130:                 $reply=$response->content;
  131:                 chomp($reply);
  132:             } else {
  133: 		$reply='local_error'; 
  134: 	    }
  135: 	} else {
  136:             $reply='local_unknown';
  137:         }
  138: 	&hidden($key.'_time',time);
  139:     }
  140:     &hidden($key,$reply);
  141:     return $reply;
  142: }
  143: 
  144: # ============================================= Are local and remote connected?
  145: sub connected {
  146:     my ($local,$remote)=@_;
  147:     $local=~s/\W//g;
  148:     $remote=~s/\W//g;
  149: 
  150:     unless ($hostname{$remote}) { return 'remote_unknown'; }
  151:     my $url='/cgi-bin/ping.pl?'.$remote;
  152: #
  153: # Slowly phase this in: if not cached, only do 5 percent of the cases,
  154: # but always do the first five. 
  155: #
  156:     unless ($FORM{&key($local,$url)}) {
  157: 	unless (($concount<=5) || (rand>0.95)) {
  158: 	    $stat_total++;
  159: 	    $stat_notyet++; 
  160: 	    return 'not_yet'; 
  161: 	} else {
  162: 	    $concount++;
  163: 	}
  164:     }
  165: #
  166: # Actually do the query
  167: #
  168:     &statuslist($local,'connecting '.$remote);
  169:     my $reply=&request($local,$url,3600);
  170:     $reply=(split("\n",$reply))[0];
  171:     $reply=~s/\W//g;
  172:     if ($reply ne $remote) { return $reply; }
  173:     return 'ok';
  174: }
  175: # ============================================================ Get a reply hash
  176: 
  177: sub replyhash {
  178:     my %returnhash=();
  179:     foreach (split(/\&/,&request(@_))) {
  180: 	my ($name,$value)=split(/\=/,$_);
  181: 	if ($name) {
  182: 	    unless ($value) { $value=''; }
  183: 	    $returnhash{$name}=$value;
  184: 	}
  185:     }
  186:     return %returnhash;
  187: }
  188: 
  189: # ================================================================ Link to host
  190: 
  191: sub otherwindow {
  192:     my ($local,$url,$label)=@_;
  193:     return
  194:   " <a href='http://$hostname{$local}$url' target='newwin$local'>$label</a> ";
  195: }
  196: 
  197: sub login {
  198:     my $local=shift;
  199:     print(&otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
  200: 		       'Login'));
  201: }
  202: 
  203: sub runloncron {
  204:     my $local=shift;
  205:     print(&otherwindow($local,'/cgi-bin/loncron.pl',&Apache::lonlocal::mt('Run loncron')));
  206: }
  207: 
  208: sub loncron {
  209:     my $local=shift;
  210:     print(&otherwindow($local,'/lon-status','loncron'));
  211: }
  212: 
  213: sub lonc {
  214:     my $local=shift;
  215:     print(&otherwindow($local,'/lon-status/loncstatus.txt','lonc'));
  216: }
  217: 
  218: sub lond {
  219:     my $local=shift;
  220:     print(&otherwindow($local,'/lon-status/londstatus.txt','lond'));
  221: }
  222: 
  223: sub users {
  224:     my $local=shift;
  225:     print(&otherwindow($local,'/cgi-bin/userstatus.pl',&Apache::lonlocal::mt('Users')));
  226: }
  227: 
  228: sub versions {
  229:     my $local=shift;
  230:     print(&otherwindow($local,'/cgi-bin/lonversions.pl',&Apache::lonlocal::mt('Versions')));
  231: }
  232: 
  233: sub server {
  234:     my $local=shift;
  235:     print(&otherwindow($local,'/server-status',&Apache::lonlocal::mt('Server Status')));
  236: }
  237: 
  238: sub announcement {
  239:     my $local=shift;
  240:     print(&otherwindow($local,'/announcement.txt',&Apache::lonlocal::mt('Announcement')));
  241: }
  242: 
  243: sub takeonline {
  244:     my $local=shift;
  245:     print(&otherwindow($local,'/cgi-bin/takeonline.pl',&Apache::lonlocal::mt('Take online')));
  246: }
  247: 
  248: sub takeoffline {
  249:     my $local=shift;
  250:     print(&otherwindow($local,'/cgi-bin/takeoffline.pl',&Apache::lonlocal::mt('Take offline')));
  251: }
  252: 
  253: sub reroute {
  254:     my ($local,$remote)=@_;
  255:     print(&otherwindow($local,'/cgi-bin/takeoffline.pl?'.
  256: 		       $hostname{$remote}.'&'.$hostdom{$local}
  257: 		       ,$remote)."\n");
  258: }
  259: 
  260: sub allreroutes {
  261:     my $local=shift;
  262:     &takeoffline($local);
  263:     print(&Apache::lonlocal::mt('Reroute to:').' <font size="1">');
  264:     foreach my $remote (sort keys %hostname) {
  265: 	unless ($local eq $remote) {
  266: 	    &reroute($local,$remote);
  267: 	}
  268:     }
  269:     print('</font>');
  270: }
  271: 
  272: # ========================================================= Produce a green bar
  273: sub bar {
  274:     my $parm=shift;
  275:     my $number=int($parm+0.5);
  276:     print('<table><tr><td bgcolor="#225522"><font color="#225522">');
  277:     for (my $i=0;$i<$number;$i++) {
  278: 	print "+";
  279:     }
  280:     print("</font></table>");
  281: }
  282: 
  283: # ========================================================== Show server status
  284: 
  285: sub serverstatus {
  286:     my ($local,$trouble)=@_;
  287:     my $hostrole;
  288:     if (exists($libserv{$local})) {
  289:         $hostrole = 'library';
  290:     } else {
  291:         $hostrole = 'access';
  292:     }
  293:     my %lt = &Apache::lonlocal::texthash(
  294:                                           rero => 'Reroute:',
  295:                                           vers => 'Version:',
  296:                                           load => 'Load:',
  297:                                           acti => 'Active Users:',
  298:                                           rpms => 'RPMs',
  299:                                           mysq => 'MySQL Database:',
  300:                                           notc => 'Not connected',
  301:                                           lonc => 'loncron errors',
  302:                                          );
  303:    
  304:     print(<<ENDHEADER);
  305: <a name="$local" />
  306: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
  307: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
  308: $local $hostdom{$local}</b> <tt>($hostname{$local}); $hostrole</tt>
  309: <br />$domaininfo{$hostdom{$local}}{'description'}
  310: $domaininfo{$hostdom{$local}}{'city'}
  311: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
  312: ENDHEADER
  313:     &login($local);&server($local);&users($local);&versions($local);
  314:     &announcement($local);
  315:     &loncron($local);&lond($local);&lonc($local);&runloncron($local);
  316:     print("</font></td></tr>");
  317:     if ($trouble) {
  318: 	print("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
  319:     }
  320:     print("<tr><td bgcolor='#BBBBBB'>");
  321: # re-routing
  322:     if ($host{$local.'_reroute'}) {
  323: 	print('<br />'.$lt{'rero'}.' '.$host{$local.'_reroute'});
  324: 	&takeonline($local);
  325:     }
  326: # version
  327:     if ($host{$local.'_version'}) {
  328: 	print('<br />'.$lt{'vers'}.' '.$host{$local.'_version'});
  329:     }
  330: # load
  331:     if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
  332: 	print('<br />'.$lt{'load'}.' '.$host{$local.'_load'});
  333:     }
  334: # users
  335:     if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
  336: 	print('<br />'.$lt{'acti'}.' '.$host{$local.'_users'});
  337:     }
  338: 
  339: # checkrpms
  340:     if ($host{$local.'_checkrpms'}) {
  341: 	print('<br />'.$lt{'rpms'}.' '.$host{$local.'_checkrpms'});
  342:     }
  343: # mysql
  344:     if ($host{$local.'_mysql'}) {
  345: 	print('<br />'.$lt{'mysq'}.' '.$host{$local.'_mysql'});
  346:     }
  347: # connections
  348:     if ($host{$local.'_notconnected'}) {
  349: 	print('<br />'.$lt{'notc'}.' ');
  350: 	foreach my $item (split(/ /,$host{$local.'_notconnected'})) {
  351: 	    if ($item) {
  352: 		print(' <a href="#$item">'.$item.'</a>');
  353: 	    }
  354: 	}
  355:     }
  356: # errors
  357:     if ($host{$local.'_errors'}) {
  358: 	print('<br />'.$lt{'lonc'}.' '.$host{$local.'_errors'});
  359:     }
  360:     print "</td></tr><tr><td bgcolor='#DDDDDD'>";
  361:     &allreroutes($local);
  362:     print "</td></tr></table><br />";
  363: }
  364: 
  365: # =========================================================== Doomedness sorted
  366: 
  367: sub doomedness {
  368:     my $crit=shift;
  369:     my %alldoomed=();
  370:     my @allhosts=();
  371:     foreach (keys %host) {
  372: 	if ($_=~/^(\w+)\_$crit$/) {
  373: 	    if ($host{$_}) {
  374: 		push (@allhosts,$1);
  375: 		$alldoomed{$1}=$host{$_};
  376: 	    }
  377: 	}
  378:     }
  379:     return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
  380: }
  381: 
  382: sub resetvars {
  383:    $maxusers=0;
  384:    $maxload=0;
  385:    $totalusers=0;
  386:    $stat_total=0;
  387:    $stat_notyet=0;
  388:    $stat_fromcache=0;
  389:    $concount=0;
  390:    undef %host;
  391:    %host=();
  392: }
  393: 
  394: sub mainloop {
  395:     &resetvars();
  396: # ==================================================== Main Loop over all Hosts
  397: 
  398: foreach my $local (sort(keys(%hostname))) {
  399:     $host{$local.'_unresponsive_doomed'}=0;
  400: # -- Check general status
  401:     &statuslist($local,'General');
  402:     my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
  403:     if (defined($loncron{'local_error'})) {
  404: 	$host{$local.'_loncron'}='Could not determine.';
  405: 	$host{$local.'_unresponsive_doomed'}++;
  406:     } else {
  407: 	if ((time-$loncron{'time'})>$oneday) {
  408: 	    $host{$local.'_loncron'}='Stale.';
  409: 	    $host{$local.'_unresponsive_doomed'}++;
  410: 	} else {
  411: 	    $host{$local.'_loncron_doomed'}=$loncron{'notices'}
  412: 	                                 +4*$loncron{'warnings'}
  413: 	                               +100*$loncron{'errors'};
  414: 	    $host{$local.'_errors'}=$loncron{'errors'};
  415: 	}
  416:     }
  417: # -- Check version
  418:     &statuslist($local,'Version');
  419:     my $version=&request($local,'/lon-status/version.txt',7200);
  420:     if ($version eq 'local_error') {
  421: 	$host{$local.'_version'}='Could not determine.';
  422: 	$host{$local.'_unresponsive_doomed'}++;
  423:     } else {
  424: 	$host{$local.'_version'}=$version;
  425:     }
  426: # -- Check user status
  427:     &statuslist($local,'Users');
  428:     my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
  429:     if (defined($userstatus{'local_error'})) {
  430: 	$host{$local.'_userstatus'}='Could not determine.';
  431: 	$host{$local.'_unresponsive_doomed'}++;
  432:     } else {
  433: 	$host{$local.'_users_doomed'}=$userstatus{'Active'};
  434: 	$host{$local.'_users'}=$userstatus{'Active'};
  435: 	unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
  436: 	if ($host{$local.'_users'}>$maxusers) { 
  437: 	    $maxusers=$host{$local.'_users'};
  438: 	}
  439: 	$totalusers+=$host{$local.'_users'};
  440: 	my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
  441: 	$host{$local.'_load_doomed'}=$mload;
  442: 	if ($mload>$maxload) { 
  443: 	    $maxload=$mload;
  444: 	}
  445: 	$host{$local.'_load'}=$userstatus{'loadavg'};
  446:     }
  447: # -- Check reroute status
  448:     &statuslist($local,'Reroute');
  449:     my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800);
  450:     if ($reroute{'status'} eq 'rerouting') {
  451: 	if ($reroute{'server'}) {
  452: 	    $host{$local.'_reroute'}=
  453: 		'Rerouting to <tt>'.$reroute{'server'}.
  454:                    '</tt>, domain: '.$reroute{'domain'}.
  455: 		 ' (since '.localtime($reroute{'time'}).')';
  456: 	} else {
  457: 	    $host{$local.'_reroute'}='offline';
  458: 	}
  459:     }
  460: # -- Check mysql status
  461:     &statuslist($local,'Database');
  462:     my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
  463:     if (defined($mysql{'local_error'})) {
  464: 	$host{$local.'_mysql'}='Could not determine.';
  465: 	$host{$local.'_unresponsive_doomed'}++;
  466:     } else {
  467: 	if ((time-$mysql{'time'})>(7*$oneday)) {
  468: 	    if (exists($libserv{$local})) {
  469: 		$host{$local.'_mysql'}='Stale.';
  470: 		$host{$local.'_mysql_doomed'}=1;
  471: 	    }
  472: 	    if ($mysql{'mysql'} eq 'defunct') {
  473: 		$host{$local.'_mysql'}='Defunct (maybe stale).';
  474: 		$host{$local.'_mysql_doomed'}=2;
  475: 	    }
  476: 	} elsif ($mysql{'mysql'} eq 'defunct') {
  477: 	    $host{$local.'_mysql'}='Defunct.';
  478: 	    $host{$local.'_mysql_doomed'}=3;
  479: 	}
  480:     }
  481: # -- Check rpm status
  482:     &statuslist($local,'RPMs');
  483:     my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
  484:     if (defined($checkrpms{'local_error'})) {
  485: 	$host{$local.'_checkrpms'}='Could not determine.';
  486: 	$host{$local.'_unresponsive_doomed'}++;
  487:     } else {
  488: 	if ((time-$checkrpms{'time'})>(4*$oneday)) {
  489: 	    $host{$local.'_checkrpms'}='Stale.';
  490: 	    $host{$local.'_checkrpms_doomed'}=50;
  491: 	    $host{$local.'_unresponsive_doomed'}++;
  492: 	} elsif ($checkrpms{'status'} eq 'fail') {
  493: 	    $host{$local.'_checkrpms'}='Could not checked RPMs.';
  494: 	    $host{$local.'_checkrpms_doomed'}=100;
  495: 	} elsif ($checkrpms{'rpmcount'}) {
  496: 	    $host{$local.'_checkrpms'}='Outdated RPMs: '.
  497: 		$checkrpms{'rpmcount'};
  498: 	    $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
  499: 	}
  500:     }
  501: # -- Check connections
  502:     &statuslist($local,'Connections');
  503:     $host{$local.'_notconnected'}='';
  504:     $host{$local.'_notconnected_doomed'}=0;
  505:     foreach my $remote (sort keys %hostname) {
  506: 	my $status=&connected($local,$remote);
  507: 	$connectionstatus{$local.'_TO_'.$remote}=$status;
  508: 	unless (($status eq 'ok') || ($status eq 'not_yet')) {
  509: 	    $host{$local.'_notconnected'}.=' '.$remote;
  510: 	    $host{$local.'_notconnected_doomed'}++;
  511: 	}
  512:     }
  513: # =============================================================== End Main Loop
  514: }
  515: 
  516: }
  517: 
  518: sub reports {
  519: # ====================================================================== Output
  520:     if ($mode=~/\_doomed$/) {
  521: # Output by doomedness
  522: 	foreach (&doomedness($mode)) {
  523: 	    &serverstatus($_);
  524: 	}
  525:     } elsif ($mode eq 'connections') {
  526: 	print 
  527:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
  528:        "<tr><td bgcolor='#225522'>&nbsp;</td>";
  529: 	foreach my $remote (sort keys %hostname) {
  530: 	    print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
  531: 	}
  532: 	print "</tr>\n";
  533: # connection matrix
  534: 	foreach my $local (sort keys %hostname) {
  535: 	    print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
  536: 	    foreach my $remote (sort keys %hostname) {
  537: 		if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
  538: 		    my $cellcolor='#FFFFFF';
  539: 		    if ($local eq $remote) { $cellcolor='#DDDDDD'; }
  540: 		    print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
  541: 		} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
  542: 		    my $cellcolor='#BBDDBB';
  543: 		    if ($local eq $remote) { $cellcolor='#99DD99'; }
  544: 		    print 
  545: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>'.&Apache::lonlocal::mt('ok').'</b></td>';
  546: 		} else {
  547: 		    my $cellcolor='#DDCCAA';
  548: 		    if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
  549: 			if ($local eq $remote) { 
  550: 			    $cellcolor='#DD88AA'; 
  551: 			} else {
  552: 			    $cellcolor='#DDAACC';
  553: 			}
  554: 		    } else {
  555: 			if ($local eq $remote) { $cellcolor='#DDBB77'; }
  556: 		    }
  557: 		    print 
  558: 		  '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
  559: 		  $connectionstatus{$local.'_TO_'.$remote}.'<br />';
  560: 		    &lonc($local); &lond($remote);
  561: 		    print '</td>';
  562: 		}
  563: 	    }
  564: 	    print "</tr>\n";
  565: 	}
  566: 	print "</table>";
  567:     } elsif ($mode eq 'users') {
  568: # Users
  569: 	if ($maxusers) {
  570: 	    my $factor=50/$maxusers;
  571: 	    print '<h3>'.&Apache::lonlocal::mt('Total active user(s)').': '.$totalusers.'</h3>'. 
  572:                   '<table cellspacing="3" cellpadding="3" border="0" bgcolor="#225522">';
  573: 
  574: 	    foreach my $local (sort keys %hostname) {
  575: 		if (defined($host{$local.'_users'})) {
  576: 		    print 
  577: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
  578: 			'</font><br /><font size="-2">'.
  579: 			$domaininfo{$hostdom{$local}}{'description'}.
  580: 		       '</font></td><td bgcolor="#DDDDBB">';
  581: 		    &users($local);
  582: 		    print 
  583: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
  584: 	      $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
  585: 		    &bar($factor*$host{$local.'_users'});
  586: 		    print '</td></tr>'."\n";
  587: 		}
  588: 	    }
  589: 	    print '</table>';
  590: 	} else {
  591: 	    print &Apache::lonlocal::mt('No active users logged in.');
  592: 	}
  593:     } elsif ($mode eq 'load') {
  594: # Load
  595: 	if ($maxload) {
  596: 	    my $factor=50/$maxload; 
  597: 	    print
  598:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
  599: 	    foreach my $local (sort keys %hostname) {
  600: 		if (defined($host{$local.'_load_doomed'})) {
  601: 		    print 
  602: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
  603:                         $local.
  604: 			'</font><br /><font size="-2">'.
  605: 			$Apache::lonnet::domain{$hostdom{$local}}{'description'}.
  606: 		       '</font></td><td bgcolor="#DDDDBB">';
  607: 		    &server($local);
  608: 		    print 
  609: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
  610: 	      $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
  611: 		    &bar($factor*$host{$local.'_load_doomed'});
  612: 		    print "</td></tr>\n";
  613: 		}
  614: 	    }
  615: 	    print "</table>";
  616: 	} else {
  617: 	    print &Apache::lonlocal::mt('No workload.');
  618: 	}
  619:     } elsif ($mode eq 'trouble') {
  620: 	my $count=0;
  621: 	foreach my $local (sort keys %hostname) {
  622: 	    my $trouble='';
  623: 	    if ($host{$local.'_unresponsive_doomed'}>3) {
  624: 		$trouble=&Apache::lonlocal::mt('Does not respond to several queries.').
  625:                          '<br />';
  626: 	    }
  627: 	    if ($host{$local.'_errors'}) {
  628: 		$trouble=&Apache::lonlocal::mt('Has loncron errors').'<br />';
  629: 	    } elsif ($host{$local.'_loncron_doomed'}>2500) {
  630: 		$trouble=&Apache::lonlocal::mt('High loncron count.').'<br />';
  631: 	    }
  632: 	    if ($host{$local.'_load_doomed'}>5) {
  633: 		$trouble=&Apache::lonlocal::mt('High load.').'<br />';
  634: 	    }
  635: 	    if ($host{$local.'_users_doomed'}>200) {
  636: 		$trouble=&Apache::lonlocal::mt('High user volume.').'<br />';
  637: 	    }
  638: 	    if ($host{$local.'_mysql_doomed'}>1) {
  639: 		$trouble=&Apache::lonlocal::mt('MySQL database apparently offline.').'<br />';
  640: 	    }
  641: 	    if ($host{$local.'_checkrpms_doomed'}>100) {
  642: 		$trouble=&Apache::lonlocal::mt('RPMs outdated.').'<br />';
  643: 	    }
  644: 	    if ($host{$local.'_reroute'}) {
  645: 		$trouble=&Apache::lonlocal::&mt('Rerouting').'<br >';
  646: 	    }
  647: 	    if ($trouble) { $count++; &serverstatus($local,$trouble); }
  648: 	}
  649: 	unless ($count) { print &Apache::lonlocal::mt('No major trouble.'); }
  650:     }
  651: }
  652: 
  653: # ====================================================================== Status
  654: sub statuslist {
  655:     my ($local,$what)=@_;
  656:     my $displaylocal;
  657:     if (defined($local)) {
  658:         $displaylocal = " $local ($hostname{$local})";
  659:     }
  660:     print '<script>document.prgstat.progress.value="'. 
  661:           &Apache::lonlocal::mt("Testing[_1]: $what",$displaylocal).'";</script>'."\n";
  662: }
  663: 
  664: # =============================================================================
  665: # =============================================================================
  666: # Main program
  667: #
  668: # ========================================================= Get form parameters
  669: my $buffer;
  670: 
  671: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  672: my @pairs=split(/&/,$buffer);
  673: my $pair; my $name; my $value;
  674: undef %FORM;
  675: %FORM=();
  676: foreach $pair (@pairs) {
  677:     ($name,$value) = split(/=/,$pair);
  678:     $value =~ tr/+/ /;
  679:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  680:     $FORM{$name}=$value;
  681: } 
  682: 
  683: $buffer=$ENV{'QUERY_STRING'};
  684: @pairs=split(/&/,$buffer);
  685: foreach $pair (@pairs) {
  686:     ($name,$value) = split(/=/,$pair);
  687:     $value =~ tr/+/ /;
  688:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  689:     $FORM{$name}=$value;
  690: } 
  691: 
  692: # ====================================================== Determine refresh rate
  693: 
  694: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
  695: if ($refresh<30) { $refresh=30; }
  696: my $starttime=time;
  697: 
  698: # ============================================================== Determine mode
  699: 
  700: my %modes= &Apache::lonlocal::texthash (
  701:                      'trouble' => 'Trouble',
  702: 	             'users_doomed' => 'Doomed: Users',
  703: 	             'loncron_doomed' => 'Doomed: General (loncron)',
  704: 	             'mysql_doomed' => 'Doomed: Database (mysql)',
  705: 	             'notconnected_doomed' => 'Doomed: Connections',
  706: 	             'checkrpms_doomed' => 'Doomed: RPMs',
  707: 	             'load_doomed' => 'Doomed: Load',
  708: 	             'unresponsive_doomed' => 'Doomed: Status could not be determined',
  709: 	             'users' => 'User Report',
  710: 	             'load' => 'Load Report',
  711: 	             'connections' => 'Connections Matrix');
  712: $mode=$FORM{'mode'};
  713: unless ($modes{$mode}) { $mode='trouble'; }
  714: # ================================================================ Send Headers
  715: print("Content-type: text/html\n\n".
  716:       '<html><body bgcolor="#FFFFFF">'."\n");
  717: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
  718: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
  719: %perlvar=%{$perlvarref};
  720: undef $perlvarref; # remove since sensitive and not needed
  721: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
  722: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
  723: 
  724: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
  725:     &Apache::lonlocal::get_language_handle();
  726:     print(&LONCAPA::loncgi::missing_cookie_msg());
  727:     exit;
  728: }
  729: 
  730: if (!&LONCAPA::lonauthcgi::can_view('clusterstatus')) {
  731:     &Apache::lonlocal::get_language_handle();
  732:     print &LONCAPA::lonauthcgi::unauthorized_msg('clusterstatus');
  733:     exit;
  734: }
  735: 
  736: &Apache::lonlocal::get_language_handle();
  737: 
  738: my $scope = 'Domain';
  739: if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
  740:     %hostname = %allhostname;
  741:     $scope = 'Cluster';
  742: } else {
  743:     undef(%hostname);
  744:     my @poss_domains = &Apache::lonnet::current_machine_domains();
  745:     foreach my $host (keys(%allhostname)) {
  746:         if (grep(/^\Q$hostdom{$host}\E$/,@poss_domains)) {
  747:             $hostname{$host} = $allhostname{$host};
  748:         }
  749:     }
  750: }
  751: 
  752: print '<img src="/adm/lonIcons/lonlogos.gif" align="right" /><h1>'.&Apache::lonlocal::mt("LON-CAPA $scope Status").' '.localtime()."</h1>";
  753: print "<form name='prgstat'>\n".
  754: '<input type="text" name="progress" value="'."'".&Apache::lonlocal::mt('Starting ...')."'".'" size="100" /><br />'.
  755: "</form>\n";
  756: print "<form name='status' method='post'>\n";
  757: print &Apache::lonlocal::mt('Choose next report:').' '.&select_form($mode,'mode',%modes).'<input type="submit" name="getreport" value="'.&Apache::lonlocal::mt('Go').'" /><hr />';
  758: &hidden('refresh',$refresh);
  759: 
  760:     if (!$FORM{'runonetime'}) {
  761:         my $lcscope = lc($scope);
  762: 	print '<h3>'.&Apache::lonlocal::mt("Gathering initial $lcscope data").'</h3>'.
  763:               &Apache::lonlocal::mt('This may take some time ..').'<br />';
  764: 	$fromcache=0;
  765: 	&mainloop();
  766: 	&statuslist(undef,'Done initial run.');
  767: 	&reports();
  768:     } else {
  769: 	$fromcache=1;
  770: 	&mainloop();
  771: 	&statuslist(undef,'Done gathering cached data');
  772: 	&reports();
  773: 	$fromcache=0;
  774: 	&mainloop();
  775:     }
  776:     &hidden('runonetime',1);
  777:     print '<tt><br />'.&Apache::lonlocal::mt('Total number of queries: [_1]',$stat_total);
  778:     if ($stat_total != 0) {
  779:         print '<br />'.&Apache::lonlocal::mt('Percent complete:').''.
  780: 	      int(($stat_total-$stat_notyet)/$stat_total*100.).
  781: 	      '<br />'.&Apache::lonlocal::mt('Percent from cache:').' '.
  782:               int($stat_fromcache/$stat_total*100.).'</tt>';
  783:     }
  784: 
  785: # ============================================================== Close, refresh
  786: print "</form><script>";
  787: my $runtime=time-$starttime;
  788: if (($refresh-$runtime)<0) {
  789:     print "document.status.submit();";
  790: } else {
  791:     my $refreshtime=int(1000*($refresh-$runtime));
  792:     my $refreshmsg = &Apache::lonlocal::mt('Will automatically refresh ([_1] secs refresh cycle)',$refresh);
  793:     print "setTimeout('document.status.submit()',$refreshtime);\n".
  794:           "document.prgstat.progress.value='$refreshmsg'";
  795: }
  796: print "</script></body></html>";
  797: exit 0;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>