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

1.1       www         1: #!/usr/bin/perl
                      2: $|=1;
                      3: # The LearningOnline Network with CAPA
                      4: # Cluster Status
                      5: # (Versions
                      6: # (Running loncron
                      7: # 09/06/01 Gerd Kortemeyer)
1.2       www         8: # 02/18/02,02/19/02 Gerd Kortemeyer)
1.3       harris41    9: 
                     10: use lib '/home/httpd/lib/perl/';
                     11: use LONCAPA::Configuration;
                     12: 
1.1       www        13: use LWP::UserAgent();
                     14: use HTTP::Headers;
                     15: use IO::File;
                     16: 
1.8     ! www        17: my %host=();
        !            18: my $oneday=60*60*24;
        !            19: 
        !            20: my %connectionstatus=();
        !            21: 
        !            22: sub key {
        !            23:     my ($local,$url)=@_;
        !            24:     my $key=$local.'_'.$url;
        !            25:     $key=~s/\W/\_/gs;
        !            26:     return $key;
        !            27: }
        !            28: 
        !            29: sub hidden {
        !            30:     my ($name,$value)=@_;
        !            31:     print "\n<input type='hidden' name='$name' value='$value' />";
        !            32: }
        !            33: 
        !            34: sub request {
        !            35:     my ($local,$url,$cachetime)=@_;
        !            36:     my $key=&key($local,$url);
        !            37:     my $reply='';
        !            38:     if ($FORM{$key.'_time'}) {
        !            39: 	if ((time-$FORM{$key.'_time'})<$cachetime) {
        !            40: 	    $reply=$FORM{$key};
        !            41: 	    &hidden($key.'_time',$FORM{$key.'_time'});
        !            42: 	    &hidden($key.'_fromcache',1);
        !            43: 	}
        !            44:     }
        !            45:     unless ($reply) {
        !            46: 	unless ($hostname{$local}) { 
        !            47: 	    $reply='local_unknown'; 
        !            48: 	} else {
        !            49: 
        !            50: 	    my $ua=new LWP::UserAgent(timeout => 20);
        !            51:     
        !            52: 	    my $request=new HTTP::Request('GET',
        !            53: 					  "http://".$hostname{$local}.$url);
        !            54: 	    $request->authorization_basic('lonadm','litelite');
        !            55: 
        !            56: 	    my $response=$ua->request($request);
        !            57: 
        !            58: 	    unless ($response->is_success) { 
        !            59: 		$reply='local_error'; 
        !            60: 	    } else {
        !            61: 		$reply=$response->content;
        !            62: 		chomp($reply);
        !            63: 	    }
        !            64: 	}
        !            65: 	&hidden($key.'_time',time);
        !            66:     }
        !            67:     &hidden($key,$reply);
        !            68:     return $reply;
        !            69: }
        !            70: 
        !            71: # ============================================= Are local and remote connected?
1.1       www        72: sub connected {
                     73:     my ($local,$remote)=@_;
                     74:     $local=~s/\W//g;
                     75:     $remote=~s/\W//g;
                     76: 
                     77:     unless ($hostname{$remote}) { return 'remote_unknown'; }
1.8     ! www        78:     my $url='/cgi-bin/ping.pl?'.$remote;
        !            79: #
        !            80: # Slowly phase this in: if not cached, only do 10 percent of the cases 
        !            81: #
        !            82:     unless ($FORM{&key($local,$url)}) {
        !            83: 	unless (rand>0.9) { return 'not_yet'; }
        !            84:     }
        !            85: #
        !            86: # Actually do the query
        !            87: #
        !            88:     &statuslist($local,'connecting '.$remote);
        !            89:     my $reply=&request($local,$url,1800);
        !            90:     $reply=(split("\n",$reply))[0];
        !            91:     $reply=~s/\W//g;
        !            92:     if ($reply ne $remote) { return $reply; }
        !            93:     return 'ok';
        !            94: }
        !            95: # ============================================================ Get a reply hash
        !            96: 
        !            97: sub replyhash {
        !            98:     my %returnhash=();
        !            99:     foreach (split(/\&/,&request(@_))) {
        !           100: 	my ($name,$value)=split(/\=/,$_);
        !           101: 	if ($name) {
        !           102: 	    unless ($value) { $value=''; }
        !           103: 	    $returnhash{$name}=$value;
        !           104: 	}
        !           105:     }
        !           106:     return %returnhash;
        !           107: }
