--- loncom/cgi/clusterstatus.pl 2002/02/18 23:45:23 1.1
+++ loncom/cgi/clusterstatus.pl 2003/08/05 18:33:08 1.16
@@ -2,61 +2,628 @@
$|=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.16 2003/08/05 18:33:08 www Exp $
+
+use lib '/home/httpd/lib/perl/';
+use LONCAPA::Configuration;
+use strict;
+
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;
+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)=@_;
+ 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='';
+ $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'});
+ $stat_fromcache++;
+ }
+ }
+ 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)) {
+ $stat_total++;
+ $stat_notyet++;
+ 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 "
";
}
+# ========================================================== Show server status
+
+sub serverstatus {
+ my ($local,$trouble)=@_;
+ print (<
+