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 Gerd Kortemeyer)
9: #
10: use LWP::UserAgent();
11: use HTTP::Headers;
12: use IO::File;
13:
14: sub connected {
15: my ($local,$remote)=@_;
16: $local=~s/\W//g;
17: $remote=~s/\W//g;
18:
19: unless ($hostname{$local}) { return 'local_unknown'; }
20: unless ($hostname{$remote}) { return 'remote_unknown'; }
21:
22: my $ua=new LWP::UserAgent;
23:
24: my $request=new HTTP::Request('GET',
25: "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote);
26:
27: my $response=$ua->request($request);
28:
29: unless ($response->is_success) { return 'local_offline'; }
30:
31: my $reply=$response->content;
32: $reply=(split("\n",$reply))[0];
33: $reply=~s/\W//g;
34: if ($reply ne $remote) { return $reply; }
35: return 'ok';
36: }
37:
38:
39: print "Content-type: text/html\n\n".
40: "<html><body bgcolor=#FFFFFF>\n";
41: # ------------------------------------------------------------ Read access.conf
42: {
43: my $config=IO::File->new("/etc/httpd/conf/access.conf");
44:
45: while (my $configline=<$config>) {
46: if ($configline =~ /PerlSetVar/) {
47: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
48: $perlvar{$varname}=$varvalue;
49: }
50: }
51: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
52: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
53: }
54:
55: # ------------------------------------------------------------- Read hosts file
56: {
57: my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
58:
59: while (my $configline=<$config>) {
60: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
61: $hostname{$id}=$name;
62: $hostdom{$id}=$domain;
63: $hostrole{$id}=$role;
64: $hostip{$id}=$ip;
65: if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
66: $libserv{$id}=$name;
67: }
68: }
69: }
70:
71: print "<h1>Cluster Status</h1>\n";
72: print &connected('gerdl1','msul1');
73:
74: print "</body></html>";
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>