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

1.1       www         1: #!/usr/bin/perl
                      2: $|=1;
1.21      albertel    3: # Generates a html page showing various sataus reports about the cluster
1.23    ! www         4: # $Id: clusterstatus.pl,v 1.22 2003/09/14 18:24:34 www 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: 
                     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.22      www       245: sub takeonline {
                    246:     my $local=shift;
                    247:     print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online');
                    248: }
                    249: 
1.23    ! www       250: sub takeoffline {
        !           251:     my $local=shift;
        !           252:     print &otherwindow($local,'/cgi-bin/takeoffline.pl','Take offline');
        !           253: }
        !           254: 
        !           255: sub reroute {
        !           256:     my ($local,$remote)=@_;
        !           257:     print &otherwindow($local,'/cgi-bin/takeoffline.pl?'.
        !           258: 		       $hostname{$remote}.'&'.$hostdom{$local}
        !           259: 		       ,$remote)."\n";
        !           260: }
        !           261: 
        !           262: sub allreroutes {
        !           263:     my $local=shift;
        !           264:     &takeoffline($local);
        !           265:     print ' Reroute to: <font size="1">';
        !           266:     foreach my $remote (sort keys %hostname) {
        !           267: 	unless ($local eq $remote) {
        !           268: 	    &reroute($local,$remote);
        !           269: 	}
        !           270:     }
        !           271:     print '</font>';
        !           272: }
        !           273: 
1.11      www       274: # ========================================================= Produce a green bar
                    275: sub bar {
                    276:     my $parm=shift;
                    277:     my $number=int($parm+0.5);
                    278:     print "<table><tr><td bgcolor='#225522'><font color='#225522'>";
                    279:     for (my $i=0;$i<$number;$i++) {
                    280: 	print "+";
                    281:     }
                    282:     print "</font></table>";
                    283: }
                    284: 
1.9       www       285: # ========================================================== Show server status
                    286: 
1.8       www       287: sub serverstatus {
1.11      www       288:     my ($local,$trouble)=@_;
1.9       www       289:     print (<<ENDHEADER);
1.11      www       290: <a name="$local" />
1.9       www       291: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
                    292: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
                    293: $local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt>
                    294: <br />$domaindescription{$hostdom{$local}}
1.19      www       295: $domain_city{$hostdom{$local}}
1.10      www       296: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
1.9       www       297: ENDHEADER
                    298:     &login($local);&server($local);&users($local);&versions($local);
1.18      www       299:     &announcement($local);
1.9       www       300:     &loncron($local);&lond($local);&lonc($local);&runloncron($local);
1.11      www       301:     print "</font></td></tr>";
                    302:     if ($trouble) {
                    303: 	print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
                    304:     }
                    305:     print "<tr><td bgcolor='#BBBBBB'>";
1.22      www       306: # re-routing
                    307:     if ($host{$local.'_reroute'}) {
                    308: 	print "<br />Reroute: ".$host{$local.'_reroute'};
                    309: 	&takeonline($local);
                    310:     }
1.15      www       311: # version
                    312:     if ($host{$local.'_version'}) {
                    313: 	print "<br />Version: ".$host{$local.'_version'}
                    314:     }
1.9       www       315: # load
                    316:     if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
                    317: 	print "<br />Load: ".$host{$local.'_load'}
                    318:     }
                    319: # users
                    320:     if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
                    321: 	print "<br />Active Users: ".$host{$local.'_users'}
                    322:     }
                    323: 
1.8       www       324: # checkrpms
                    325:     if ($host{$local.'_checkrpms'}) {
                    326: 	print "<br />RPMs: ".$host{$local.'_checkrpms'}
                    327:     }
                    328: # mysql
                    329:     if ($host{$local.'_mysql'}) {
                    330: 	print "<br />MySQL Database: ".$host{$local.'_mysql'}
                    331:     }
