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

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.28    ! bisitz      4: # $Id: clusterstatus.pl,v 1.27 2009/01/15 22:34:18 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: #
1.28    ! bisitz    168:     &statuslist($local,&mt('connecting [_1]',$remote),1);
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.27      raeburn   263:     my $reroute;
                    264:     foreach my $remote (sort(keys(%hostname))) {
1.23      www       265: 	unless ($local eq $remote) {
1.27      raeburn   266: 	    $reroute .= &reroute($local,$remote);
1.23      www       267: 	}
                    268:     }
1.27      raeburn   269:     if ($reroute) {
                    270:         print(&Apache::lonlocal::mt('Reroute to:').' <font size="1">'.$reroute.'</font>');
                    271:     }
1.23      www       272: }
                    273: 
1.11      www       274: # ========================================================= Produce a green bar
                    275: sub bar {
                    276:     my $parm=shift;
                    277:     my $number=int($parm+0.5);
1.25      raeburn   278:     print('<table><tr><td bgcolor="#225522"><font color="#225522">');
1.11      www       279:     for (my $i=0;$i<$number;$i++) {
                    280: 	print "+";
                    281:     }
1.25      raeburn   282:     print("</font></table>");
1.11      www       283: }
                    284: 
1.9       www       285: # ========================================================== Show server status
                    286: 
1.8       www       287: sub serverstatus {
1.11      www       288:     my ($local,$trouble)=@_;
1.25      raeburn   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:',
1.28    ! bisitz    300:                                           rpms => 'RPMs:',
1.25      raeburn   301:                                           mysq => 'MySQL Database:',
                    302:                                           notc => 'Not connected',
                    303:                                           lonc => 'loncron errors',
                    304:                                          );
                    305:    
                    306:     print(<<ENDHEADER);
1.11      www       307: <a name="$local" />
1.9       www       308: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
                    309: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
1.25      raeburn   310: $local $hostdom{$local}</b> <tt>($hostname{$local}); $hostrole</tt>
                    311: <br />$domaininfo{$hostdom{$local}}{'description'}
                    312: $domaininfo{$hostdom{$local}}{'city'}
1.10      www       313: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
1.9       www       314: ENDHEADER
                    315:     &login($local);&server($local);&users($local);&versions($local);
1.18      www       316:     &announcement($local);
1.9       www       317:     &loncron($local);&lond($local);&lonc($local);&runloncron($local);
1.25      raeburn   318:     print("</font></td></tr>");
1.11      www       319:     if ($trouble) {
1.25      raeburn   320: 	print("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
1.11      www       321:     }
1.25      raeburn   322:     print("<tr><td bgcolor='#BBBBBB'>");
1.22      www       323: # re-routing
                    324:     if ($host{$local.'_reroute'}) {
1.25      raeburn   325: 	print('<br />'.$lt{'rero'}.' '.$host{$local.'_reroute'});
1.22      www       326: 	&takeonline($local);
                    327:     }
1.15      www       328: # version
                    329:     if ($host{$local.'_version'}) {
1.25      raeburn   330: 	print('<br />'.$lt{'vers'}.' '.$host{$local.'_version'});
1.15      www       331:     }
1.9       www       332: # load
                    333:     if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
1.25      raeburn   334: 	print('<br />'.$lt{'load'}.' '.$host{$local.'_load'});
1.9       www       335:     }
                    336: # users
                    337:     if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
1.25      raeburn   338: 	print('<br />'.$lt{'acti'}.' '.$host{$local.'_users'});
1.9       www       339:     }
                    340: 
1.8       www       341: # checkrpms
                    342:     if ($host{$local.'_checkrpms'}) {
1.25      raeburn   343: 	print('<br />'.$lt{'rpms'}.' '.$host{$local.'_checkrpms'});
1.8       www       344:     }
                    345: # mysql
                    346:     if ($host{$local.'_mysql'}) {
1.25      raeburn   347: 	print('<br />'.$lt{'mysq'}.' '.$host{$local.'_mysql'});
1.8       www       348:     }
1.11      www       349: # connections
                    350:     if ($host{$local.'_notconnected'}) {
1.25      raeburn   351: 	print('<br />'.$lt{'notc'}.' ');
                    352: 	foreach my $item (split(/ /,$host{$local.'_notconnected'})) {
                    353: 	    if ($item) {
                    354: 		print(' <a href="#$item">'.$item.'</a>');
1.11      www       355: 	    }
                    356: 	}
                    357:     }
                    358: # errors
                    359:     if ($host{$local.'_errors'}) {
1.25      raeburn   360: 	print('<br />'.$lt{'lonc'}.' '.$host{$local.'_errors'});
1.11      www       361:     }
1.23      www       362:     print "</td></tr><tr><td bgcolor='#DDDDDD'>";
                    363:     &allreroutes($local);
