Annotation of loncom/cgi/clusterstatus.pl, revision 1.7
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;
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:
1.2 www 32: unless ($response->is_success) { return 'local_error'; }
1.1 www 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";
1.4 harris41 44: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
45: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
1.3 harris41 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
1.1 www 50:
51: # ------------------------------------------------------------- Read hosts file
52: {
53: my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
54:
1.2 www 55: $total=0;
1.1 www 56: while (my $configline=<$config>) {
1.7 ! www 57: $configline=~s/#.*$//;
! 58: unless ($configline=~/\w/) { next; }
1.1 www 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;
1.2 www 64: $total++;
1.1 www 65: if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
66: $libserv{$id}=$name;
67: }
68: }
69: }
70:
1.2 www 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) {
1.7 ! www 90: print "Checking $local: ";
1.2 www 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}.
1.7 ! www 123: "/lon-status/loncstatus.txt>lonc</a>".
! 124: " <a href=http://".$hostname{$remote}.
1.2 www 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;
1.1 www 134: print "</body></html>";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>