1.11      www       332: # connections
                    333:     if ($host{$local.'_notconnected'}) {
                    334: 	print "<br />Not connected: ";
                    335: 	foreach (split(/ /,$host{$local.'_notconnected'})) {
                    336: 	    if ($_) {
                    337: 		print " <a href='#$_'>$_</a>";
                    338: 	    }
                    339: 	}
                    340:     }
                    341: # errors
                    342:     if ($host{$local.'_errors'}) {
                    343: 	print "<br />loncron errors: ".$host{$local.'_errors'};
                    344:     }
1.23    ! www       345:     print "</td></tr><tr><td bgcolor='#DDDDDD'>";
        !           346:     &allreroutes($local);
1.9       www       347:     print "</td></tr></table><br />";
                    348: }
                    349: 
                    350: # =========================================================== Doomedness sorted
                    351: 
                    352: sub doomedness {
                    353:     my $crit=shift;
                    354:     my %alldoomed=();
                    355:     my @allhosts=();
                    356:     foreach (keys %host) {
                    357: 	if ($_=~/^(\w+)\_$crit$/) {
                    358: 	    if ($host{$_}) {
                    359: 		push (@allhosts,$1);
                    360: 		$alldoomed{$1}=$host{$_};
                    361: 	    }
                    362: 	}
                    363:     }
                    364:     return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
1.8       www       365: }
1.1       www       366: 
1.16      www       367: sub resetvars {
                    368:    $maxusers=0;
                    369:    $maxload=0;
                    370:    $totalusers=0;
                    371:    $stat_total=0;
                    372:    $stat_notyet=0;
                    373:    $stat_fromcache=0;
1.17      www       374:    $concount=0;
1.16      www       375:    undef %host;
                    376:    %host=();
1.1       www       377: }
1.8       www       378: 
1.16      www       379: sub mainloop {
                    380:     &resetvars();
1.8       www       381: # ==================================================== Main Loop over all Hosts
                    382: 
1.16      www       383: foreach my $local (sort keys %hostname) {
1.9       www       384:     $host{$local.'_unresponsive_doomed'}=0;
1.8       www       385: # -- Check general status
                    386:     &statuslist($local,'General');
                    387:     my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
                    388:     if (defined($loncron{'local_error'})) {
                    389: 	$host{$local.'_loncron'}='Could not determine.';
1.9       www       390: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       391:     } else {
                    392: 	if ((time-$loncron{'time'})>$oneday) {
                    393: 	    $host{$local.'_loncron'}='Stale.';
1.9       www       394: 	    $host{$local.'_unresponsive_doomed'}++;
1.8       www       395: 	} else {
1.11      www       396: 	    $host{$local.'_loncron_doomed'}=$loncron{'notices'}
                    397: 	                                 +4*$loncron{'warnings'}
                    398: 	                               +100*$loncron{'errors'};
                    399: 	    $host{$local.'_errors'}=$loncron{'errors'};
1.8       www       400: 	}
                    401:     }
1.15      www       402: # -- Check version
                    403:     &statuslist($local,'Version');
                    404:     my $version=&request($local,'/lon-status/version.txt',7200);
                    405:     if ($version eq 'local_error') {
                    406: 	$host{$local.'_version'}='Could not determine.';
                    407: 	$host{$local.'_unresponsive_doomed'}++;
                    408:     } else {
                    409: 	$host{$local.'_version'}=$version;
                    410:     }
1.8       www       411: # -- Check user status
                    412:     &statuslist($local,'Users');
                    413:     my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
                    414:     if (defined($userstatus{'local_error'})) {
                    415: 	$host{$local.'_userstatus'}='Could not determine.';
1.9       www       416: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       417:     } else {
1.9       www       418: 	$host{$local.'_users_doomed'}=$userstatus{'Active'};
                    419: 	$host{$local.'_users'}=$userstatus{'Active'};
1.11      www       420: 	unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
                    421: 	if ($host{$local.'_users'}>$maxusers) { 
                    422: 	    $maxusers=$host{$local.'_users'};
                    423: 	}
                    424: 	$totalusers+=$host{$local.'_users'};
1.9       www       425: 	my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
                    426: 	$host{$local.'_load_doomed'}=$mload;
1.11      www       427: 	if ($mload>$maxload) { 
                    428: 	    $maxload=$mload;
                    429: 	}
1.9       www       430: 	$host{$local.'_load'}=$userstatus{'loadavg'};
1.8       www       431:     }
1.22      www       432: # -- Check reroute status
                    433:     &statuslist($local,'Reroute');
                    434:     my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800);
                    435:     if ($reroute{'status'} eq 'rerouting') {
                    436: 	if ($reroute{'server'}) {
                    437: 	    $host{$local.'_reroute'}=
                    438: 		'Rerouting to <tt>'.$reroute{'server'}.
                    439:                    '</tt>, domain: '.$reroute{'domain'}.
                    440: 		 ' (since '.localtime($reroute{'time'}).')';
                    441: 	} else {
                    442: 	    $host{$local.'_reroute'}='offline';
                    443: 	}
                    444:     }
1.8       www       445: # -- Check mysql status
                    446:     &statuslist($local,'Database');
1.9       www       447:     my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
1.8       www       448:     if (defined($mysql{'local_error'})) {
                    449: 	$host{$local.'_mysql'}='Could not determine.';
1.9       www       450: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       451:     } else {
                    452: 	if ((time-$mysql{'time'})>(7*$oneday)) {
                    453: 	    if ($hostrole{$local} eq 'library') {
                    454: 		$host{$local.'_mysql'}='Stale.';
                    455: 		$host{$local.'_mysql_doomed'}=1;
                    456: 	    }
                    457: 	    if ($mysql{'mysql'} eq 'defunct') {
                    458: 		$host{$local.'_mysql'}='Defunct (maybe stale).';
                    459: 		$host{$local.'_mysql_doomed'}=2;
                    460: 	    }
                    461: 	} elsif ($mysql{'mysql'} eq 'defunct') {
                    462: 	    $host{$local.'_mysql'}='Defunct.';
                    463: 	    $host{$local.'_mysql_doomed'}=3;
                    464: 	}
                    465:     }
                    466: # -- Check rpm status
                    467:     &statuslist($local,'RPMs');
1.9       www       468:     my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
1.8       www       469:     if (defined($checkrpms{'local_error'})) {
                    470: 	$host{$local.'_checkrpms'}='Could not determine.';
1.9       www       471: 	$host{$local.'_unresponsive_doomed'}++;
1.8       www       472:     } else {
                    473: 	if ((time-$checkrpms{'time'})>(4*$oneday)) {
                    474: 	    $host{$local.'_checkrpms'}='Stale.';
                    475: 	    $host{$local.'_checkrpms_doomed'}=50;
1.9       www       476: 	    $host{$local.'_unresponsive_doomed'}++;
1.8       www       477: 	} elsif ($checkrpms{'status'} eq 'fail') {
                    478: 	    $host{$local.'_checkrpms'}='Could not checked RPMs.';
                    479: 	    $host{$local.'_checkrpms_doomed'}=100;
                    480: 	} elsif ($checkrpms{'rpmcount'}) {
                    481: 	    $host{$local.'_checkrpms'}='Outdated RPMs: '.
                    482: 		$checkrpms{'rpmcount'};
                    483: 	    $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
                    484: 	}
                    485:     }
                    486: # -- Check connections
                    487:     &statuslist($local,'Connections');
                    488:     $host{$local.'_notconnected'}='';
                    489:     $host{$local.'_notconnected_doomed'}=0;
1.16      www       490:     foreach my $remote (sort keys %hostname) {
1.8       www       491: 	my $status=&connected($local,$remote);
                    492: 	$connectionstatus{$local.'_TO_'.$remote}=$status;
                    493: 	unless (($status eq 'ok') || ($status eq 'not_yet')) {
                    494: 	    $host{$local.'_notconnected'}.=' '.$remote;
                    495: 	    $host{$local.'_notconnected_doomed'}++;
                    496: 	}
                    497:     }
1.16      www       498: # =============================================================== End Main Loop
                    499: }
                    500: 