1.9       www       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;
1.8       www       382: }
1.1       www       383: 
1.16      www       384: sub resetvars {
                    385:    $maxusers=0;
                    386:    $maxload=0;
                    387:    $totalusers=0;
                    388:    $stat_total=0;
                    389:    $stat_notyet=0;
                    390:    $stat_fromcache=0;
1.17      www       391:    $concount=0;
1.16      www       392:    undef %host;
                    393:    %host=();
1.1       www       394: }
1.8       www       395: 
1.16      www       396: sub mainloop {
                    397:     &resetvars();
1.8       www       398: # ==================================================== Main Loop over all Hosts
                    399: 
1.25      raeburn   400: foreach my $local (sort(keys(%hostname))) {
1.9       www       401:     $host{$local.'_unresponsive_doomed'}=0;
1.8       www       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.';
1.9       www       407: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       408:     } else {
                    409: 	if ((time-$loncron{'time'})>$oneday) {
                    410: 	    $host{$local.'_loncron'}='Stale.';
1.9       www       411: 	    $host{$local.'_unresponsive_doomed'}++;
1.8       www       412: 	} else {
1.11      www       413: 	    $host{$local.'_loncron_doomed'}=$loncron{'notices'}
                    414: 	                                 +4*$loncron{'warnings'}
                    415: 	                               +100*$loncron{'errors'};
                    416: 	    $host{$local.'_errors'}=$loncron{'errors'};
1.8       www       417: 	}
                    418:     }
1.15      www       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:     }
1.8       www       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.';
1.9       www       433: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       434:     } else {
1.9       www       435: 	$host{$local.'_users_doomed'}=$userstatus{'Active'};
                    436: 	$host{$local.'_users'}=$userstatus{'Active'};
1.11      www       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'};
1.9       www       442: 	my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
                    443: 	$host{$local.'_load_doomed'}=$mload;
1.11      www       444: 	if ($mload>$maxload) { 
                    445: 	    $maxload=$mload;
                    446: 	}
1.9       www       447: 	$host{$local.'_load'}=$userstatus{'loadavg'};
1.8       www       448:     }
1.22      www       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:     }
1.8       www       462: # -- Check mysql status
                    463:     &statuslist($local,'Database');
