Diff for /loncom/cgi/clusterstatus.pl between versions 1.5 and 1.7

version 1.5, 2002/11/18 15:11:41 version 1.7, 2003/02/25 21:56:48
Line 6  $|=1; Line 6  $|=1;
 # (Running loncron  # (Running loncron
 # 09/06/01 Gerd Kortemeyer)  # 09/06/01 Gerd Kortemeyer)
 # 02/18/02,02/19/02 Gerd Kortemeyer)  # 02/18/02,02/19/02 Gerd Kortemeyer)
 # 5/11/2002 Scott Harrison  
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
Line 14  use LONCAPA::Configuration; Line 13  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;  
     return 1;  
 # ping is broken  
     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 35  sub connected { Line 22  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 69  delete $perlvar{'lonSqlAccess'}; # remov Line 54  delete $perlvar{'lonSqlAccess'}; # remov
   
     $total=0;      $total=0;
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
          $configline=~s/#.*$//;
          unless ($configline=~/\w/) { next; } 
        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;
Line 100  foreach $remote (sort keys %hostname) { Line 87  foreach $remote (sort keys %hostname) {
 }  }
 $table.="</tr>";  $table.="</tr>";
 foreach $local (sort keys %hostname) {  foreach $local (sort keys %hostname) {
     print "Checking $local ";     print "Checking $local: ";
    $table.="<tr><td";     $table.="<tr><td";
    if ($local eq $perlvar{'lonHostID'}) {     if ($local eq $perlvar{'lonHostID'}) {
        $table.=" bgcolor=#CCFFBB";         $table.=" bgcolor=#CCFFBB";
Line 114  foreach $local (sort keys %hostname) { Line 101  foreach $local (sort keys %hostname) {
       $hostname{$local}."</a></tt><br>".        $hostname{$local}."</a></tt><br>".
      "<a href=http://".$hostname{$local}."/cgi-bin/loncron.pl>New Report</a>".       "<a href=http://".$hostname{$local}."/cgi-bin/loncron.pl>New Report</a>".
      "</td>";       "</td>";
   if (&online($hostname{$local})) {  
    foreach $remote (sort keys %hostname) {     foreach $remote (sort keys %hostname) {
        $status=&connected($local,$remote);         $status=&connected($local,$remote);
        if ($status eq 'ok') {         if ($status eq 'ok') {
Line 134  foreach $local (sort keys %hostname) { Line 120  foreach $local (sort keys %hostname) {
            print "X";             print "X";
            $table.="<td><b><font color=#FF0000>".$status."</font></b><br>".             $table.="<td><b><font color=#FF0000>".$status."</font></b><br>".
      "<a href=http://".$hostname{$local}.       "<a href=http://".$hostname{$local}.
  "/lon-status/loncstatus.txt>lonc</a>";   "/lon-status/loncstatus.txt>lonc</a>".
            if (&online($hostname{$remote})) {      " <a href=http://".$hostname{$remote}.
               $table.=" <a href=http://".$hostname{$remote}.  
       "/lon-status/londstatus.txt>lond</a>".        "/lon-status/londstatus.txt>lond</a>".
             "</td>";              "</td>";
   } else {  
               $table.=' offline';  
           }  
     
        }         }
    }     }
   } else {  
       print "offline";  
       $table.='<th colspan='.$total.'><font color=#FF0000>Offline</font></th>';  
   }  
    $table.="</tr>\n";     $table.="</tr>\n";
     print "<br>\n";      print "<br>\n";
 }  }

Removed from v.1.5  
changed lines
  Added in v.1.7


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