--- loncom/cgi/clusterstatus.pl 2003/07/31 16:07:47 1.10 +++ loncom/cgi/clusterstatus.pl 2005/04/13 18:30:46 1.24 @@ -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.24 2005/04/13 18:30:46 albertel 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.10 2003/07/31 16:07:47 www Exp $ use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; +use strict; use LWP::UserAgent(); use HTTP::Headers; @@ -19,6 +41,32 @@ my %connectionstatus=(); 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) = @_; @@ -47,13 +95,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) { @@ -61,7 +122,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); @@ -91,10 +152,17 @@ 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 @@ -169,20 +237,81 @@ 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; + my $number=int($parm+0.5); + print "
"; + for (my $i=0;$i<$number;$i++) { + print "+"; + } + print " |
$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 " |
"; + print " |
$trouble |
";
+# re-routing
+ if ($host{$local.'_reroute'}) {
+ print " Reroute: ".$host{$local.'_reroute'}; + &takeonline($local); + } +# version + if ($host{$local.'_version'}) { + print " Version: ".$host{$local.'_version'} + } # load if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) { print " Load: ".$host{$local.'_load'} @@ -200,6 +329,21 @@ ENDHEADER if ($host{$local.'_mysql'}) { print " MySQL Database: ".$host{$local.'_mysql'} } +# connections + if ($host{$local.'_notconnected'}) { + print " Not connected: "; + foreach (split(/ /,$host{$local.'_notconnected'})) { + if ($_) { + print " $_"; + } + } + } +# errors + if ($host{$local.'_errors'}) { + print " loncron errors: ".$host{$local.'_errors'}; + } + print " |
"; + &allreroutes($local); print " |