1.8       www       501: }
1.16      www       502: 
                    503: sub reports {
1.9       www       504: # ====================================================================== Output
                    505:     if ($mode=~/\_doomed$/) {
                    506: # Output by doomedness
                    507: 	foreach (&doomedness($mode)) {
                    508: 	    &serverstatus($_);
                    509: 	}
1.10      www       510:     } elsif ($mode eq 'connections') {
                    511: 	print 
                    512:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
                    513:        "<tr><td bgcolor='#225522'>&nbsp;</td>";
1.11      www       514: 	foreach my $remote (sort keys %hostname) {
1.17      www       515: 	    print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
1.10      www       516: 	}
                    517: 	print "</tr>\n";
                    518: # connection matrix
1.11      www       519: 	foreach my $local (sort keys %hostname) {
1.17      www       520: 	    print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
1.11      www       521: 	    foreach my $remote (sort keys %hostname) {
1.10      www       522: 		if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
1.14      www       523: 		    my $cellcolor='#FFFFFF';
                    524: 		    if ($local eq $remote) { $cellcolor='#DDDDDD'; }
                    525: 		    print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
1.10      www       526: 		} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
1.14      www       527: 		    my $cellcolor='#BBDDBB';
                    528: 		    if ($local eq $remote) { $cellcolor='#99DD99'; }
1.10      www       529: 		    print 
1.14      www       530: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>';
1.10      www       531: 		} else {
1.20      www       532: 		    my $cellcolor='#DDCCAA';
1.14      www       533: 		    if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
                    534: 			if ($local eq $remote) { 
                    535: 			    $cellcolor='#DD88AA'; 
                    536: 			} else {
                    537: 			    $cellcolor='#DDAACC';
                    538: 			}
                    539: 		    } else {
1.20      www       540: 			if ($local eq $remote) { $cellcolor='#DDBB77'; }
1.14      www       541: 		    }
1.10      www       542: 		    print 
1.14      www       543: 		  '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
1.10      www       544: 		  $connectionstatus{$local.'_TO_'.$remote}.'<br />';
                    545: 		    &lonc($local); &lond($remote);
                    546: 		    print '</td>';
                    547: 		}
                    548: 	    }
                    549: 	    print "</tr>\n";
                    550: 	}
