--- loncom/cgi/clusterstatus.pl	2002/02/18 23:45:23	1.1
+++ loncom/cgi/clusterstatus.pl	2002/02/19 20:23:59	1.2
@@ -5,11 +5,21 @@ $|=1;
 # (Versions
 # (Running loncron
 # 09/06/01 Gerd Kortemeyer)
-# 02/18/02 Gerd Kortemeyer)
+# 02/18/02,02/19/02 Gerd Kortemeyer)
 #
 use LWP::UserAgent();
 use HTTP::Headers;
 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 {
     my ($local,$remote)=@_;
@@ -19,6 +29,8 @@ sub connected {
     unless ($hostname{$local}) { return 'local_unknown'; }
     unless ($hostname{$remote}) { return 'remote_unknown'; }
 
+    unless (&online($hostname{$local})) { return 'local_offline'; }
+
     my $ua=new LWP::UserAgent;
     
     my $request=new HTTP::Request('GET',
@@ -26,7 +38,7 @@ sub connected {
 
     my $response=$ua->request($request);
 
-    unless ($response->is_success) { return 'local_offline'; }
+    unless ($response->is_success) { return 'local_error'; }
 
     my $reply=$response->content;
     $reply=(split("\n",$reply))[0];
@@ -56,19 +68,91 @@ print "Content-type: text/html\n\n".
 {
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
 
+    $total=0;
     while (my $configline=<$config>) {
        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
        $hostname{$id}=$name;
        $hostdom{$id}=$domain;
        $hostrole{$id}=$role;
        $hostip{$id}=$ip;
+       $total++;
        if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
 	   $libserv{$id}=$name;
        }
     }
 }
 
-print "<h1>Cluster Status</h1>\n";
-print &connected('gerdl1','msul1');
-
+print 
+"<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>";