Diff for /loncom/cgi/clusterstatus.pl between versions 1.1 and 1.3

version 1.1, 2002/02/18 23:45:23 version 1.3, 2002/05/11 21:29:42
Line 5  $|=1; Line 5  $|=1;
 # (Versions  # (Versions
 # (Running loncron  # (Running loncron
 # 09/06/01 Gerd Kortemeyer)  # 09/06/01 Gerd Kortemeyer)
 # 02/18/02 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 LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use IO::File;  use IO::File;
   use Net::Ping;
   
   sub online {
       my $host=shift;
       my $p=Net::Ping->new("tcp",10);
       my $online=$p->ping("$host");
       $p->close();
       undef ($p);
       return $online;
   }
   
 sub connected {  sub connected {
     my ($local,$remote)=@_;      my ($local,$remote)=@_;
Line 19  sub connected { Line 33  sub connected {
     unless ($hostname{$local}) { return 'local_unknown'; }      unless ($hostname{$local}) { return 'local_unknown'; }
     unless ($hostname{$remote}) { return 'remote_unknown'; }      unless ($hostname{$remote}) { return 'remote_unknown'; }
   
       unless (&online($hostname{$local})) { return 'local_offline'; }
   
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
           
     my $request=new HTTP::Request('GET',      my $request=new HTTP::Request('GET',
Line 26  sub connected { Line 42  sub connected {
   
     my $response=$ua->request($request);      my $response=$ua->request($request);
   
     unless ($response->is_success) { return 'local_offline'; }      unless ($response->is_success) { return 'local_error'; }
   
     my $reply=$response->content;      my $reply=$response->content;
     $reply=(split("\n",$reply))[0];      $reply=(split("\n",$reply))[0];
Line 38  sub connected { Line 54  sub connected {
     
 print "Content-type: text/html\n\n".  print "Content-type: text/html\n\n".
       "<html><body bgcolor=#FFFFFF>\n";        "<html><body bgcolor=#FFFFFF>\n";
 # ------------------------------------------------------------ Read access.conf  # ------------------------------------------- Read access.conf and loncapa.conf
 {  my $perlvarref=LONCAPA::Configuration::read_conf('access.conf','loncapa.conf');
     my $config=IO::File->new("/etc/httpd/conf/access.conf");  my %perlvar=%{$perlvarref};
   undef $perlvarref; # remove since sensitive and not needed
     while (my $configline=<$config>) {  delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
         if ($configline =~ /PerlSetVar/) {  delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
    my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
            $perlvar{$varname}=$varvalue;  
         }  
     }  
     delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed  
     delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed  
 }  
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
 {  {
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");      my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
   
       $total=0;
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);         my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
        $hostname{$id}=$name;         $hostname{$id}=$name;
        $hostdom{$id}=$domain;         $hostdom{$id}=$domain;
        $hostrole{$id}=$role;         $hostrole{$id}=$role;
        $hostip{$id}=$ip;         $hostip{$id}=$ip;
          $total++;
        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {         if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
    $libserv{$id}=$name;     $libserv{$id}=$name;
        }         }
     }      }
 }  }
   
 print "<h1>Cluster Status</h1>\n";  print 
 print &connected('gerdl1','msul1');  "<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>";  print "</body></html>";

Removed from v.1.1  
changed lines
  Added in v.1.3


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