#!/usr/bin/perl
$|=1;
# 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 $
#
# 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;
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;
}
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'}) {
$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'});
$stat_fromcache++;
}
}
unless ($reply) {
if ($hostname{$local}) {
my $ua=new LWP::UserAgent(timeout => 20);
my $request=new HTTP::Request('GET',
"http://".$hostname{$local}.$url);
my $response=$ua->request($request);
if ($response->is_success) {
$reply=$response->content;
chomp($reply);
} else {
$reply='local_error';
}
} else {
$reply='local_unknown';
}
&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{$remote}) { return 'remote_unknown'; }
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
sub replyhash {
my %returnhash=();
foreach (split(/\&/,&request(@_))) {
my ($name,$value)=split(/\=/,$_);
if ($name) {
unless ($value) { $value=''; }
$returnhash{$name}=$value;
}
}
return %returnhash;
}
# ================================================================ 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',&Apache::lonlocal::mt('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',&Apache::lonlocal::mt('Users')));
}
sub versions {
my $local=shift;
print(&otherwindow($local,'/cgi-bin/lonversions.pl',&Apache::lonlocal::mt('Versions')));
}
sub server {
my $local=shift;
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('
');
for (my $i=0;$i<$number;$i++) {
print "+";
}
print("
");
}
# ========================================================== Show server status
sub serverstatus {
my ($local,$trouble)=@_;
my $hostrole;
if (exists($libserv{$local})) {
$hostrole = 'library';
} else {
$hostrole = 'access';
}
my %lt = &Apache::lonlocal::texthash(
rero => 'Reroute:',
vers => 'Version:',
load => 'Load:',
acti => 'Active Users:',
rpms => 'RPMs',
mysq => 'MySQL Database:',
notc => 'Not connected',
lonc => 'loncron errors',
);
print(<