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