#!/usr/bin/perl $|=1; # The LearningOnline Network with CAPA # Cluster Status # (Versions # (Running loncron # 09/06/01 Gerd Kortemeyer) # 02/18/02,02/19/02 Gerd Kortemeyer) use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; use LWP::UserAgent(); use HTTP::Headers; use IO::File; my %host=(); my $oneday=60*60*24; my %connectionstatus=(); sub key { my ($local,$url)=@_; my $key=$local.'_'.$url; $key=~s/\W/\_/gs; return $key; } sub hidden { my ($name,$value)=@_; print "\n"; } sub request { my ($local,$url,$cachetime)=@_; my $key=&key($local,$url); my $reply=''; if ($FORM{$key.'_time'}) { if ((time-$FORM{$key.'_time'})<$cachetime) { $reply=$FORM{$key}; &hidden($key.'_time',$FORM{$key.'_time'}); &hidden($key.'_fromcache',1); } } unless ($reply) { unless ($hostname{$local}) { $reply='local_unknown'; } else { my $ua=new LWP::UserAgent(timeout => 20); my $request=new HTTP::Request('GET', "http://".$hostname{$local}.$url); $request->authorization_basic('lonadm','litelite'); my $response=$ua->request($request); unless ($response->is_success) { $reply='local_error'; } else { $reply=$response->content; chomp($reply); } } &hidden($key.'_time',time); } &hidden($key,$reply); return $reply; } # ============================================= Are local and remote connected? sub connected { my ($local,$remote)=@_; $local=~s/\W//g; $remote=~s/\W//g; unless ($hostname{$remote}) { return 'remote_unknown'; } my $url='/cgi-bin/ping.pl?'.$remote; # # Slowly phase this in: if not cached, only do 10 percent of the cases # unless ($FORM{&key($local,$url)}) { unless (rand>0.9) { return 'not_yet'; } } # # Actually do the query # &statuslist($local,'connecting '.$remote); my $reply=&request($local,$url,1800); $reply=(split("\n",$reply))[0]; $reply=~s/\W//g; if ($reply ne $remote) { return $reply; } return 'ok'; } # ============================================================ Get a reply hash sub replyhash { my %returnhash=(); foreach (split(/\&/,&request(@_))) { my ($name,$value)=split(/\=/,$_); if ($name) { unless ($value) { $value=''; } $returnhash{$name}=$value; } } return %returnhash; } # ========================================================== Show server status sub otherwindow { my ($local,$url,$label)=@_; return "$label"; } sub serverstatus { my $local=shift; print "\n