--- loncom/cgi/clusterstatus.pl 2003/08/01 14:47:44 1.13 +++ loncom/cgi/clusterstatus.pl 2009/01/15 22:34:18 1.27 @@ -1,17 +1,45 @@ #!/usr/bin/perl $|=1; -# The LearningOnline Network with CAPA -# Cluster Status +# Generates a html page showing various status reports about the domain or cluster +# $Id: clusterstatus.pl,v 1.27 2009/01/15 22:34:18 raeburn Exp $ # -# $Id: clusterstatus.pl,v 1.13 2003/08/01 14:47:44 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/ +# + +use strict; use lib '/home/httpd/lib/perl/'; +use Apache::lonnet; +use Apache::lonlocal; use LONCAPA::Configuration; - +use LONCAPA::loncgi; +use LONCAPA::lonauthcgi; use LWP::UserAgent(); use HTTP::Headers; use IO::File; +my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf'); + my %host=(); my $oneday=60*60*24; @@ -19,14 +47,37 @@ my %connectionstatus=(); my %perlvar=(); my $mode; +my $concount=0; +my $fromcache; + +my %domaininfo = &Apache::lonnet::domain_info(); +my %allhostname = &Apache::lonnet::all_hostnames(); +my (%hostname,%hostip); +my %hostdom = &Apache::lonnet::all_host_domain(); +my %iphost = &Apache::lonnet::get_iphost(); +my %libserv= &Apache::lonnet::all_library(); + +foreach my $ip (keys(%iphost)) { + $hostip{$iphost{$ip}} = $ip; +} + +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; @@ -42,7 +93,7 @@ sub key { sub hidden { my ($name,$value)=@_; - print "\n"; + print("\n"); } sub request { @@ -50,33 +101,40 @@ 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'}) { + $stat_fromcache++; + return $FORM{$key}; + } else { + $stat_notyet++; + return 'not_yet'; + } + } +# 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) { - unless ($hostname{$local}) { - $reply='local_unknown'; - } else { - - my $ua=new LWP::UserAgent(timeout => 15); - + if ($hostname{$local}) { + my $ua=new LWP::UserAgent(timeout => 20); my $request=new HTTP::Request('GET', "http://".$hostname{$local}.$url); - $request->authorization_basic('lonadm','litelite'); - my $response=$ua->request($request); - - unless ($response->is_success) { + if ($response->is_success) { + $reply=$response->content; + chomp($reply); + } else { $reply='local_error'; - } else { - $reply=$response->content; - chomp($reply); } - } + } else { + $reply='local_unknown'; + } &hidden($key.'_time',time); } &hidden($key,$reply); @@ -92,10 +150,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.95) { return 'not_yet'; } + unless (($concount<=5) || (rand>0.95)) { + $stat_total++; + $stat_notyet++; + return 'not_yet'; + } else { + $concount++; + } } # # Actually do the query @@ -131,105 +196,171 @@ sub otherwindow { sub login { my $local=shift; - print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'}, - 'Login'); + print(&otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'}, + 'Login')); } sub runloncron { my $local=shift; - print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron'); + print(&otherwindow($local,'/cgi-bin/loncron.pl',&Apache::lonlocal::mt('Run loncron'))); } sub loncron { my $local=shift; - print &otherwindow($local,'/lon-status','loncron'); + print(&otherwindow($local,'/lon-status','loncron')); } sub lonc { my $local=shift; - print &otherwindow($local,'/lon-status/loncstatus.txt','lonc'); + print(&otherwindow($local,'/lon-status/loncstatus.txt','lonc')); } sub lond { my $local=shift; - print &otherwindow($local,'/lon-status/londstatus.txt','lond'); + print(&otherwindow($local,'/lon-status/londstatus.txt','lond')); } sub users { my $local=shift; - print &otherwindow($local,'/cgi-bin/userstatus.pl','Users'); + print(&otherwindow($local,'/cgi-bin/userstatus.pl',&Apache::lonlocal::mt('Users'))); } sub versions { my $local=shift; - print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions'); + print(&otherwindow($local,'/cgi-bin/lonversions.pl',&Apache::lonlocal::mt('Versions'))); } sub server { my $local=shift; - print &otherwindow($local,'/server-status','Server Status'); + print(&otherwindow($local,'/server-status',&Apache::lonlocal::mt('Server Status'))); +} + +sub announcement { + my $local=shift; + print(&otherwindow($local,'/announcement.txt',&Apache::lonlocal::mt('Announcement'))); +} + +sub takeonline { + my $local=shift; + print(&otherwindow($local,'/cgi-bin/takeonline.pl',&Apache::lonlocal::mt('Take online'))); +} + +sub takeoffline { + my $local=shift; + print(&otherwindow($local,'/cgi-bin/takeoffline.pl',&Apache::lonlocal::mt('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); + my $reroute; + foreach my $remote (sort(keys(%hostname))) { + unless ($local eq $remote) { + $reroute .= &reroute($local,$remote); + } + } + if ($reroute) { + print(&Apache::lonlocal::mt('Reroute to:').' '.$reroute.''); + } } # ========================================================= Produce a green bar sub bar { my $parm=shift; my $number=int($parm+0.5); - print "
";
+ print('
|
-$local $hostdom{$local} ($hostname{$local}; $hostrole{$local})
- $domaindescription{$hostdom{$local}} +$local $hostdom{$local} ($hostname{$local}); $hostrole + $domaininfo{$hostdom{$local}}{'description'} +$domaininfo{$hostdom{$local}}{'city'} |
ENDHEADER &login($local);&server($local);&users($local);&versions($local); + &announcement($local); &loncron($local);&lond($local);&lonc($local);&runloncron($local); - print " |
$trouble |
$trouble |
");
+# re-routing
+ if ($host{$local.'_reroute'}) {
+ print(' '.$lt{'rero'}.' '.$host{$local.'_reroute'}); + &takeonline($local); + } +# version + if ($host{$local.'_version'}) { + print(' '.$lt{'vers'}.' '.$host{$local.'_version'}); } - print " |
";
# load
if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
- print " Load: ".$host{$local.'_load'} + print(' '.$lt{'load'}.' '.$host{$local.'_load'}); } # users if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) { - print " Active Users: ".$host{$local.'_users'} + print(' '.$lt{'acti'}.' '.$host{$local.'_users'}); } # checkrpms if ($host{$local.'_checkrpms'}) { - print " RPMs: ".$host{$local.'_checkrpms'} + print(' '.$lt{'rpms'}.' '.$host{$local.'_checkrpms'}); } # mysql if ($host{$local.'_mysql'}) { - print " MySQL Database: ".$host{$local.'_mysql'} + print(' '.$lt{'mysq'}.' '.$host{$local.'_mysql'}); } # connections if ($host{$local.'_notconnected'}) { - print " Not connected: "; - foreach (split(/ /,$host{$local.'_notconnected'})) { - if ($_) { - print " $_"; + print(' '.$lt{'notc'}.' '); + foreach my $item (split(/ /,$host{$local.'_notconnected'})) { + if ($item) { + print(' '.$item.''); } } } # errors if ($host{$local.'_errors'}) { - print " loncron errors: ".$host{$local.'_errors'}; + print(' '.$lt{'lonc'}.' '.$host{$local.'_errors'}); } + print " |
"; + &allreroutes($local); print " |