--- loncom/cgi/clusterstatus.pl 2003/08/05 12:52:23 1.15
+++ loncom/cgi/clusterstatus.pl 2003/09/14 19:00:03 1.23
@@ -1,12 +1,34 @@
#!/usr/bin/perl
$|=1;
-# The LearningOnline Network with CAPA
-# Cluster Status
+# Generates a html page showing various sataus reports about the cluster
+# $Id: clusterstatus.pl,v 1.23 2003/09/14 19:00:03 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
#
-# $Id: clusterstatus.pl,v 1.15 2003/08/05 12:52:23 www Exp $
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
+use strict;
use LWP::UserAgent();
use HTTP::Headers;
@@ -20,6 +42,31 @@ my %perlvar=();
my $mode;
my $concount=0;
+my $fromcache;
+
+my %domaindescription = ();
+my %domain_auth_def = ();
+my %domain_auth_arg_def = ();
+my %domain_lang_def=();
+my %domain_city=();
+my %domain_longi=();
+my %domain_lati=();
+
+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) = @_;
@@ -51,11 +98,23 @@ sub request {
$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) {
@@ -97,7 +156,9 @@ sub connected {
# but always do the first five.
#
unless ($FORM{&key($local,$url)}) {
- unless (($concount<=5) || (rand>0.95)) {
+ unless (($concount<=5) || (rand>0.95)) {
+ $stat_total++;
+ $stat_notyet++;
return 'not_yet';
} else {
$concount++;
@@ -176,6 +237,40 @@ sub server {
print &otherwindow($local,'/server-status','Server Status');
}
+sub announcement {
+ my $local=shift;
+ print &otherwindow($local,'/announcement.txt','Announcement');
+}
+
+sub takeonline {
+ my $local=shift;
+ print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online');
+}
+
+sub takeoffline {
+ my $local=shift;
+ print &otherwindow($local,'/cgi-bin/takeoffline.pl','Take offline');
+}
+
+sub reroute {
+ my ($local,$remote)=@_;
+ print &otherwindow($local,'/cgi-bin/takeoffline.pl?'.
+ $hostname{$remote}.'&'.$hostdom{$local}
+ ,$remote)."\n";
+}
+
+sub allreroutes {
+ my $local=shift;
+ &takeoffline($local);
+ print ' Reroute to: ';
+ foreach my $remote (sort keys %hostname) {
+ unless ($local eq $remote) {
+ &reroute($local,$remote);
+ }
+ }
+ print '';
+}
+
# ========================================================= Produce a green bar
sub bar {
my $parm=shift;
@@ -197,15 +292,22 @@ sub serverstatus {
$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})
$domaindescription{$hostdom{$local}}
+$domain_city{$hostdom{$local}}
|
ENDHEADER
&login($local);&server($local);&users($local);&versions($local);
+ &announcement($local);
&loncron($local);&lond($local);&lonc($local);&runloncron($local);
print " |
";
if ($trouble) {
print ("$trouble |
");
}
print "";
+# re-routing
+ if ($host{$local.'_reroute'}) {
+ print " Reroute: ".$host{$local.'_reroute'};
+ &takeonline($local);
+ }
# version
if ($host{$local.'_version'}) {
print " Version: ".$host{$local.'_version'}
@@ -240,6 +342,8 @@ ENDHEADER
if ($host{$local.'_errors'}) {
print " loncron errors: ".$host{$local.'_errors'};
}
+ print " |
";
+ &allreroutes($local);
print " |
";
}
@@ -260,125 +364,23 @@ sub doomedness {
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'}:120);
-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',
- 'load' => 'Load 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;
- }
- }
+sub resetvars {
+ $maxusers=0;
+ $maxload=0;
+ $totalusers=0;
+ $stat_total=0;
+ $stat_notyet=0;
+ $stat_fromcache=0;
+ $concount=0;
+ undef %host;
+ %host=();
}
-print "LON-CAPA Cluster Status ".localtime()."
";
-print "\n";;
-print "