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

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

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