--- loncom/cgi/clusterstatus.pl 2002/02/18 23:45:23 1.1
+++ loncom/cgi/clusterstatus.pl 2003/07/30 21:20:16 1.8
@@ -5,70 +5,287 @@ $|=1;
# (Versions
# (Running loncron
# 09/06/01 Gerd Kortemeyer)
-# 02/18/02 Gerd Kortemeyer)
-#
+# 02/18/02,02/19/02 Gerd Kortemeyer)
+
+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=();
+
+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,1800);
$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;
- }
+# ========================================================== Show server status
+
+sub otherwindow {
+ my ($local,$url,$label)=@_;
+ return
+ "$label";
+}
+
+sub serverstatus {
+ my $local=shift;
+ print "\n
$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})
\n";
+# checkrpms
+ if ($host{$local.'_checkrpms'}) {
+ print "
RPMs: ".$host{$local.'_checkrpms'}
}
- delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
- delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
+# mysql
+ if ($host{$local.'_mysql'}) {
+ print "
MySQL Database: ".$host{$local.'_mysql'}
+ }
+}
+
+# ====================================================================== 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;
+# ================================================================ 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');
+my %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;
}
}
}
-print "Cluster Status
\n";
-print &connected('gerdl1','msul1');
+print "Cluster Status ".localtime()."
";
+print "\n";;
+print "";
+exit 0;