[BACK]Return to clusterstatus.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / cgi

Annotation of loncom/cgi/clusterstatus.pl, revision 1.1

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)
        !             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>