Annotation of loncom/cgi/clusterstatus.pl, revision 1.26

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

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