Annotation of loncom/cgi/clusterstatus.pl, revision 1.4

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

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