File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.18: download - view: text, annotated - select for diffs
Wed Aug 13 21:41:47 2003 UTC (20 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Link to announcements - they might say why the thing is down.

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

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