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