#!/usr/bin/perl
$|=1;
# Generates a html page showing various sataus reports about the cluster
# $Id: clusterstatus.pl,v 1.23 2003/09/14 19:00:03 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use strict;
use LWP::UserAgent();
use HTTP::Headers;
use IO::File;
my %host=();
my $oneday=60*60*24;
my %connectionstatus=();
my %perlvar=();
my $mode;
my $concount=0;
my $fromcache;
my %domaindescription = ();
my %domain_auth_def = ();
my %domain_auth_arg_def = ();
my %domain_lang_def=();
my %domain_city=();
my %domain_longi=();
my %domain_lati=();
my %hostname=();
my %hostip=();
my %hostdom=();
my %hostrole=();
my %libserv=();
my $maxusers=0;
my $maxload=0;
my $totalusers=0;
my %FORM=();
my $stat_total=0;
my $stat_notyet=0;
my $stat_fromcache=0;
sub select_form {
my ($def,$name,%hash) = @_;
my $selectform = "";
return $selectform;
}
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)=@_;
$cachetime*=(0.5+rand);
my $key=&key($local,$url);
my $reply='';
$stat_total++;
# if fromcache flag is set, only return cached values
if ($fromcache) {
if ($FORM{$key.'_time'}) {
return $FORM{$key};
$stat_fromcache++;
} else {
return 'not_yet';
$stat_notyet++;
}
}
# normal mode, refresh when expired or not yet present
if ($FORM{$key.'_time'}) {
if ((time-$FORM{$key.'_time'})<$cachetime) {
$reply=$FORM{$key};
&hidden($key.'_time',$FORM{$key.'_time'});
$stat_fromcache++;
}
}
unless ($reply) {
unless ($hostname{$local}) {
$reply='local_unknown';
} else {
my $ua=new LWP::UserAgent(timeout => 10);
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 5 percent of the cases,
# but always do the first five.
#
unless ($FORM{&key($local,$url)}) {
unless (($concount<=5) || (rand>0.95)) {
$stat_total++;
$stat_notyet++;
return 'not_yet';
} else {
$concount++;
}
}
#
# Actually do the query
#
&statuslist($local,'connecting '.$remote);
my $reply=&request($local,$url,3600);
$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;
}
# ================================================================ Link to host
sub otherwindow {
my ($local,$url,$label)=@_;
return
" $label ";
}
sub login {
my $local=shift;
print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
'Login');
}
sub runloncron {
my $local=shift;
print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron');
}
sub loncron {
my $local=shift;
print &otherwindow($local,'/lon-status','loncron');
}
sub lonc {
my $local=shift;
print &otherwindow($local,'/lon-status/loncstatus.txt','lonc');
}
sub lond {
my $local=shift;
print &otherwindow($local,'/lon-status/londstatus.txt','lond');
}
sub users {
my $local=shift;
print &otherwindow($local,'/cgi-bin/userstatus.pl','Users');
}
sub versions {
my $local=shift;
print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions');
}
sub server {
my $local=shift;
print &otherwindow($local,'/server-status','Server Status');
}
sub announcement {
my $local=shift;
print &otherwindow($local,'/announcement.txt','Announcement');
}
sub takeonline {
my $local=shift;
print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online');
}
sub takeoffline {
my $local=shift;
print &otherwindow($local,'/cgi-bin/takeoffline.pl','Take offline');
}
sub reroute {
my ($local,$remote)=@_;
print &otherwindow($local,'/cgi-bin/takeoffline.pl?'.
$hostname{$remote}.'&'.$hostdom{$local}
,$remote)."\n";
}
sub allreroutes {
my $local=shift;
&takeoffline($local);
print ' Reroute to: ';
foreach my $remote (sort keys %hostname) {
unless ($local eq $remote) {
&reroute($local,$remote);
}
}
print '';
}
# ========================================================= Produce a green bar
sub bar {
my $parm=shift;
my $number=int($parm+0.5);
print "
";
for (my $i=0;$i<$number;$i++) {
print "+";
}
print "
";
}
# ========================================================== Show server status
sub serverstatus {
my ($local,$trouble)=@_;
print (<