--- loncom/cgi/clusterstatus.pl 2002/02/18 23:45:23 1.1
+++ loncom/cgi/clusterstatus.pl 2003/07/31 16:07:47 1.10
@@ -2,73 +2,468 @@
$|=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.10 2003/07/31 16:07:47 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;
+
+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)=@_;
+ 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 => 20);
+
+ 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 10 percent of the cases
+#
+ unless ($FORM{&key($local,$url)}) {
+ unless (rand>0.9) { return 'not_yet'; }
+ }
+#
+# 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');
+}
+
+# ========================================================== Show server status
+
+sub serverstatus {
+ my $local=shift;
+ 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 " |
";
+# 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'}
+ }
+ print " |
";
+}
+
+# =========================================================== Doomedness sorted
+
+sub doomedness {
+ my $crit=shift;
+ my %alldoomed=();
+ my @allhosts=();
+ foreach (keys %host) {
+ if ($_=~/^(\w+)\_$crit$/) {
+ if ($host{$_}) {
+ push (@allhosts,$1);
+ $alldoomed{$1}=$host{$_};
+ }
+ }
}
- delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
- delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
+ 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'}:60);
+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',
+ '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;
}
}
}
+# ------------------------------------------------------------ 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 "Cluster Status
\n";
-print &connected('gerdl1','msul1');
-print "";
+print "LON-CAPA Cluster Status ".localtime()."
";
+print "\n";;
+print "";
+exit 0;