--- loncom/cgi/clusterstatus.pl 2003/08/20 01:34:25 1.19
+++ loncom/cgi/clusterstatus.pl 2008/12/25 01:56:03 1.26
@@ -1,18 +1,45 @@
#!/usr/bin/perl
$|=1;
-# The LearningOnline Network with CAPA
-# Cluster Status
+# Generates a html page showing various status reports about the domain or cluster
+# $Id: clusterstatus.pl,v 1.26 2008/12/25 01:56:03 raeburn 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/
#
-# $Id: clusterstatus.pl,v 1.19 2003/08/20 01:34:25 www Exp $
-use lib '/home/httpd/lib/perl/';
-use LONCAPA::Configuration;
use strict;
+use lib '/home/httpd/lib/perl/';
+use Apache::lonnet;
+use Apache::lonlocal;
+use LONCAPA::Configuration;
+use LONCAPA::loncgi;
+use LONCAPA::lonauthcgi;
use LWP::UserAgent();
use HTTP::Headers;
use IO::File;
+my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
+
my %host=();
my $oneday=60*60*24;
@@ -23,19 +50,16 @@ 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 %domaininfo = &Apache::lonnet::domain_info();
+my %allhostname = &Apache::lonnet::all_hostnames();
+my (%hostname,%hostip);
+my %hostdom = &Apache::lonnet::all_host_domain();
+my %iphost = &Apache::lonnet::get_iphost();
+my %libserv= &Apache::lonnet::all_library();
+
+foreach my $ip (keys(%iphost)) {
+ $hostip{$iphost{$ip}} = $ip;
+}
my $maxusers=0;
my $maxload=0;
@@ -50,10 +74,10 @@ my $stat_fromcache=0;
sub select_form {
my ($def,$name,%hash) = @_;
my $selectform = "";
return $selectform;
@@ -69,7 +93,7 @@ sub key {
sub hidden {
my ($name,$value)=@_;
- print "\n";
+ print("\n");
}
sub request {
@@ -81,11 +105,11 @@ sub request {
# if fromcache flag is set, only return cached values
if ($fromcache) {
if ($FORM{$key.'_time'}) {
+ $stat_fromcache++;
return $FORM{$key};
- $stat_fromcache++;
} else {
+ $stat_notyet++;
return 'not_yet';
- $stat_notyet++;
}
}
# normal mode, refresh when expired or not yet present
@@ -97,25 +121,20 @@ sub request {
}
}
unless ($reply) {
- unless ($hostname{$local}) {
- $reply='local_unknown';
- } else {
-
- my $ua=new LWP::UserAgent(timeout => 10);
-
+ if ($hostname{$local}) {
+ 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) {
+ if ($response->is_success) {
+ $reply=$response->content;
+ chomp($reply);
+ } else {
$reply='local_error';
- } else {
- $reply=$response->content;
- chomp($reply);
}
- }
+ } else {
+ $reply='local_unknown';
+ }
&hidden($key.'_time',time);
}
&hidden($key,$reply);
@@ -177,116 +196,169 @@ sub otherwindow {
sub login {
my $local=shift;
- print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
- 'Login');
+ print(&otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
+ 'Login'));
}
sub runloncron {
my $local=shift;
- print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron');
+ print(&otherwindow($local,'/cgi-bin/loncron.pl',&Apache::lonlocal::mt('Run loncron')));
}
sub loncron {
my $local=shift;
- print &otherwindow($local,'/lon-status','loncron');
+ print(&otherwindow($local,'/lon-status','loncron'));
}
sub lonc {
my $local=shift;
- print &otherwindow($local,'/lon-status/loncstatus.txt','lonc');
+ print(&otherwindow($local,'/lon-status/loncstatus.txt','lonc'));
}
sub lond {
my $local=shift;
- print &otherwindow($local,'/lon-status/londstatus.txt','lond');
+ print(&otherwindow($local,'/lon-status/londstatus.txt','lond'));
}
sub users {
my $local=shift;
- print &otherwindow($local,'/cgi-bin/userstatus.pl','Users');
+ print(&otherwindow($local,'/cgi-bin/userstatus.pl',&Apache::lonlocal::mt('Users')));
}
sub versions {
my $local=shift;
- print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions');
+ print(&otherwindow($local,'/cgi-bin/lonversions.pl',&Apache::lonlocal::mt('Versions')));
}
sub server {
my $local=shift;
- print &otherwindow($local,'/server-status','Server Status');
+ print(&otherwindow($local,'/server-status',&Apache::lonlocal::mt('Server Status')));
}
sub announcement {
my $local=shift;
- print &otherwindow($local,'/announcement.txt','Announcement');
+ print(&otherwindow($local,'/announcement.txt',&Apache::lonlocal::mt('Announcement')));
+}
+
+sub takeonline {
+ my $local=shift;
+ print(&otherwindow($local,'/cgi-bin/takeonline.pl',&Apache::lonlocal::mt('Take online')));
+}
+
+sub takeoffline {
+ my $local=shift;
+ print(&otherwindow($local,'/cgi-bin/takeoffline.pl',&Apache::lonlocal::mt('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(&Apache::lonlocal::mt('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 "