[BACK]Return to clusterstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi
File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.5: download - view: text, annotated - select for diffs
Mon Nov 18 15:11:41 2002 UTC (21 years, 5 months ago) by www
Branches: MAIN
CVS tags: version_0_6_2, version_0_6, HEAD
Avoid bug #429. Subroutine "online" short-circuit until we have figured out
Net::Ping.

#!/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)
# 5/11/2002 Scott Harrison

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>