File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.21: download - view: text, annotated - select for diffs
Mon Sep 1 03:37:27 2003 UTC (20 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- adding more GPL headers

    1: #!/usr/bin/perl
    2: $|=1;
    3: # Generates a html page showing various sataus reports about the cluster
    4: # $Id: clusterstatus.pl,v 1.21 2003/09/01 03:37:27 albertel 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: # ========================================================= Produce a green bar
  246: sub bar {
  247:     my $parm=shift;
  248:     my $number=int($parm+0.5);
  249:     print "<table><tr><td bgcolor='#225522'><font color='#225522'>";
  250:     for (my $i=0;$i<$number;$i++) {
  251: 	print "+";
  252:     }
  253:     print "</font></table>";
  254: }
  255: 
  256: # ========================================================== Show server status
  257: 
  258: sub serverstatus {
  259:     my ($local,$trouble)=@_;
  260:     print (<<ENDHEADER);
  261: <a name="$local" />
  262: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
  263: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
  264: $local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt>
  265: <br />$domaindescription{$hostdom{$local}}
  266: $domain_city{$hostdom{$local}}
  267: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
  268: ENDHEADER
  269:     &login($local);&server($local);&users($local);&versions($local);
  270:     &announcement($local);
  271:     &loncron($local);&lond($local);&lonc($local);&runloncron($local);
  272:     print "</font></td></tr>";
  273:     if ($trouble) {
  274: 	print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
  275:     }
  276:     print "<tr><td bgcolor='#BBBBBB'>";
  277: # version
  278:     if ($host{$local.'_version'}) {
  279: 	print "<br />Version: ".$host{$local.'_version'}
  280:     }
  281: # load
  282:     if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
  283: 	print "<br />Load: ".$host{$local.'_load'}
  284:     }
  285: # users
  286:     if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
  287: 	print "<br />Active Users: ".$host{$local.'_users'}
  288:     }
  289: 
  290: # checkrpms
  291:     if ($host{$local.'_checkrpms'}) {
  292: 	print "<br />RPMs: ".$host{$local.'_checkrpms'}
  293:     }
  294: # mysql
  295:     if ($host{$local.'_mysql'}) {
  296: 	print "<br />MySQL Database: ".$host{$local.'_mysql'}
  297:     }
  298: # connections
  299:     if ($host{$local.'_notconnected'}) {
  300: 	print "<br />Not connected: ";
  301: 	foreach (split(/ /,$host{$local.'_notconnected'})) {
  302: 	    if ($_) {
  303: 		print " <a href='#$_'>$_</a>";
  304: 	    }
  305: 	}
  306:     }
  307: # errors
  308:     if ($host{$local.'_errors'}) {
  309: 	print "<br />loncron errors: ".$host{$local.'_errors'};
  310:     }
  311:     print "</td></tr></table><br />";
  312: }
  313: 
  314: # =========================================================== Doomedness sorted
  315: 
  316: sub doomedness {
  317:     my $crit=shift;
  318:     my %alldoomed=();
  319:     my @allhosts=();
  320:     foreach (keys %host) {
  321: 	if ($_=~/^(\w+)\_$crit$/) {
  322: 	    if ($host{$_}) {
  323: 		push (@allhosts,$1);
  324: 		$alldoomed{$1}=$host{$_};
  325: 	    }
  326: 	}
  327:     }
  328:     return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
  329: }
  330: 
  331: sub resetvars {
  332:    $maxusers=0;
  333:    $maxload=0;
  334:    $totalusers=0;
  335:    $stat_total=0;
  336:    $stat_notyet=0;
  337:    $stat_fromcache=0;
  338:    $concount=0;
  339:    undef %host;
  340:    %host=();
  341: }
  342: 
  343: sub mainloop {
  344:     &resetvars();
  345: # ==================================================== Main Loop over all Hosts
  346: 
  347: foreach my $local (sort keys %hostname) {
  348:     $host{$local.'_unresponsive_doomed'}=0;
  349: # -- Check general status
  350:     &statuslist($local,'General');
  351:     my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
  352:     if (defined($loncron{'local_error'})) {
  353: 	$host{$local.'_loncron'}='Could not determine.';
  354: 	$host{$local.'_unresponsive_doomed'}++;
  355:     } else {
  356: 	if ((time-$loncron{'time'})>$oneday) {
  357: 	    $host{$local.'_loncron'}='Stale.';
  358: 	    $host{$local.'_unresponsive_doomed'}++;
  359: 	} else {
  360: 	    $host{$local.'_loncron_doomed'}=$loncron{'notices'}
  361: 	                                 +4*$loncron{'warnings'}
  362: 	                               +100*$loncron{'errors'};
  363: 	    $host{$local.'_errors'}=$loncron{'errors'};
  364: 	}
  365:     }
  366: # -- Check version
  367:     &statuslist($local,'Version');
  368:     my $version=&request($local,'/lon-status/version.txt',7200);
  369:     if ($version eq 'local_error') {
  370: 	$host{$local.'_version'}='Could not determine.';
  371: 	$host{$local.'_unresponsive_doomed'}++;
  372:     } else {
  373: 	$host{$local.'_version'}=$version;
  374:     }
  375: # -- Check user status
  376:     &statuslist($local,'Users');
  377:     my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
  378:     if (defined($userstatus{'local_error'})) {
  379: 	$host{$local.'_userstatus'}='Could not determine.';
  380: 	$host{$local.'_unresponsive_doomed'}++;
  381:     } else {
  382: 	$host{$local.'_users_doomed'}=$userstatus{'Active'};
  383: 	$host{$local.'_users'}=$userstatus{'Active'};
  384: 	unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
  385: 	if ($host{$local.'_users'}>$maxusers) { 
  386: 	    $maxusers=$host{$local.'_users'};
  387: 	}
  388: 	$totalusers+=$host{$local.'_users'};
  389: 	my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
  390: 	$host{$local.'_load_doomed'}=$mload;
  391: 	if ($mload>$maxload) { 
  392: 	    $maxload=$mload;
  393: 	}
  394: 	$host{$local.'_load'}=$userstatus{'loadavg'};
  395:     }
  396: # -- Check mysql status
  397:     &statuslist($local,'Database');
  398:     my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
  399:     if (defined($mysql{'local_error'})) {
  400: 	$host{$local.'_mysql'}='Could not determine.';
  401: 	$host{$local.'_unresponsive_doomed'}++;
  402:     } else {
  403: 	if ((time-$mysql{'time'})>(7*$oneday)) {
  404: 	    if ($hostrole{$local} eq 'library') {
  405: 		$host{$local.'_mysql'}='Stale.';
  406: 		$host{$local.'_mysql_doomed'}=1;
  407: 	    }
  408: 	    if ($mysql{'mysql'} eq 'defunct') {
  409: 		$host{$local.'_mysql'}='Defunct (maybe stale).';
  410: 		$host{$local.'_mysql_doomed'}=2;
  411: 	    }
  412: 	} elsif ($mysql{'mysql'} eq 'defunct') {
  413: 	    $host{$local.'_mysql'}='Defunct.';
  414: 	    $host{$local.'_mysql_doomed'}=3;
  415: 	}
  416:     }
  417: # -- Check rpm status
  418:     &statuslist($local,'RPMs');
  419:     my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
  420:     if (defined($checkrpms{'local_error'})) {
  421: 	$host{$local.'_checkrpms'}='Could not determine.';
  422: 	$host{$local.'_unresponsive_doomed'}++;
  423:     } else {
  424: 	if ((time-$checkrpms{'time'})>(4*$oneday)) {
  425: 	    $host{$local.'_checkrpms'}='Stale.';
  426: 	    $host{$local.'_checkrpms_doomed'}=50;
  427: 	    $host{$local.'_unresponsive_doomed'}++;
  428: 	} elsif ($checkrpms{'status'} eq 'fail') {
  429: 	    $host{$local.'_checkrpms'}='Could not checked RPMs.';
  430: 	    $host{$local.'_checkrpms_doomed'}=100;
  431: 	} elsif ($checkrpms{'rpmcount'}) {
  432: 	    $host{$local.'_checkrpms'}='Outdated RPMs: '.
  433: 		$checkrpms{'rpmcount'};
  434: 	    $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
  435: 	}
  436:     }
  437: # -- Check connections
  438:     &statuslist($local,'Connections');
  439:     $host{$local.'_notconnected'}='';
  440:     $host{$local.'_notconnected_doomed'}=0;
  441:     foreach my $remote (sort keys %hostname) {
  442: 	my $status=&connected($local,$remote);
  443: 	$connectionstatus{$local.'_TO_'.$remote}=$status;
  444: 	unless (($status eq 'ok') || ($status eq 'not_yet')) {
  445: 	    $host{$local.'_notconnected'}.=' '.$remote;
  446: 	    $host{$local.'_notconnected_doomed'}++;
  447: 	}
  448:     }
  449: # =============================================================== End Main Loop
  450: }
  451: 
  452: }
  453: 
  454: sub reports {
  455: # ====================================================================== Output
  456:     if ($mode=~/\_doomed$/) {
  457: # Output by doomedness
  458: 	foreach (&doomedness($mode)) {
  459: 	    &serverstatus($_);
  460: 	}
  461:     } elsif ($mode eq 'connections') {
  462: 	print 
  463:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
  464:        "<tr><td bgcolor='#225522'>&nbsp;</td>";
  465: 	foreach my $remote (sort keys %hostname) {
  466: 	    print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
  467: 	}
  468: 	print "</tr>\n";
  469: # connection matrix
  470: 	foreach my $local (sort keys %hostname) {
  471: 	    print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
  472: 	    foreach my $remote (sort keys %hostname) {
  473: 		if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
  474: 		    my $cellcolor='#FFFFFF';
  475: 		    if ($local eq $remote) { $cellcolor='#DDDDDD'; }
  476: 		    print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
  477: 		} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
  478: 		    my $cellcolor='#BBDDBB';
  479: 		    if ($local eq $remote) { $cellcolor='#99DD99'; }
  480: 		    print 
  481: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>';
  482: 		} else {
  483: 		    my $cellcolor='#DDCCAA';
  484: 		    if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
  485: 			if ($local eq $remote) { 
  486: 			    $cellcolor='#DD88AA'; 
  487: 			} else {
  488: 			    $cellcolor='#DDAACC';
  489: 			}
  490: 		    } else {
  491: 			if ($local eq $remote) { $cellcolor='#DDBB77'; }
  492: 		    }
  493: 		    print 
  494: 		  '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
  495: 		  $connectionstatus{$local.'_TO_'.$remote}.'<br />';
  496: 		    &lonc($local); &lond($remote);
  497: 		    print '</td>';
  498: 		}
  499: 	    }
  500: 	    print "</tr>\n";
  501: 	}
  502: 	print "</table>";
  503:     } elsif ($mode eq 'users') {
  504: # Users
  505: 	if ($maxusers) {
  506: 	    my $factor=50/$maxusers;
  507: 	    print "<h3>Total active user(s): $totalusers</h3>". 
  508:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
  509: 
  510: 	    foreach my $local (sort keys %hostname) {
  511: 		if (defined($host{$local.'_users'})) {
  512: 		    print 
  513: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
  514: 			'</font><br /><font size="-2">'.
  515: 			$domaindescription{$hostdom{$local}}.
  516: 		       '</font></td><td bgcolor="#DDDDBB">';
  517: 		    &users($local);
  518: 		    print 
  519: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
  520: 	      $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
  521: 		    &bar($factor*$host{$local.'_users'});
  522: 		    print "</td></tr>\n";
  523: 		}
  524: 	    }
  525: 	    print "</table>";
  526: 	} else {
  527: 	    print "No active users logged in.";
  528: 	}
  529:     } elsif ($mode eq 'load') {
  530: # Load
  531: 	if ($maxload) {
  532: 	    my $factor=50/$maxload; 
  533: 	    print
  534:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
  535: 	    foreach my $local (sort keys %hostname) {
  536: 		if (defined($host{$local.'_load_doomed'})) {
  537: 		    print 
  538: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
  539:                         $local.
  540: 			'</font><br /><font size="-2">'.
  541: 			$domaindescription{$hostdom{$local}}.
  542: 		       '</font></td><td bgcolor="#DDDDBB">';
  543: 		    &server($local);
  544: 		    print 
  545: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
  546: 	      $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
  547: 		    &bar($factor*$host{$local.'_load_doomed'});
  548: 		    print "</td></tr>\n";
  549: 		}
  550: 	    }
  551: 	    print "</table>";
  552: 	} else {
  553: 	    print "No workload.";
  554: 	}
  555:     } elsif ($mode eq 'trouble') {
  556: 	my $count=0;
  557: 	foreach my $local (sort keys %hostname) {
  558: 	    my $trouble='';
  559: 	    if ($host{$local.'_unresponsive_doomed'}>3) {
  560: 		$trouble='Does not respond to several queries.<br />';
  561: 	    }
  562: 	    if ($host{$local.'_errors'}) {
  563: 		$trouble='Has loncron errors.<br />';
  564: 	    } elsif ($host{$local.'_loncron_doomed'}>600) {
  565: 		$trouble='High loncron count.<br />';
  566: 	    }
  567: 	    if ($host{$local.'_load_doomed'}>5) {
  568: 		$trouble='High load.<br />';
  569: 	    }
  570: 	    if ($host{$local.'_users_doomed'}>200) {
  571: 		$trouble='High user volume.<br />';
  572: 	    }
  573: 	    if ($host{$local.'_mysql_doomed'}>1) {
  574: 		$trouble='MySQL database apparently offline.<br />';
  575: 	    }
  576: 	    if ($host{$local.'_checkrpms_doomed'}>100) {
  577: 		$trouble='RPMs outdated.<br />';
  578: 	    }
  579: 	    if ($trouble) { $count++; &serverstatus($local,$trouble); }
  580: 	}
  581: 	unless ($count) { print "No mayor trouble."; }
  582:     }
  583: }
  584: 
  585: # ====================================================================== Status
  586: sub statuslist {
  587:     my ($local,$what)=@_;
  588:     print 
  589: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
  590: }
  591: 
  592: # =============================================================================
  593: # =============================================================================
  594: # Main program
  595: #
  596: # ========================================================= Get form parameters
  597: my $buffer;
  598: 
  599: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  600: my @pairs=split(/&/,$buffer);
  601: my $pair; my $name; my $value;
  602: undef %FORM;
  603: %FORM=();
  604: foreach $pair (@pairs) {
  605:     ($name,$value) = split(/=/,$pair);
  606:     $value =~ tr/+/ /;
  607:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  608:     $FORM{$name}=$value;
  609: } 
  610: 
  611: $buffer=$ENV{'QUERY_STRING'};
  612: @pairs=split(/&/,$buffer);
  613: foreach $pair (@pairs) {
  614:     ($name,$value) = split(/=/,$pair);
  615:     $value =~ tr/+/ /;
  616:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  617:     $FORM{$name}=$value;
  618: } 
  619: 
  620: # ====================================================== Determine refresh rate
  621: 
  622: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
  623: if ($refresh<30) { $refresh=30; }
  624: my $starttime=time;
  625: 
  626: # ============================================================== Determine mode
  627: 
  628: my %modes=('trouble' => 'Trouble',
  629: 	   'users_doomed' => 'Doomed: Users',
  630: 	   'loncron_doomed' => 'Doomed: General (loncron)',
  631: 	   'mysql_doomed' => 'Doomed: Database (mysql)',
  632: 	   'notconnected_doomed' => 'Doomed: Connections',
  633: 	   'checkrpms_doomed' => 'Doomed: RPMs',
  634: 	   'load_doomed' => 'Doomed: Load',
  635: 	   'unresponsive_doomed' => 'Doomed: Status could not be determined',
  636: 	   'users' => 'User Report',
  637: 	   'load' => 'Load Report',
  638: 	   'connections' => 'Connections Matrix');
  639: 
  640: $mode=$FORM{'mode'};
  641: unless ($modes{$mode}) { $mode='trouble'; }
  642: # ================================================================ Send Headers
  643: print "Content-type: text/html\n\n".
  644:     "<html><body bgcolor='#FFFFFF'>\n";
  645: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
  646: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
  647: %perlvar=%{$perlvarref};
  648: undef $perlvarref; # remove since sensitive and not needed
  649: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
  650: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
  651: 
  652: # ------------------------------------------------------------- Read hosts file
  653: {
  654:     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
  655: 
  656:     while (my $configline=<$config>) {
  657:        $configline=~s/#.*$//;
  658:        unless ($configline=~/\w/) { next; } 
  659:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
  660:        $hostname{$id}=$name;
  661:        $hostdom{$id}=$domain;
  662:        $hostrole{$id}=$role;
  663:        $hostip{$id}=$ip;
  664:        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
  665: 	   $libserv{$id}=$name;
  666:        }
  667:     }
  668: }
  669: # ------------------------------------------------------------ Read domain file
  670: {
  671:     my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab');
  672:     if ($fh) {
  673:        while (<$fh>) {
  674:            next if (/^(\#|\s*$)/);
  675:            chomp;
  676:            my ($domain, $domain_description, $def_auth, $def_auth_arg,
  677: 	       $def_lang, $city, $longi, $lati) = split(/:/,$_);
  678: 	   $domain_auth_def{$domain}=$def_auth;
  679:            $domain_auth_arg_def{$domain}=$def_auth_arg;
  680: 	   $domaindescription{$domain}=$domain_description;
  681: 	   $domain_lang_def{$domain}=$def_lang;
  682: 	   $domain_city{$domain}=$city;
  683: 	   $domain_longi{$domain}=$longi;
  684: 	   $domain_lati{$domain}=$lati;
  685:        }
  686:     }
  687: }
  688: 
  689: print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>";
  690: print "<form name='prgstat'>\n".
  691: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
  692: "</form>\n";;
  693: print "<form name='status' method='post'>\n";
  694: print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />';
  695: &hidden('refresh',$refresh);
  696: 
  697:     if (!$FORM{'runonetime'}) {
  698: 	print 
  699:    "<h3>Gathering initial cluster data</h3>This may take some time ...<br />";
  700: 	$fromcache=0;
  701: 	&mainloop();
  702: 	&statuslist('Done initial run.');
  703: 	&reports();
  704:     } else {
  705: 	$fromcache=1;
  706: 	&mainloop();
  707: 	&statuslist('Done gathering cached data');
  708: 	&reports();
  709: 	$fromcache=0;
  710: 	&mainloop();
  711:     }
  712:     &hidden('runonetime',1);
  713: print '<tt><br />Total number of queries: '.$stat_total.
  714:           '<br />Percent complete: '.
  715: 	  int(($stat_total-$stat_notyet)/$stat_total*100.).
  716: 	  '<br />Percent from cache: '.
  717:           int($stat_fromcache/$stat_total*100.).'</tt>';
  718: 
  719: # ============================================================== Close, refresh
  720: print "</form><script>";
  721: my $runtime=time-$starttime;
  722: if (($refresh-$runtime)<0) {
  723:     print "document.status.submit();";
  724: } else {
  725:     my $refreshtime=int(1000*($refresh-$runtime));
  726:     print "setTimeout('document.status.submit()',$refreshtime);\n".
  727:           "document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'";
  728: }
  729: print "</script></body></html>";
  730: exit 0;

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