1.9       www       464:     my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
1.8       www       465:     if (defined($mysql{'local_error'})) {
                    466: 	$host{$local.'_mysql'}='Could not determine.';
1.9       www       467: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       468:     } else {
                    469: 	if ((time-$mysql{'time'})>(7*$oneday)) {
1.25      raeburn   470: 	    if (exists($libserv{$local})) {
1.8       www       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');
1.9       www       485:     my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
1.8       www       486:     if (defined($checkrpms{'local_error'})) {
                    487: 	$host{$local.'_checkrpms'}='Could not determine.';
1.9       www       488: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       489:     } else {
                    490: 	if ((time-$checkrpms{'time'})>(4*$oneday)) {
                    491: 	    $host{$local.'_checkrpms'}='Stale.';
                    492: 	    $host{$local.'_checkrpms_doomed'}=50;
1.9       www       493: 	    $host{$local.'_unresponsive_doomed'}++;
1.8       www       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;
1.16      www       507:     foreach my $remote (sort keys %hostname) {
1.8       www       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:     }
1.16      www       515: # =============================================================== End Main Loop
                    516: }
                    517: 
1.8       www       518: }
1.16      www       519: 
                    520: sub reports {
1.9       www       521: # ====================================================================== Output
                    522:     if ($mode=~/\_doomed$/) {
                    523: # Output by doomedness
                    524: 	foreach (&doomedness($mode)) {
                    525: 	    &serverstatus($_);
                    526: 	}
1.10      www       527:     } elsif ($mode eq 'connections') {
                    528: 	print 
                    529:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
                    530:        "<tr><td bgcolor='#225522'>&nbsp;</td>";
1.11      www       531: 	foreach my $remote (sort keys %hostname) {
1.17      www       532: 	    print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
1.10      www       533: 	}
                    534: 	print "</tr>\n";
                    535: # connection matrix
1.11      www       536: 	foreach my $local (sort keys %hostname) {
1.17      www       537: 	    print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
1.11      www       538: 	    foreach my $remote (sort keys %hostname) {
1.10      www       539: 		if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
1.14      www       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>';
1.10      www       543: 		} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
1.14      www       544: 		    my $cellcolor='#BBDDBB';
                    545: 		    if ($local eq $remote) { $cellcolor='#99DD99'; }
1.10      www       546: 		    print 
1.25      raeburn   547: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>'.&Apache::lonlocal::mt('ok').'</b></td>';
1.10      www       548: 		} else {
1.20      www       549: 		    my $cellcolor='#DDCCAA';
1.14      www       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 {
1.20      www       557: 			if ($local eq $remote) { $cellcolor='#DDBB77'; }
1.14      www       558: 		    }
1.10      www       559: 		    print 
1.14      www       560: 		  '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
1.10      www       561: 		  $connectionstatus{$local.'_TO_'.$remote}.'<br />';
                    562: 		    &lonc($local); &lond($remote);
                    563: 		    print '</td>';
                    564: 		}
                    565: 	    }
                    566: 	    print "</tr>\n";
                    567: 	}
1.11      www       568: 	print "</table>";
                    569:     } elsif ($mode eq 'users') {
                    570: # Users
                    571: 	if ($maxusers) {
                    572: 	    my $factor=50/$maxusers;
1.25      raeburn   573: 	    print '<h3>'.&Apache::lonlocal::mt('Total active user(s)').': '.$totalusers.'</h3>'. 
                    574:                   '<table cellspacing="3" cellpadding="3" border="0" bgcolor="#225522">';
1.11      www       575: 
1.16      www       576: 	    foreach my $local (sort keys %hostname) {
1.11      www       577: 		if (defined($host{$local.'_users'})) {
                    578: 		    print 
1.16      www       579: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
                    580: 			'</font><br /><font size="-2">'.
1.25      raeburn   581: 			$domaininfo{$hostdom{$local}}{'description'}.
1.16      www       582: 		       '</font></td><td bgcolor="#DDDDBB">';
1.12      www       583: 		    &users($local);
1.11      www       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'});
1.25      raeburn   588: 		    print '</td></tr>'."\n";
1.11      www       589: 		}
                    590: 	    }
1.25      raeburn   591: 	    print '</table>';
1.11      www       592: 	} else {
1.25      raeburn   593: 	    print &Apache::lonlocal::mt('No active users logged in.');
1.11      www       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'>";
1.16      www       601: 	    foreach my $local (sort keys %hostname) {
1.11      www       602: 		if (defined($host{$local.'_load_doomed'})) {
                    603: 		    print 
1.16      www       604: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
1.11      www       605:                         $local.
1.16      www       606: 			'</font><br /><font size="-2">'.
1.25      raeburn   607: 			$Apache::lonnet::domain{$hostdom{$local}}{'description'}.
1.16      www       608: 		       '</font></td><td bgcolor="#DDDDBB">';
1.12      www       609: 		    &server($local);
1.11      www       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 {
1.25      raeburn   619: 	    print &Apache::lonlocal::mt('No workload.');
1.11      www       620: 	}
                    621:     } elsif ($mode eq 'trouble') {
                    622: 	my $count=0;
1.16      www       623: 	foreach my $local (sort keys %hostname) {
1.11      www       624: 	    my $trouble='';
1.15      www       625: 	    if ($host{$local.'_unresponsive_doomed'}>3) {
1.25      raeburn   626: 		$trouble=&Apache::lonlocal::mt('Does not respond to several queries.').
                    627:                          '<br />';
1.15      www       628: 	    }
1.11      www       629: 	    if ($host{$local.'_errors'}) {
1.25      raeburn   630: 		$trouble=&Apache::lonlocal::mt('Has loncron errors').'<br />';
1.24      albertel  631: 	    } elsif ($host{$local.'_loncron_doomed'}>2500) {
1.25      raeburn   632: 		$trouble=&Apache::lonlocal::mt('High loncron count.').'<br />';
1.11      www       633: 	    }
                    634: 	    if ($host{$local.'_load_doomed'}>5) {
1.25      raeburn   635: 		$trouble=&Apache::lonlocal::mt('High load.').'<br />';
1.11      www       636: 	    }
                    637: 	    if ($host{$local.'_users_doomed'}>200) {
1.25      raeburn   638: 		$trouble=&Apache::lonlocal::mt('High user volume.').'<br />';
1.11      www       639: 	    }
                    640: 	    if ($host{$local.'_mysql_doomed'}>1) {
1.25      raeburn   641: 		$trouble=&Apache::lonlocal::mt('MySQL database apparently offline.').'<br />';
1.11      www       642: 	    }
                    643: 	    if ($host{$local.'_checkrpms_doomed'}>100) {
1.25      raeburn   644: 		$trouble=&Apache::lonlocal::mt('RPMs outdated.').'<br />';
1.22      www       645: 	    }
                    646: 	    if ($host{$local.'_reroute'}) {
1.25      raeburn   647: 		$trouble=&Apache::lonlocal::&mt('Rerouting').'<br >';
1.11      www       648: 	    }
                    649: 	    if ($trouble) { $count++; &serverstatus($local,$trouble); }
                    650: 	}
1.25      raeburn   651: 	unless ($count) { print &Apache::lonlocal::mt('No major trouble.'); }
1.9       www       652:     }
1.16      www       653: }
                    654: 
                    655: # ====================================================================== Status
                    656: sub statuslist {
1.28    ! bisitz    657:     my ($local,$what,$nomt)=@_;
1.25      raeburn   658:     my $displaylocal;
                    659:     if (defined($local)) {
                    660:         $displaylocal = " $local ($hostname{$local})";
                    661:     }
1.28    ! bisitz    662:     my $output = &Apache::lonlocal::mt('Testing[_1]:',$displaylocal).' ';
        !           663:     if ($nomt) {
        !           664:         $output .= $what;
        !           665:     } else {
        !           666:         $output .= &Apache::lonlocal::mt($what);
        !           667:     }
        !           668:     print '<script>document.prgstat.progress.value="'.$output.'";</script>'."\n";
1.16      www       669: }
                    670: 
                    671: # =============================================================================
                    672: # =============================================================================
                    673: # Main program
                    674: #
                    675: # ========================================================= Get form parameters
                    676: my $buffer;
                    677: 
                    678: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
                    679: my @pairs=split(/&/,$buffer);
                    680: my $pair; my $name; my $value;
                    681: undef %FORM;
                    682: %FORM=();
                    683: foreach $pair (@pairs) {
                    684:     ($name,$value) = split(/=/,$pair);
                    685:     $value =~ tr/+/ /;
                    686:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    687:     $FORM{$name}=$value;
                    688: } 
                    689: 
                    690: $buffer=$ENV{'QUERY_STRING'};
                    691: @pairs=split(/&/,$buffer);
                    692: foreach $pair (@pairs) {
                    693:     ($name,$value) = split(/=/,$pair);
                    694:     $value =~ tr/+/ /;
                    695:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    696:     $FORM{$name}=$value;
                    697: } 
                    698: 
                    699: # ====================================================== Determine refresh rate
                    700: 
                    701: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
                    702: if ($refresh<30) { $refresh=30; }
                    703: my $starttime=time;
                    704: 
                    705: # ============================================================== Determine mode
                    706: 
1.25      raeburn   707: my %modes= &Apache::lonlocal::texthash (
                    708:                      'trouble' => 'Trouble',
                    709: 	             'users_doomed' => 'Doomed: Users',
                    710: 	             'loncron_doomed' => 'Doomed: General (loncron)',
                    711: 	             'mysql_doomed' => 'Doomed: Database (mysql)',
                    712: 	             'notconnected_doomed' => 'Doomed: Connections',
                    713: 	             'checkrpms_doomed' => 'Doomed: RPMs',
                    714: 	             'load_doomed' => 'Doomed: Load',
                    715: 	             'unresponsive_doomed' => 'Doomed: Status could not be determined',
                    716: 	             'users' => 'User Report',
                    717: 	             'load' => 'Load Report',
                    718: 	             'connections' => 'Connections Matrix');
1.16      www       719: $mode=$FORM{'mode'};
                    720: unless ($modes{$mode}) { $mode='trouble'; }
                    721: # ================================================================ Send Headers
1.25      raeburn   722: print("Content-type: text/html\n\n".
                    723:       '<html><body bgcolor="#FFFFFF">'."\n");
1.16      www       724: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
                    725: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
                    726: %perlvar=%{$perlvarref};
                    727: undef $perlvarref; # remove since sensitive and not needed
                    728: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
                    729: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
                    730: 
1.25      raeburn   731: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
                    732:     &Apache::lonlocal::get_language_handle();
                    733:     print(&LONCAPA::loncgi::missing_cookie_msg());
                    734:     exit;
                    735: }
                    736: 
1.26      raeburn   737: if (!&LONCAPA::lonauthcgi::can_view('clusterstatus')) {
1.25      raeburn   738:     &Apache::lonlocal::get_language_handle();
1.26      raeburn   739:     print &LONCAPA::lonauthcgi::unauthorized_msg('clusterstatus');
1.25      raeburn   740:     exit;
                    741: }
                    742: 
                    743: &Apache::lonlocal::get_language_handle();
                    744: 
                    745: my $scope = 'Domain';
                    746: if ($Apache::lonnet::env{'request.role'} =~ m{^su\./}) {
                    747:     %hostname = %allhostname;
                    748:     $scope = 'Cluster';
                    749: } else {
1.27      raeburn   750:     my $roledom = $env{'request.role.domain'}; 
                    751:     if ((!$roledom) || ($roledom eq 'public'))  {
                    752:         print &LONCAPA::lonauthcgi::unauthorized_msg('clusterstatus'); 
                    753:         exit;
                    754:     }
1.25      raeburn   755:     undef(%hostname);
                    756:     my @poss_domains = &Apache::lonnet::current_machine_domains();
1.27      raeburn   757:     if (!grep(/^\Q$roledom\E$/,@poss_domains)) {
                    758:         my $home = &Apache::lonnet::domain($roledom,'primary');
                    759:         print &LONCAPA::lonauthcgi::unauthorized_msg('clusterstatus');
                    760:         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 />';
                    761:         if ($home) {
                    762:             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>';
                    763:         }
                    764:         exit;
                    765:     }
1.25      raeburn   766:     foreach my $host (keys(%allhostname)) {
                    767:         if (grep(/^\Q$hostdom{$host}\E$/,@poss_domains)) {
                    768:             $hostname{$host} = $allhostname{$host};
                    769:         }
1.16      www       770:     }
                    771: }
                    772: 
1.25      raeburn   773: print '<img src="/adm/lonIcons/lonlogos.gif" align="right" /><h1>'.&Apache::lonlocal::mt("LON-CAPA $scope Status").' '.localtime()."</h1>";
1.16      www       774: print "<form name='prgstat'>\n".
1.25      raeburn   775: '<input type="text" name="progress" value="'."'".&Apache::lonlocal::mt('Starting ...')."'".'" size="100" /><br />'.
                    776: "</form>\n";
1.16      www       777: print "<form name='status' method='post'>\n";
1.25      raeburn   778: 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       779: &hidden('refresh',$refresh);
                    780: 
                    781:     if (!$FORM{'runonetime'}) {
1.25      raeburn   782:         my $lcscope = lc($scope);
                    783: 	print '<h3>'.&Apache::lonlocal::mt("Gathering initial $lcscope data").'</h3>'.
1.28    ! bisitz    784:               &Apache::lonlocal::mt('This may take some time ...').'<br />';
1.16      www       785: 	$fromcache=0;
                    786: 	&mainloop();
1.28    ! bisitz    787: 	&statuslist(undef,'Done initial run');
1.16      www       788: 	&reports();
                    789:     } else {
                    790: 	$fromcache=1;
                    791: 	&mainloop();
1.25      raeburn   792: 	&statuslist(undef,'Done gathering cached data');
1.16      www       793: 	&reports();
                    794: 	$fromcache=0;
                    795: 	&mainloop();
                    796:     }
                    797:     &hidden('runonetime',1);
1.25      raeburn   798:     print '<tt><br />'.&Apache::lonlocal::mt('Total number of queries: [_1]',$stat_total);
                    799:     if ($stat_total != 0) {
1.28    ! bisitz    800:         print '<br />'.&Apache::lonlocal::mt('Percent complete:').' '.
1.25      raeburn   801: 	      int(($stat_total-$stat_notyet)/$stat_total*100.).
                    802: 	      '<br />'.&Apache::lonlocal::mt('Percent from cache:').' '.
                    803:               int($stat_fromcache/$stat_total*100.).'</tt>';
                    804:     }
1.16      www       805: 
1.9       www       806: # ============================================================== Close, refresh
1.8       www       807: print "</form><script>";
1.16      www       808: my $runtime=time-$starttime;
                    809: if (($refresh-$runtime)<0) {
                    810:     print "document.status.submit();";
1.8       www       811: } else {
1.16      www       812:     my $refreshtime=int(1000*($refresh-$runtime));
1.25      raeburn   813:     my $refreshmsg = &Apache::lonlocal::mt('Will automatically refresh ([_1] secs refresh cycle)',$refresh);
1.11      www       814:     print "setTimeout('document.status.submit()',$refreshtime);\n".
1.25      raeburn   815:           "document.prgstat.progress.value='$refreshmsg'";
1.2       www       816: }
1.8       www       817: print "</script></body></html>";
                    818: exit 0;

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