Return to clusterstatus.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Users of clusterstatus.pl need to have a role in one of the domain(s) to which the server where the script is being run belongs.
- Only display "Reroute to" if there are servers to which rerouting can occur.

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