--- loncom/cgi/clusterstatus.pl 2002/02/18 23:45:23 1.1 +++ loncom/cgi/clusterstatus.pl 2003/08/05 12:52:23 1.15 @@ -2,73 +2,621 @@ $|=1; # The LearningOnline Network with CAPA # Cluster Status -# (Versions -# (Running loncron -# 09/06/01 Gerd Kortemeyer) -# 02/18/02 Gerd Kortemeyer) # +# $Id: clusterstatus.pl,v 1.15 2003/08/05 12:52:23 www Exp $ + +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + use LWP::UserAgent(); use HTTP::Headers; use IO::File; +my %host=(); +my $oneday=60*60*24; + +my %connectionstatus=(); +my %perlvar=(); + +my $mode; +my $concount=0; + +sub select_form { + my ($def,$name,%hash) = @_; + my $selectform = ""; + return $selectform; +} + + +sub key { + my ($local,$url)=@_; + my $key=$local.'_'.$url; + $key=~s/\W/\_/gs; + return $key; +} + +sub hidden { + my ($name,$value)=@_; + print "\n"; +} + +sub request { + my ($local,$url,$cachetime)=@_; + $cachetime*=(0.5+rand); + my $key=&key($local,$url); + my $reply=''; + if ($FORM{$key.'_time'}) { + if ((time-$FORM{$key.'_time'})<$cachetime) { + $reply=$FORM{$key}; + &hidden($key.'_time',$FORM{$key.'_time'}); + &hidden($key.'_fromcache',1); + } + } + unless ($reply) { + unless ($hostname{$local}) { + $reply='local_unknown'; + } else { + + my $ua=new LWP::UserAgent(timeout => 10); + + my $request=new HTTP::Request('GET', + "http://".$hostname{$local}.$url); + $request->authorization_basic('lonadm','litelite'); + + my $response=$ua->request($request); + + unless ($response->is_success) { + $reply='local_error'; + } else { + $reply=$response->content; + chomp($reply); + } + } + &hidden($key.'_time',time); + } + &hidden($key,$reply); + return $reply; +} + +# ============================================= Are local and remote connected? sub connected { my ($local,$remote)=@_; $local=~s/\W//g; $remote=~s/\W//g; - unless ($hostname{$local}) { return 'local_unknown'; } unless ($hostname{$remote}) { return 'remote_unknown'; } - - my $ua=new LWP::UserAgent; - - my $request=new HTTP::Request('GET', - "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote); - - my $response=$ua->request($request); - - unless ($response->is_success) { return 'local_offline'; } - - my $reply=$response->content; + my $url='/cgi-bin/ping.pl?'.$remote; +# +# Slowly phase this in: if not cached, only do 5 percent of the cases, +# but always do the first five. +# + unless ($FORM{&key($local,$url)}) { + unless (($concount<=5) || (rand>0.95)) { + return 'not_yet'; + } else { + $concount++; + } + } +# +# Actually do the query +# + &statuslist($local,'connecting '.$remote); + my $reply=&request($local,$url,3600); $reply=(split("\n",$reply))[0]; $reply=~s/\W//g; if ($reply ne $remote) { return $reply; } return 'ok'; } +# ============================================================ Get a reply hash - -print "Content-type: text/html\n\n". - "
\n"; -# ------------------------------------------------------------ Read access.conf -{ - my $config=IO::File->new("/etc/httpd/conf/access.conf"); +sub replyhash { + my %returnhash=(); + foreach (split(/\&/,&request(@_))) { + my ($name,$value)=split(/\=/,$_); + if ($name) { + unless ($value) { $value=''; } + $returnhash{$name}=$value; + } + } + return %returnhash; +} - while (my $configline=<$config>) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - $perlvar{$varname}=$varvalue; - } +# ================================================================ Link to host + +sub otherwindow { + my ($local,$url,$label)=@_; + return + " $label "; +} + +sub login { + my $local=shift; + print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'}, + 'Login'); +} + +sub runloncron { + my $local=shift; + print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron'); +} + +sub loncron { + my $local=shift; + print &otherwindow($local,'/lon-status','loncron'); +} + +sub lonc { + my $local=shift; + print &otherwindow($local,'/lon-status/loncstatus.txt','lonc'); +} + +sub lond { + my $local=shift; + print &otherwindow($local,'/lon-status/londstatus.txt','lond'); +} + +sub users { + my $local=shift; + print &otherwindow($local,'/cgi-bin/userstatus.pl','Users'); +} + +sub versions { + my $local=shift; + print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions'); +} + +sub server { + my $local=shift; + print &otherwindow($local,'/server-status','Server Status'); +} + +# ========================================================= Produce a green bar +sub bar { + my $parm=shift; + my $number=int($parm+0.5); + print ""; + for (my $i=0;$i<$number;$i++) { + print "+"; } - delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed - delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed + print " |
+$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})
+ $domaindescription{$hostdom{$local}} + |
+ENDHEADER + &login($local);&server($local);&users($local);&versions($local); + &loncron($local);&lond($local);&lonc($local);&runloncron($local); + print " |
$trouble |
";
+# version
+ if ($host{$local.'_version'}) {
+ print " Version: ".$host{$local.'_version'} + } +# load + if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) { + print " Load: ".$host{$local.'_load'} + } +# users + if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) { + print " Active Users: ".$host{$local.'_users'} + } + +# checkrpms + if ($host{$local.'_checkrpms'}) { + print " RPMs: ".$host{$local.'_checkrpms'} + } +# mysql + if ($host{$local.'_mysql'}) { + print " MySQL Database: ".$host{$local.'_mysql'} + } +# connections + if ($host{$local.'_notconnected'}) { + print " Not connected: "; + foreach (split(/ /,$host{$local.'_notconnected'})) { + if ($_) { + print " $_"; + } + } + } +# errors + if ($host{$local.'_errors'}) { + print " loncron errors: ".$host{$local.'_errors'}; + } + print " |