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

version 1.1, 2002/02/18 23:45:23 version 1.2, 2002/02/19 20:23:59
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)
 #  #
 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 29  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 38  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 56  print "Content-type: text/html\n\n". Line 68  print "Content-type: text/html\n\n".
 {  {
     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.2


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