1.11      www       551: 	print "</table>";
                    552:     } elsif ($mode eq 'users') {
                    553: # Users
                    554: 	if ($maxusers) {
                    555: 	    my $factor=50/$maxusers;
                    556: 	    print "<h3>Total active user(s): $totalusers</h3>". 
                    557:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
                    558: 
1.16      www       559: 	    foreach my $local (sort keys %hostname) {
1.11      www       560: 		if (defined($host{$local.'_users'})) {
                    561: 		    print 
1.16      www       562: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
                    563: 			'</font><br /><font size="-2">'.
                    564: 			$domaindescription{$hostdom{$local}}.
                    565: 		       '</font></td><td bgcolor="#DDDDBB">';
1.12      www       566: 		    &users($local);
1.11      www       567: 		    print 
                    568: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
                    569: 	      $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
                    570: 		    &bar($factor*$host{$local.'_users'});
                    571: 		    print "</td></tr>\n";
                    572: 		}
                    573: 	    }
                    574: 	    print "</table>";
                    575: 	} else {
                    576: 	    print "No active users logged in.";
                    577: 	}
                    578:     } elsif ($mode eq 'load') {
                    579: # Load
                    580: 	if ($maxload) {
                    581: 	    my $factor=50/$maxload; 
                    582: 	    print
                    583:        "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
1.16      www       584: 	    foreach my $local (sort keys %hostname) {
1.11      www       585: 		if (defined($host{$local.'_load_doomed'})) {
                    586: 		    print 
1.16      www       587: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
1.11      www       588:                         $local.
1.16      www       589: 			'</font><br /><font size="-2">'.
                    590: 			$domaindescription{$hostdom{$local}}.
                    591: 		       '</font></td><td bgcolor="#DDDDBB">';
1.12      www       592: 		    &server($local);
1.11      www       593: 		    print 
                    594: 	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
                    595: 	      $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
                    596: 		    &bar($factor*$host{$local.'_load_doomed'});
                    597: 		    print "</td></tr>\n";
                    598: 		}
                    599: 	    }
                    600: 	    print "</table>";
                    601: 	} else {
                    602: 	    print "No workload.";
                    603: 	}
                    604:     } elsif ($mode eq 'trouble') {
                    605: 	my $count=0;
1.16      www       606: 	foreach my $local (sort keys %hostname) {
1.11      www       607: 	    my $trouble='';
1.15      www       608: 	    if ($host{$local.'_unresponsive_doomed'}>3) {
                    609: 		$trouble='Does not respond to several queries.<br />';
                    610: 	    }
1.11      www       611: 	    if ($host{$local.'_errors'}) {
                    612: 		$trouble='Has loncron errors.<br />';
                    613: 	    } elsif ($host{$local.'_loncron_doomed'}>600) {
                    614: 		$trouble='High loncron count.<br />';
                    615: 	    }
                    616: 	    if ($host{$local.'_load_doomed'}>5) {
                    617: 		$trouble='High load.<br />';
                    618: 	    }
                    619: 	    if ($host{$local.'_users_doomed'}>200) {
                    620: 		$trouble='High user volume.<br />';
                    621: 	    }
                    622: 	    if ($host{$local.'_mysql_doomed'}>1) {
                    623: 		$trouble='MySQL database apparently offline.<br />';
                    624: 	    }
                    625: 	    if ($host{$local.'_checkrpms_doomed'}>100) {
                    626: 		$trouble='RPMs outdated.<br />';
1.22      www       627: 	    }
                    628: 	    if ($host{$local.'_reroute'}) {
1.23    ! www       629: 		$trouble='Rerouting<br >';
1.11      www       630: 	    }
                    631: 	    if ($trouble) { $count++; &serverstatus($local,$trouble); }
                    632: 	}
                    633: 	unless ($count) { print "No mayor trouble."; }
1.9       www       634:     }
1.16      www       635: }
                    636: 
                    637: # ====================================================================== Status
                    638: sub statuslist {
                    639:     my ($local,$what)=@_;
                    640:     print 
                    641: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
                    642: }
                    643: 
                    644: # =============================================================================
                    645: # =============================================================================
                    646: # Main program
                    647: #
                    648: # ========================================================= Get form parameters
                    649: my $buffer;
                    650: 
                    651: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
                    652: my @pairs=split(/&/,$buffer);
                    653: my $pair; my $name; my $value;
                    654: undef %FORM;
                    655: %FORM=();
                    656: foreach $pair (@pairs) {
                    657:     ($name,$value) = split(/=/,$pair);
                    658:     $value =~ tr/+/ /;
                    659:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    660:     $FORM{$name}=$value;
                    661: } 
                    662: 
                    663: $buffer=$ENV{'QUERY_STRING'};
                    664: @pairs=split(/&/,$buffer);
                    665: foreach $pair (@pairs) {
                    666:     ($name,$value) = split(/=/,$pair);
                    667:     $value =~ tr/+/ /;
                    668:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    669:     $FORM{$name}=$value;
                    670: } 
                    671: 
                    672: # ====================================================== Determine refresh rate
                    673: 
                    674: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
                    675: if ($refresh<30) { $refresh=30; }
                    676: my $starttime=time;
                    677: 
                    678: # ============================================================== Determine mode
                    679: 
                    680: my %modes=('trouble' => 'Trouble',
                    681: 	   'users_doomed' => 'Doomed: Users',
                    682: 	   'loncron_doomed' => 'Doomed: General (loncron)',
                    683: 	   'mysql_doomed' => 'Doomed: Database (mysql)',
                    684: 	   'notconnected_doomed' => 'Doomed: Connections',
                    685: 	   'checkrpms_doomed' => 'Doomed: RPMs',
                    686: 	   'load_doomed' => 'Doomed: Load',
                    687: 	   'unresponsive_doomed' => 'Doomed: Status could not be determined',
                    688: 	   'users' => 'User Report',
                    689: 	   'load' => 'Load Report',
                    690: 	   'connections' => 'Connections Matrix');
                    691: 
                    692: $mode=$FORM{'mode'};
                    693: unless ($modes{$mode}) { $mode='trouble'; }
                    694: # ================================================================ Send Headers
                    695: print "Content-type: text/html\n\n".
                    696:     "<html><body bgcolor='#FFFFFF'>\n";
                    697: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
                    698: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
                    699: %perlvar=%{$perlvarref};
                    700: undef $perlvarref; # remove since sensitive and not needed
                    701: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
                    702: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
                    703: 
                    704: # ------------------------------------------------------------- Read hosts file
                    705: {
                    706:     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
                    707: 
                    708:     while (my $configline=<$config>) {
                    709:        $configline=~s/#.*$//;
                    710:        unless ($configline=~/\w/) { next; } 
                    711:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
                    712:        $hostname{$id}=$name;
                    713:        $hostdom{$id}=$domain;
                    714:        $hostrole{$id}=$role;
                    715:        $hostip{$id}=$ip;
                    716:        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
                    717: 	   $libserv{$id}=$name;
                    718:        }
                    719:     }
                    720: }
                    721: # ------------------------------------------------------------ Read domain file
                    722: {
                    723:     my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab');
                    724:     if ($fh) {
                    725:        while (<$fh>) {
                    726:            next if (/^(\#|\s*$)/);
                    727:            chomp;
1.19      www       728:            my ($domain, $domain_description, $def_auth, $def_auth_arg,
                    729: 	       $def_lang, $city, $longi, $lati) = split(/:/,$_);
                    730: 	   $domain_auth_def{$domain}=$def_auth;
1.16      www       731:            $domain_auth_arg_def{$domain}=$def_auth_arg;
1.19      www       732: 	   $domaindescription{$domain}=$domain_description;
                    733: 	   $domain_lang_def{$domain}=$def_lang;
                    734: 	   $domain_city{$domain}=$city;
                    735: 	   $domain_longi{$domain}=$longi;
                    736: 	   $domain_lati{$domain}=$lati;
1.16      www       737:        }
                    738:     }
                    739: }
                    740: 
                    741: print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>";
                    742: print "<form name='prgstat'>\n".
                    743: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
                    744: "</form>\n";;
                    745: print "<form name='status' method='post'>\n";
                    746: print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />';
                    747: &hidden('refresh',$refresh);
                    748: 
                    749:     if (!$FORM{'runonetime'}) {
                    750: 	print 
                    751:    "<h3>Gathering initial cluster data</h3>This may take some time ...<br />";
                    752: 	$fromcache=0;
                    753: 	&mainloop();
                    754: 	&statuslist('Done initial run.');
                    755: 	&reports();
                    756:     } else {
                    757: 	$fromcache=1;
                    758: 	&mainloop();
                    759: 	&statuslist('Done gathering cached data');
                    760: 	&reports();
                    761: 	$fromcache=0;
                    762: 	&mainloop();
                    763:     }
                    764:     &hidden('runonetime',1);
                    765: print '<tt><br />Total number of queries: '.$stat_total.
                    766:           '<br />Percent complete: '.
                    767: 	  int(($stat_total-$stat_notyet)/$stat_total*100.).
                    768: 	  '<br />Percent from cache: '.
                    769:           int($stat_fromcache/$stat_total*100.).'</tt>';
                    770: 
1.9       www       771: # ============================================================== Close, refresh
1.8       www       772: print "</form><script>";
1.16      www       773: my $runtime=time-$starttime;
                    774: if (($refresh-$runtime)<0) {
                    775:     print "document.status.submit();";
1.8       www       776: } else {
1.16      www       777:     my $refreshtime=int(1000*($refresh-$runtime));
1.11      www       778:     print "setTimeout('document.status.submit()',$refreshtime);\n".
                    779:           "document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'";
1.2       www       780: }
1.8       www       781: print "</script></body></html>";
                    782: exit 0;

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