--- loncom/cgi/clusterstatus.pl 2003/08/05 12:52:23 1.15 +++ loncom/cgi/clusterstatus.pl 2003/08/05 18:47:21 1.17 @@ -3,10 +3,11 @@ $|=1; # The LearningOnline Network with CAPA # Cluster Status # -# $Id: clusterstatus.pl,v 1.15 2003/08/05 12:52:23 www Exp $ +# $Id: clusterstatus.pl,v 1.17 2003/08/05 18:47:21 www Exp $ use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; +use strict; use LWP::UserAgent(); use HTTP::Headers; @@ -20,6 +21,27 @@ my %perlvar=(); my $mode; my $concount=0; +my $fromcache; + +my %domaindescription = (); +my %domain_auth_def = (); +my %domain_auth_arg_def = (); + +my %hostname=(); +my %hostip=(); +my %hostdom=(); +my %hostrole=(); +my %libserv=(); + +my $maxusers=0; +my $maxload=0; +my $totalusers=0; + +my %FORM=(); + +my $stat_total=0; +my $stat_notyet=0; +my $stat_fromcache=0; sub select_form { my ($def,$name,%hash) = @_; @@ -51,11 +73,23 @@ sub request { $cachetime*=(0.5+rand); my $key=&key($local,$url); my $reply=''; + $stat_total++; +# if fromcache flag is set, only return cached values + if ($fromcache) { + if ($FORM{$key.'_time'}) { + return $FORM{$key}; + $stat_fromcache++; + } else { + return 'not_yet'; + $stat_notyet++; + } + } +# normal mode, refresh when expired or not yet present if ($FORM{$key.'_time'}) { if ((time-$FORM{$key.'_time'})<$cachetime) { $reply=$FORM{$key}; &hidden($key.'_time',$FORM{$key.'_time'}); - &hidden($key.'_fromcache',1); + $stat_fromcache++; } } unless ($reply) { @@ -97,7 +131,9 @@ sub connected { # but always do the first five. # unless ($FORM{&key($local,$url)}) { - unless (($concount<=5) || (rand>0.95)) { + unless (($concount<=5) || (rand>0.95)) { + $stat_total++; + $stat_notyet++; return 'not_yet'; } else { $concount++; @@ -260,125 +296,23 @@ sub doomedness { return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts; } -# ====================================================================== Status -sub statuslist { - my ($local,$what)=@_; - print -"\n"; -} - -# -# Main program -# -# ========================================================= Get form parameters -my $buffer; - -read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); -my @pairs=split(/&/,$buffer); -my $pair; my $name; my $value; -undef %FORM; -%FORM=(); -foreach $pair (@pairs) { - ($name,$value) = split(/=/,$pair); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - $FORM{$name}=$value; -} - -$buffer=$ENV{'QUERY_STRING'}; -@pairs=split(/&/,$buffer); -foreach $pair (@pairs) { - ($name,$value) = split(/=/,$pair); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - $FORM{$name}=$value; -} - -# ====================================================== Determine refresh rate - -my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:120); -if ($refresh<30) { $refresh=30; } -my $starttime=time; - -# ============================================================== Determine mode - -my %modes=('trouble' => 'Trouble', - 'users_doomed' => 'Doomed: Users', - 'loncron_doomed' => 'Doomed: General (loncron)', - 'mysql_doomed' => 'Doomed: Database (mysql)', - 'notconnected_doomed' => 'Doomed: Connections', - 'checkrpms_doomed' => 'Doomed: RPMs', - 'load_doomed' => 'Doomed: Load', - 'unresponsive_doomed' => 'Doomed: Status could not be determined', - 'users' => 'User Report', - 'load' => 'Load Report', - 'connections' => 'Connections Matrix'); - -$mode=$FORM{'mode'}; -unless ($modes{$mode}) { $mode='trouble'; } -# ================================================================ Send Headers -print "Content-type: text/html\n\n". - "
\n"; -# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf). -my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); -%perlvar=%{$perlvarref}; -undef $perlvarref; # remove since sensitive and not needed -delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed -delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed - -# ------------------------------------------------------------- Read hosts file -{ - my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab"); - - $total=0; - while (my $configline=<$config>) { - $configline=~s/#.*$//; - unless ($configline=~/\w/) { next; } - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - $hostname{$id}=$name; - $hostdom{$id}=$domain; - $hostrole{$id}=$role; - $hostip{$id}=$ip; - $total++; - if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { - $libserv{$id}=$name; - } - } +sub resetvars { + $maxusers=0; + $maxload=0; + $totalusers=0; + $stat_total=0; + $stat_notyet=0; + $stat_fromcache=0; + $concount=0; + undef %host; + %host=(); } -# ------------------------------------------------------------ Read domain file -{ - my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab'); - %domaindescription = (); - %domain_auth_def = (); - %domain_auth_arg_def = (); - if ($fh) { - while (<$fh>) { - next if (/^(\#|\s*$)/); - chomp; - my ($domain, $domain_description, $def_auth, $def_auth_arg) - = split(/:/,$_,4); - $domain_auth_def{$domain}=$def_auth; - $domain_auth_arg_def{$domain}=$def_auth_arg; - $domaindescription{$domain}=$domain_description; - } - } -} - -print "