Annotation of loncom/cgi/clusterstatus.pl, revision 1.3
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.3 ! harris41 57: # ------------------------------------------- Read access.conf and loncapa.conf
! 58: my $perlvarref=LONCAPA::Configuration::read_conf('access.conf','loncapa.conf');
! 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>
![[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