File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.22: download - view: text, annotated - select for diffs
Sun Sep 14 18:24:34 2003 UTC (20 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Detects re-routing

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

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