[BACK]Return to clusterstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi
File:  [LON-CAPA] / loncom / cgi / clusterstatus.pl
Revision 1.7: download - view: text, annotated - select for diffs
Tue Feb 25 21:56:48 2003 UTC (21 years, 2 months ago) by www
Branches: MAIN
CVS tags: version_0_99_3, version_0_99_2, version_0_99_1, version_0_99_0, conference_2003, HEAD
Bug #1267 - list of active users via /cgi-bin/userstatus.pl
Trying to get clusterstatus.pl working again. Added ability to ignore
comments in hosts.tab, and took out Net::Ping because that library is kaputt.

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