File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.2: download - view: text, annotated - select for diffs
Tue Feb 19 20:23:59 2002 UTC (22 years, 2 months ago) by www
Branches: MAIN
CVS tags: stable_2002_april, HEAD
New Cluster Status Functionality

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

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