File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.3: download - view: text, annotated - select for diffs
Sat May 11 21:29:42 2002 UTC (22 years ago) by harris41
Branches: MAIN
CVS tags: version_0_5_1, version_0_5, version_0_4, stable_2002_july, STABLE, HEAD
Using LONCAPA::Configuration::read_conf
BUG 129

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>