1.1       www       108: 
1.8     ! www       109: # ========================================================== Show server status
1.1       www       110: 
1.8     ! www       111: sub otherwindow {
        !           112:     my ($local,$url,$label)=@_;
        !           113:     return
        !           114:   "<a href='http://$hostname{$local}$url' target='newwin$local'>$label</a>";
        !           115: }
1.1       www       116: 
1.8     ! www       117: sub serverstatus {
        !           118:     my $local=shift;
        !           119:     print "\n<hr /><h3>$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})</h3>\n";
        !           120: # checkrpms
        !           121:     if ($host{$local.'_checkrpms'}) {
        !           122: 	print "<br />RPMs: ".$host{$local.'_checkrpms'}
        !           123:     }
        !           124: # mysql
        !           125:     if ($host{$local.'_mysql'}) {
        !           126: 	print "<br />MySQL Database: ".$host{$local.'_mysql'}
        !           127:     }
        !           128: }
1.1       www       129: 
1.8     ! www       130: # ====================================================================== Status
        !           131: sub statuslist {
        !           132:     my ($local,$what)=@_;
        !           133:     print 
        !           134: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
1.1       www       135: }
                    136: 
1.8     ! www       137: #
        !           138: # Main program
        !           139: #
        !           140: # ========================================================= Get form parameters
        !           141: my $buffer;
        !           142: 
        !           143: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
        !           144: my @pairs=split(/&/,$buffer);
        !           145: my $pair; my $name; my $value;
        !           146: undef %FORM;
        !           147: %FORM=();
        !           148: foreach $pair (@pairs) {
        !           149:     ($name,$value) = split(/=/,$pair);
        !           150:     $value =~ tr/+/ /;
        !           151:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !           152:     $FORM{$name}=$value;
        !           153: } 
        !           154: 
        !           155: $buffer=$ENV{'QUERY_STRING'};
        !           156: @pairs=split(/&/,$buffer);
        !           157: foreach $pair (@pairs) {
        !           158:     ($name,$value) = split(/=/,$pair);
        !           159:     $value =~ tr/+/ /;
        !           160:     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !           161:     $FORM{$name}=$value;
        !           162: } 
        !           163: 
        !           164: # ====================================================== Determine refresh rate
        !           165: 
        !           166: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:60);
        !           167: if ($refresh<30) { $refresh=30; }
        !           168: my $starttime=time;
        !           169: # ================================================================ Send Headers
1.1       www       170: print "Content-type: text/html\n\n".
1.8     ! www       171:     "<html><body bgcolor=#FFFFFF>\n";
1.4       harris41  172: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
                    173: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
1.3       harris41  174: my %perlvar=%{$perlvarref};
                    175: undef $perlvarref; # remove since sensitive and not needed
                    176: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
                    177: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
1.1       www       178: 
                    179: # ------------------------------------------------------------- Read hosts file
                    180: {
                    181:     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
                    182: 
1.2       www       183:     $total=0;
1.1       www       184:     while (my $configline=<$config>) {
1.7       www       185:        $configline=~s/#.*$//;
                    186:        unless ($configline=~/\w/) { next; } 
1.1       www       187:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
                    188:        $hostname{$id}=$name;
                    189:        $hostdom{$id}=$domain;
                    190:        $hostrole{$id}=$role;
                    191:        $hostip{$id}=$ip;
1.2       www       192:        $total++;
1.1       www       193:        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
                    194: 	   $libserv{$id}=$name;
                    195:        }
                    196:     }
                    197: }
                    198: 
