--- loncom/cgi/clusterstatus.pl 2003/08/05 18:33:08 1.16 +++ loncom/cgi/clusterstatus.pl 2003/09/14 19:00:03 1.23 @@ -1,9 +1,30 @@ #!/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.16 2003/08/05 18:33:08 www Exp $ use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; @@ -26,6 +47,10 @@ 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=(); @@ -212,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; @@ -233,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'} @@ -276,6 +342,8 @@ ENDHEADER if ($host{$local.'_errors'}) { print "
loncron errors: ".$host{$local.'_errors'}; } + print ""; + &allreroutes($local); print "
"; } @@ -303,7 +371,7 @@ sub resetvars { $stat_total=0; $stat_notyet=0; $stat_fromcache=0; - + $concount=0; undef %host; %host=(); } @@ -361,6 +429,19 @@ foreach my $local (sort keys %hostname) } $host{$local.'_load'}=$userstatus{'loadavg'}; } +# -- Check reroute status + &statuslist($local,'Reroute'); + my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800); + if ($reroute{'status'} eq 'rerouting') { + if ($reroute{'server'}) { + $host{$local.'_reroute'}= + 'Rerouting to '.$reroute{'server'}. + ', domain: '.$reroute{'domain'}. + ' (since '.localtime($reroute{'time'}).')'; + } else { + $host{$local.'_reroute'}='offline'; + } + } # -- Check mysql status &statuslist($local,'Database'); my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600); @@ -431,12 +512,12 @@ sub reports { "". ""; foreach my $remote (sort keys %hostname) { - print ''; + print ''; } print "\n"; # connection matrix foreach my $local (sort keys %hostname) { - print ''; + print ''; foreach my $remote (sort keys %hostname) { if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') { my $cellcolor='#FFFFFF'; @@ -448,7 +529,7 @@ sub reports { print ''; } else { - my $cellcolor='#DDBBBB'; + my $cellcolor='#DDCCAA'; if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') { if ($local eq $remote) { $cellcolor='#DD88AA'; @@ -456,7 +537,7 @@ sub reports { $cellcolor='#DDAACC'; } } else { - if ($local eq $remote) { $cellcolor='#DD9999'; } + if ($local eq $remote) { $cellcolor='#DDBB77'; } } print '
 '.$remote.''.$remote.'
'.$local.'
'.$local.'ok'. @@ -544,6 +625,9 @@ sub reports { if ($host{$local.'_checkrpms_doomed'}>100) { $trouble='RPMs outdated.
'; } + if ($host{$local.'_reroute'}) { + $trouble='Rerouting
'; + } if ($trouble) { $count++; &serverstatus($local,$trouble); } } unless ($count) { print "No mayor trouble."; } @@ -641,11 +725,15 @@ delete $perlvar{'lonSqlAccess'}; # remov while (<$fh>) { next if (/^(\#|\s*$)/); chomp; - my ($domain, $domain_description, $def_auth, $def_auth_arg) - = split(/:/,$_,4); - $domain_auth_def{$domain}=$def_auth; + my ($domain, $domain_description, $def_auth, $def_auth_arg, + $def_lang, $city, $longi, $lati) = split(/:/,$_); + $domain_auth_def{$domain}=$def_auth; $domain_auth_arg_def{$domain}=$def_auth_arg; - $domaindescription{$domain}=$domain_description; + $domaindescription{$domain}=$domain_description; + $domain_lang_def{$domain}=$def_lang; + $domain_city{$domain}=$city; + $domain_longi{$domain}=$longi; + $domain_lati{$domain}=$lati; } } }