#!/usr/bin/perl
$|=1;
# The LearningOnline Network with CAPA
# Cluster Status
# (Versions
# (Running loncron
# 09/06/01 Gerd Kortemeyer)
# 02/18/02,02/19/02 Gerd Kortemeyer)
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use LWP::UserAgent();
use HTTP::Headers;
use IO::File;
use Net::Ping;
sub online {
my $host=shift;
return 1;
# ping is broken
my $p=Net::Ping->new("tcp",10);
my $online=$p->ping("$host");
$p->close();
undef ($p);
return $online;
}
sub connected {
my ($local,$remote)=@_;
$local=~s/\W//g;
$remote=~s/\W//g;
unless ($hostname{$local}) { return 'local_unknown'; }
unless ($hostname{$remote}) { return 'remote_unknown'; }
unless (&online($hostname{$local})) { return 'local_offline'; }
my $ua=new LWP::UserAgent;
my $request=new HTTP::Request('GET',
"http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote);
my $response=$ua->request($request);
unless ($response->is_success) { return 'local_error'; }
my $reply=$response->content;
$reply=(split("\n",$reply))[0];
$reply=~s/\W//g;
if ($reply ne $remote) { return $reply; }
return 'ok';
}
print "Content-type: text/html\n\n".
"<html><body bgcolor=#FFFFFF>\n";
# -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
my %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>) {
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;
}
}
}
print
"<h1>Cluster Status</h1>";
print "Please be patient while building cluster status ...<p>\n";
$table='';
$table.="<table border=2><tr><th rowspan=2>From (local)</th>".
"<th colspan=$total>To (remote)</th></tr><tr>";
foreach $remote (sort keys %hostname) {
$table.="<th";
if ($remote eq $perlvar{'lonHostID'}) {
$table.=" bgcolor=#CCFFBB";
} else {
if ($libserv{$remote}) { $table.=" bgcolor=#FFFF99"; }
}
$table.=
"><a href=http://".$hostname{$remote}."/lon-status/>$remote</a></th>";
}
$table.="</tr>";
foreach $local (sort keys %hostname) {
print "Checking $local ";
$table.="<tr><td";
if ($local eq $perlvar{'lonHostID'}) {
$table.=" bgcolor=#CCFFBB";
} else {
if ($libserv{$local}) { $table.=" bgcolor=#FFFF99"; }
}
$table.=
"><b><a href=http://".$hostname{$local}."/lon-status/>$local</a></b><br>".
$hostrole{$local}.' '.$hostdom{$local}.'<br>'.
"<tt><a href=http://".$hostname{$local}."/server-status/>".
$hostname{$local}."</a></tt><br>".
"<a href=http://".$hostname{$local}."/cgi-bin/loncron.pl>New Report</a>".
"</td>";
if (&online($hostname{$local})) {
foreach $remote (sort keys %hostname) {
$status=&connected($local,$remote);
if ($status eq 'ok') {
$table.="<td";
if ($libserv{$remote}) {
if ($libserv{$local}) {
$table.=" bgcolor=#FFFF44";
} else {
$table.=" bgcolor=#FFFF99";
}
} elsif ($libserv{$local}) {
$table.=" bgcolor=#FFFF99";
}
$table.="><b><font color=#00FF00>OK</font></b></td>";
print ".";
} else {
print "X";
$table.="<td><b><font color=#FF0000>".$status."</font></b><br>".
"<a href=http://".$hostname{$local}.
"/lon-status/loncstatus.txt>lonc</a>";
if (&online($hostname{$remote})) {
$table.=" <a href=http://".$hostname{$remote}.
"/lon-status/londstatus.txt>lond</a>".
"</td>";
} else {
$table.=' offline';
}
}
}
} else {
print "offline";
$table.='<th colspan='.$total.'><font color=#FF0000>Offline</font></th>';
}
$table.="</tr>\n";
print "<br>\n";
}
$table.="</table>";
print $table;
print "</body></html>";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>