1.8     ! www       199: print "<h1>Cluster Status ".localtime()."</h1>";
        !           200: print "<form name='prgstat'>\n".
        !           201: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
        !           202: "</form>\n";;
        !           203: print "<form name='status' method='post'>\n";
        !           204: &hidden('refresh',$refresh);
        !           205: 
        !           206: # ==================================================== Main Loop over all Hosts
        !           207: 
        !           208: foreach $local (sort keys %hostname) {
        !           209: # -- Check general status
        !           210:     &statuslist($local,'General');
        !           211:     my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
        !           212:     if (defined($loncron{'local_error'})) {
        !           213: 	$host{$local.'_loncron'}='Could not determine.';
        !           214:     } else {
        !           215: 	if ((time-$loncron{'time'})>$oneday) {
        !           216: 	    $host{$local.'_loncron'}='Stale.';
        !           217: 	} else {
        !           218: 	}
        !           219:     }
        !           220: # -- Check user status
        !           221:     &statuslist($local,'Users');
        !           222:     my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
        !           223:     if (defined($userstatus{'local_error'})) {
        !           224: 	$host{$local.'_userstatus'}='Could not determine.';
        !           225:     } else {
        !           226:     }
        !           227: # -- Check mysql status
        !           228:     &statuslist($local,'Database');
        !           229:     my %mysql=&replyhash($local,'/lon-status/mysql.txt',1200);
        !           230:     if (defined($mysql{'local_error'})) {
        !           231: 	$host{$local.'_mysql'}='Could not determine.';
        !           232:     } else {
        !           233: 	if ((time-$mysql{'time'})>(7*$oneday)) {
        !           234: 	    if ($hostrole{$local} eq 'library') {
        !           235: 		$host{$local.'_mysql'}='Stale.';
        !           236: 		$host{$local.'_mysql_doomed'}=1;
        !           237: 	    }
        !           238: 	    if ($mysql{'mysql'} eq 'defunct') {
        !           239: 		$host{$local.'_mysql'}='Defunct (maybe stale).';
        !           240: 		$host{$local.'_mysql_doomed'}=2;
        !           241: 	    }
        !           242: 	} elsif ($mysql{'mysql'} eq 'defunct') {
        !           243: 	    $host{$local.'_mysql'}='Defunct.';
        !           244: 	    $host{$local.'_mysql_doomed'}=3;
        !           245: 	}
        !           246:     }
        !           247: # -- Check rpm status
        !           248:     &statuslist($local,'RPMs');
        !           249:     my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',2400);
        !           250:     if (defined($checkrpms{'local_error'})) {
        !           251: 	$host{$local.'_checkrpms'}='Could not determine.';
        !           252:     } else {
        !           253: 	if ((time-$checkrpms{'time'})>(4*$oneday)) {
        !           254: 	    $host{$local.'_checkrpms'}='Stale.';
        !           255: 	    $host{$local.'_checkrpms_doomed'}=50;
        !           256: 	} elsif ($checkrpms{'status'} eq 'fail') {
        !           257: 	    $host{$local.'_checkrpms'}='Could not checked RPMs.';
        !           258: 	    $host{$local.'_checkrpms_doomed'}=100;
        !           259: 	} elsif ($checkrpms{'rpmcount'}) {
        !           260: 	    $host{$local.'_checkrpms'}='Outdated RPMs: '.
        !           261: 		$checkrpms{'rpmcount'};
        !           262: 	    $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
        !           263: 	}
        !           264:     }
        !           265: # -- Check connections
        !           266:     &statuslist($local,'Connections');
        !           267:     $host{$local.'_notconnected'}='';
        !           268:     $host{$local.'_notconnected_doomed'}=0;
        !           269:     foreach $remote (sort keys %hostname) {
        !           270: 	my $status=&connected($local,$remote);
        !           271: 	$connectionstatus{$local.'_TO_'.$remote}=$status;
        !           272: 	unless (($status eq 'ok') || ($status eq 'not_yet')) {
        !           273: 	    $host{$local.'_notconnected'}.=' '.$remote;
        !           274: 	    $host{$local.'_notconnected_doomed'}++;
        !           275: 	}
        !           276:     }
        !           277: # Eventually, use doomed count
        !           278:     &serverstatus($local);
        !           279: }
        !           280: 
        !           281: # =============================================================== End Mail Loop
        !           282: print "</form><script>";
        !           283: $runtime=time-$starttime;
        !           284: if ($runtime>=$refresh) {
        !           285:     print 'document.status.submit();';
        !           286: } else {
        !           287:     $refreshtime=int(1000*($refresh-$runtime));
        !           288:     print "setTimeout('document.status.submit()',$refreshtime);";
1.2       www       289: }
1.8     ! www       290: print "</script></body></html>";
        !           291: exit 0;

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