File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.20: download - view: text, annotated - select for diffs
Fri Aug 29 17:42:32 2003 UTC (20 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Better color contrast between "local_error" and "con_lost"

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

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