[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, 6 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.

    1: #!/usr/bin/perl
    2: $|=1;
    3: # The LearningOnline Network with CAPA
    4: # Cluster Status
    5: # (Versions
    6: # (Running loncron
    7: # 09/06/01 Gerd Kortemeyer)
    8: # 02/18/02,02/19/02 Gerd Kortemeyer)
    9: # 5/11/2002 Scott Harrison
   10: 
   11: use lib '/home/httpd/lib/perl/';
   12: use LONCAPA::Configuration;
   13: 
   14: use LWP::UserAgent();
   15: use HTTP::Headers;
   16: use IO::File;
   17: use Net::Ping;
   18: 
   19: sub online {
   20:     my $host=shift;
   21:     return 1;
   22: # ping is broken
   23:     my $p=Net::Ping->new("tcp",10);
   24:     my $online=$p->ping("$host");
   25:     $p->close();
   26:     undef ($p);
   27:     return $online;
   28: }
   29: 
   30: sub connected {
   31:     my ($local,$remote)=@_;
   32:     $local=~s/\W//g;
   33:     $remote=~s/\W//g;
   34: 
   35:     unless ($hostname{$local}) { return 'local_unknown'; }
   36:     unless ($hostname{$remote}) { return 'remote_unknown'; }
   37: 
   38:     unless (&online($hostname{$local})) { return 'local_offline'; }
   39: 
   40:     my $ua=new LWP::UserAgent;
   41:     
   42:     my $request=new HTTP::Request('GET',
   43:       "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote);
   44: 
   45:     my $response=$ua->request($request);
   46: 
   47:     unless ($response->is_success) { return 'local_error'; }
   48: 
   49:     my $reply=$response->content;
   50:     $reply=(split("\n",$reply))[0];
   51:     $reply=~s/\W//g;
   52:     if ($reply ne $remote) { return $reply; }
   53:     return 'ok';
   54: }
   55: 
   56:  
   57: print "Content-type: text/html\n\n".
   58:       "<html><body bgcolor=#FFFFFF>\n";
   59: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
   60: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
   61: my %perlvar=%{$perlvarref};
   62: undef $perlvarref; # remove since sensitive and not needed
   63: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
   64: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
   65: 
   66: # ------------------------------------------------------------- Read hosts file
   67: {
   68:     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
   69: 
   70:     $total=0;
   71:     while (my $configline=<$config>) {
   72:        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
   73:        $hostname{$id}=$name;
   74:        $hostdom{$id}=$domain;
   75:        $hostrole{$id}=$role;
   76:        $hostip{$id}=$ip;
   77:        $total++;
   78:        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
   79: 	   $libserv{$id}=$name;
   80:        }
   81:     }
   82: }
   83: 
   84: print 
   85: "<h1>Cluster Status</h1>";
   86: print "Please be patient while building cluster status ...<p>\n";
   87: $table='';
   88: 
   89: $table.="<table border=2><tr><th rowspan=2>From (local)</th>".
   90: "<th colspan=$total>To (remote)</th></tr><tr>";
   91: foreach $remote (sort keys %hostname) {
   92:    $table.="<th";
   93:    if ($remote eq $perlvar{'lonHostID'}) {
   94:        $table.=" bgcolor=#CCFFBB";
   95:    } else {
   96:        if ($libserv{$remote}) { $table.=" bgcolor=#FFFF99"; }
   97:    }
   98:    $table.=
   99:  "><a href=http://".$hostname{$remote}."/lon-status/>$remote</a></th>";
  100: }
  101: $table.="</tr>";
  102: foreach $local (sort keys %hostname) {
  103:     print "Checking $local ";
  104:    $table.="<tr><td";
  105:    if ($local eq $perlvar{'lonHostID'}) {
  106:        $table.=" bgcolor=#CCFFBB";
  107:    } else {
  108:        if ($libserv{$local}) { $table.=" bgcolor=#FFFF99"; }
  109:    }
  110:    $table.=
  111:  "><b><a href=http://".$hostname{$local}."/lon-status/>$local</a></b><br>".
  112:      $hostrole{$local}.' '.$hostdom{$local}.'<br>'.
  113:      "<tt><a href=http://".$hostname{$local}."/server-status/>".
  114:       $hostname{$local}."</a></tt><br>".
  115:      "<a href=http://".$hostname{$local}."/cgi-bin/loncron.pl>New Report</a>".
  116:      "</td>";
  117:   if (&online($hostname{$local})) {
  118:    foreach $remote (sort keys %hostname) {
  119:        $status=&connected($local,$remote);
  120:        if ($status eq 'ok') {
  121: 	   $table.="<td";
  122:            if ($libserv{$remote}) {
  123: 	       if ($libserv{$local}) {
  124: 		   $table.=" bgcolor=#FFFF44";
  125:                } else {
  126:                    $table.=" bgcolor=#FFFF99";
  127:                }
  128:            } elsif ($libserv{$local}) {
  129:                $table.=" bgcolor=#FFFF99";
  130:            }
  131:            $table.="><b><font color=#00FF00>OK</font></b></td>";
  132:            print ".";
  133:        } else {
  134:            print "X";
  135:            $table.="<td><b><font color=#FF0000>".$status."</font></b><br>".
  136:      "<a href=http://".$hostname{$local}.
  137: 	 "/lon-status/loncstatus.txt>lonc</a>";
  138:            if (&online($hostname{$remote})) {
  139:               $table.=" <a href=http://".$hostname{$remote}.
  140:       "/lon-status/londstatus.txt>lond</a>".
  141:             "</td>";
  142: 	  } else {
  143:               $table.=' offline';
  144:           }
  145:   
  146:        }
  147:    }
  148:   } else {
  149:       print "offline";
  150:       $table.='<th colspan='.$total.'><font color=#FF0000>Offline</font></th>';
  151:   }
  152:    $table.="</tr>\n";
  153:     print "<br>\n";
  154: }
  155: $table.="</table>";
  156: print $table;
  157: print "</body></html>";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>