--- loncom/cgi/clusterstatus.pl 2002/02/18 23:45:23 1.1
+++ loncom/cgi/clusterstatus.pl 2014/05/28 18:16:09 1.28
@@ -1,74 +1,818 @@
#!/usr/bin/perl
$|=1;
-# The LearningOnline Network with CAPA
-# Cluster Status
-# (Versions
-# (Running loncron
-# 09/06/01 Gerd Kortemeyer)
-# 02/18/02 Gerd Kortemeyer)
+# Generates a html page showing various status reports about the domain or cluster
+# $Id: clusterstatus.pl,v 1.28 2014/05/28 18:16:09 bisitz 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 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;
+
+my %connectionstatus=();
+my %perlvar=();
+
+my $mode;
+my $concount=0;
+my $fromcache;
+
+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;
+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'}) {
+ $stat_fromcache++;
+ return $FORM{$key};
+ } else {
+ $stat_notyet++;
+ return 'not_yet';
+ }
+ }
+# 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) {
+ if ($hostname{$local}) {
+ my $ua=new LWP::UserAgent(timeout => 20);
+ my $request=new HTTP::Request('GET',
+ "http://".$hostname{$local}.$url);
+ my $response=$ua->request($request);
+ if ($response->is_success) {
+ $reply=$response->content;
+ chomp($reply);
+ } else {
+ $reply='local_error';
+ }
+ } else {
+ $reply='local_unknown';
+ }
+ &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{$local}) { return 'local_unknown'; }
unless ($hostname{$remote}) { return 'remote_unknown'; }
-
- my $ua=new LWP::UserAgent;
-
- my $request=new HTTP::Request('GET',
- "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote);
-
- my $response=$ua->request($request);
-
- unless ($response->is_success) { return 'local_offline'; }
-
- my $reply=$response->content;
+ 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,&mt('connecting [_1]',$remote),1);
+ 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
-
-print "Content-type: text/html\n\n".
- "
\n";
-# ------------------------------------------------------------ Read access.conf
-{
- my $config=IO::File->new("/etc/httpd/conf/access.conf");
-
- while (my $configline=<$config>) {
- if ($configline =~ /PerlSetVar/) {
- my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
- $perlvar{$varname}=$varvalue;
- }
+sub replyhash {
+ my %returnhash=();
+ foreach (split(/\&/,&request(@_))) {
+ my ($name,$value)=split(/\=/,$_);
+ if ($name) {
+ unless ($value) { $value=''; }
+ $returnhash{$name}=$value;
+ }
}
- delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
- delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
+ 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',&Apache::lonlocal::mt('Run loncron')));
+}
+
+sub loncron {
+ my $local=shift;
+ print(&otherwindow($local,'/lon-status','loncron'));
}
-# ------------------------------------------------------------- Read hosts file
-{
- my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
+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',&Apache::lonlocal::mt('Users')));
+}
+
+sub versions {
+ my $local=shift;
+ print(&otherwindow($local,'/cgi-bin/lonversions.pl',&Apache::lonlocal::mt('Versions')));
+}
+
+sub server {
+ my $local=shift;
+ print(&otherwindow($local,'/server-status',&Apache::lonlocal::mt('Server Status')));
+}
+
+sub announcement {
+ my $local=shift;
+ 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')));
+}
- while (my $configline=<$config>) {
- my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
- $hostname{$id}=$name;
- $hostdom{$id}=$domain;
- $hostrole{$id}=$role;
- $hostip{$id}=$ip;
- if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
- $libserv{$id}=$name;
- }
+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);
+ my $reroute;
+ foreach my $remote (sort(keys(%hostname))) {
+ unless ($local eq $remote) {
+ $reroute .= &reroute($local,$remote);
+ }
+ }
+ if ($reroute) {
+ print(&Apache::lonlocal::mt('Reroute to:').' '.$reroute.'');
+ }
+}
+
+# ========================================================= Produce a green bar
+sub bar {
+ my $parm=shift;
+ my $number=int($parm+0.5);
+ print('