--- loncom/cgi/clusterstatus.pl 2003/07/30 21:20:16 1.8
+++ loncom/cgi/clusterstatus.pl 2003/08/13 21:41:47 1.18
@@ -2,13 +2,12 @@
$|=1;
# The LearningOnline Network with CAPA
# Cluster Status
-# (Versions
-# (Running loncron
-# 09/06/01 Gerd Kortemeyer)
-# 02/18/02,02/19/02 Gerd Kortemeyer)
+#
+# $Id: clusterstatus.pl,v 1.18 2003/08/13 21:41:47 www Exp $
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
+use strict;
use LWP::UserAgent();
use HTTP::Headers;
@@ -18,6 +17,44 @@ my %host=();
my $oneday=60*60*24;
my %connectionstatus=();
+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) = @_;
+ my $selectform = "";
+ return $selectform;
+}
+
sub key {
my ($local,$url)=@_;
@@ -33,13 +70,26 @@ sub hidden {
sub request {
my ($local,$url,$cachetime)=@_;
+ $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) {
@@ -47,7 +97,7 @@ sub request {
$reply='local_unknown';
} else {
- my $ua=new LWP::UserAgent(timeout => 20);
+ my $ua=new LWP::UserAgent(timeout => 10);
my $request=new HTTP::Request('GET',
"http://".$hostname{$local}.$url);
@@ -77,16 +127,23 @@ sub connected {
unless ($hostname{$remote}) { return 'remote_unknown'; }
my $url='/cgi-bin/ping.pl?'.$remote;
#
-# Slowly phase this in: if not cached, only do 10 percent of the cases
+# 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 (rand>0.9) { return 'not_yet'; }
+ unless (($concount<=5) || (rand>0.95)) {
+ $stat_total++;
+ $stat_notyet++;
+ return 'not_yet';
+ } else {
+ $concount++;
+ }
}
#
# Actually do the query
#
&statuslist($local,'connecting '.$remote);
- my $reply=&request($local,$url,1800);
+ my $reply=&request($local,$url,3600);
$reply=(split("\n",$reply))[0];
$reply=~s/\W//g;
if ($reply ne $remote) { return $reply; }
@@ -106,129 +163,216 @@ sub replyhash {
return %returnhash;
}
-# ========================================================== Show server status
+# ================================================================ Link to host
sub otherwindow {
my ($local,$url,$label)=@_;
return
- "$label";
+ " $label ";
}
-sub serverstatus {
+sub login {
my $local=shift;
- print "\n
$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})
\n";
-# checkrpms
- if ($host{$local.'_checkrpms'}) {
- print "
RPMs: ".$host{$local.'_checkrpms'}
- }
-# mysql
- if ($host{$local.'_mysql'}) {
- print "
MySQL Database: ".$host{$local.'_mysql'}
- }
+ print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
+ 'Login');
}
-# ====================================================================== Status
-sub statuslist {
- my ($local,$what)=@_;
- print
-"\n";
+sub runloncron {
+ my $local=shift;
+ print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron');
}
-#
-# Main program
-#
-# ========================================================= Get form parameters
-my $buffer;
+sub loncron {
+ my $local=shift;
+ print &otherwindow($local,'/lon-status','loncron');
+}
-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;
-}
+sub lonc {
+ my $local=shift;
+ print &otherwindow($local,'/lon-status/loncstatus.txt','lonc');
+}
-$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;
-}
+sub lond {
+ my $local=shift;
+ print &otherwindow($local,'/lon-status/londstatus.txt','lond');
+}
-# ====================================================== Determine refresh rate
+sub users {
+ my $local=shift;
+ print &otherwindow($local,'/cgi-bin/userstatus.pl','Users');
+}
-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
+sub versions {
+ my $local=shift;
+ print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions');
+}
-# ------------------------------------------------------------- Read hosts file
-{
- my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
+sub server {
+ my $local=shift;
+ print &otherwindow($local,'/server-status','Server Status');
+}
- $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 announcement {
+ my $local=shift;
+ print &otherwindow($local,'/announcement.txt','Announcement');
+}
+
+# ========================================================= Produce a green bar
+sub bar {
+ my $parm=shift;
+ my $number=int($parm+0.5);
+ print "";
+ for (my $i=0;$i<$number;$i++) {
+ print "+";
}
+ print " |
";
}
-print "Cluster Status ".localtime()."
";
-print "\n";;
-print "\n";;
+print "";
exit 0;