Annotation of loncom/cgi/clusterstatus.pl, revision 1.22
1.1 www 1: #!/usr/bin/perl
2: $|=1;
1.21 albertel 3: # Generates a html page showing various sataus reports about the cluster
1.22 ! www 4: # $Id: clusterstatus.pl,v 1.21 2003/09/01 03:37:27 albertel Exp $
1.21 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
1.9 www 27: #
1.3 harris41 28:
29: use lib '/home/httpd/lib/perl/';
30: use LONCAPA::Configuration;
1.16 www 31: use strict;
1.3 harris41 32:
1.1 www 33: use LWP::UserAgent();
34: use HTTP::Headers;
35: use IO::File;
36:
1.8 www 37: my %host=();
38: my $oneday=60*60*24;
39:
40: my %connectionstatus=();
1.9 www 41: my %perlvar=();
42:
43: my $mode;
1.14 www 44: my $concount=0;
1.16 www 45: my $fromcache;
46:
47: my %domaindescription = ();
48: my %domain_auth_def = ();
49: my %domain_auth_arg_def = ();
1.19 www 50: my %domain_lang_def=();
51: my %domain_city=();
52: my %domain_longi=();
53: my %domain_lati=();
1.16 www 54:
55: my %hostname=();
56: my %hostip=();
57: my %hostdom=();
58: my %hostrole=();
59: my %libserv=();
60:
61: my $maxusers=0;
62: my $maxload=0;
63: my $totalusers=0;
64:
65: my %FORM=();
66:
67: my $stat_total=0;
68: my $stat_notyet=0;
69: my $stat_fromcache=0;
1.9 www 70:
71: sub select_form {
72: my ($def,$name,%hash) = @_;
73: my $selectform = "<select name=\"$name\" size=\"1\">\n";
74: foreach (sort keys %hash) {
75: $selectform.="<option value=\"$_\" ".
76: ($_ eq $def ? 'selected' : '').
77: ">".$hash{$_}."</option>\n";
78: }
79: $selectform.="</select>";
80: return $selectform;
81: }
82:
1.8 www 83:
84: sub key {
85: my ($local,$url)=@_;
86: my $key=$local.'_'.$url;
87: $key=~s/\W/\_/gs;
88: return $key;
89: }
90:
91: sub hidden {
92: my ($name,$value)=@_;
93: print "\n<input type='hidden' name='$name' value='$value' />";
94: }
95:
96: sub request {
97: my ($local,$url,$cachetime)=@_;
1.13 www 98: $cachetime*=(0.5+rand);
1.8 www 99: my $key=&key($local,$url);
100: my $reply='';
1.16 www 101: $stat_total++;
102: # if fromcache flag is set, only return cached values
103: if ($fromcache) {
104: if ($FORM{$key.'_time'}) {
105: return $FORM{$key};
106: $stat_fromcache++;
107: } else {
108: return 'not_yet';
109: $stat_notyet++;
110: }
111: }
112: # normal mode, refresh when expired or not yet present
1.8 www 113: if ($FORM{$key.'_time'}) {
114: if ((time-$FORM{$key.'_time'})<$cachetime) {
115: $reply=$FORM{$key};
116: &hidden($key.'_time',$FORM{$key.'_time'});
1.16 www 117: $stat_fromcache++;
1.8 www 118: }
119: }
120: unless ($reply) {
121: unless ($hostname{$local}) {
122: $reply='local_unknown';
123: } else {
124:
1.14 www 125: my $ua=new LWP::UserAgent(timeout => 10);
1.8 www 126:
127: my $request=new HTTP::Request('GET',
128: "http://".$hostname{$local}.$url);
129: $request->authorization_basic('lonadm','litelite');
130:
131: my $response=$ua->request($request);
132:
133: unless ($response->is_success) {
134: $reply='local_error';
135: } else {
136: $reply=$response->content;
137: chomp($reply);
138: }
139: }
140: &hidden($key.'_time',time);
141: }
142: &hidden($key,$reply);
143: return $reply;
144: }
145:
146: # ============================================= Are local and remote connected?
1.1 www 147: sub connected {
148: my ($local,$remote)=@_;
149: $local=~s/\W//g;
150: $remote=~s/\W//g;
151:
152: unless ($hostname{$remote}) { return 'remote_unknown'; }
1.8 www 153: my $url='/cgi-bin/ping.pl?'.$remote;
154: #
1.14 www 155: # Slowly phase this in: if not cached, only do 5 percent of the cases,
156: # but always do the first five.
1.8 www 157: #
158: unless ($FORM{&key($local,$url)}) {
1.16 www 159: unless (($concount<=5) || (rand>0.95)) {
160: $stat_total++;
161: $stat_notyet++;
1.14 www 162: return 'not_yet';
163: } else {
164: $concount++;
165: }
1.8 www 166: }
167: #
168: # Actually do the query
169: #
170: &statuslist($local,'connecting '.$remote);
1.9 www 171: my $reply=&request($local,$url,3600);
1.8 www 172: $reply=(split("\n",$reply))[0];
173: $reply=~s/\W//g;
174: if ($reply ne $remote) { return $reply; }
175: return 'ok';
176: }
177: # ============================================================ Get a reply hash
178:
179: sub replyhash {
180: my %returnhash=();
181: foreach (split(/\&/,&request(@_))) {
182: my ($name,$value)=split(/\=/,$_);
183: if ($name) {
184: unless ($value) { $value=''; }
185: $returnhash{$name}=$value;
186: }
187: }
188: return %returnhash;
189: }
1.1 www 190:
1.9 www 191: # ================================================================ Link to host
1.1 www 192:
1.8 www 193: sub otherwindow {
194: my ($local,$url,$label)=@_;
195: return
1.9 www 196: " <a href='http://$hostname{$local}$url' target='newwin$local'>$label</a> ";
197: }
198:
199: sub login {
200: my $local=shift;
201: print &otherwindow($local,'/adm/login?domain='.$perlvar{'lonDefDomain'},
202: 'Login');
203: }
204:
205: sub runloncron {
206: my $local=shift;
207: print &otherwindow($local,'/cgi-bin/loncron.pl','Run loncron');
208: }
209:
210: sub loncron {
211: my $local=shift;
212: print &otherwindow($local,'/lon-status','loncron');
213: }
214:
215: sub lonc {
216: my $local=shift;
217: print &otherwindow($local,'/lon-status/loncstatus.txt','lonc');
218: }
219:
220: sub lond {
221: my $local=shift;
222: print &otherwindow($local,'/lon-status/londstatus.txt','lond');
223: }
224:
225: sub users {
226: my $local=shift;
227: print &otherwindow($local,'/cgi-bin/userstatus.pl','Users');
228: }
229:
230: sub versions {
231: my $local=shift;
232: print &otherwindow($local,'/cgi-bin/lonversions.pl','Versions');
233: }
234:
235: sub server {
236: my $local=shift;
237: print &otherwindow($local,'/server-status','Server Status');
1.8 www 238: }
1.1 www 239:
1.18 www 240: sub announcement {
241: my $local=shift;
242: print &otherwindow($local,'/announcement.txt','Announcement');
243: }
244:
1.22 ! www 245: sub takeonline {
! 246: my $local=shift;
! 247: print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online');
! 248: }
! 249:
1.11 www 250: # ========================================================= Produce a green bar
251: sub bar {
252: my $parm=shift;
253: my $number=int($parm+0.5);
254: print "<table><tr><td bgcolor='#225522'><font color='#225522'>";
255: for (my $i=0;$i<$number;$i++) {
256: print "+";
257: }
258: print "</font></table>";
259: }
260:
1.9 www 261: # ========================================================== Show server status
262:
1.8 www 263: sub serverstatus {
1.11 www 264: my ($local,$trouble)=@_;
1.9 www 265: print (<<ENDHEADER);
1.11 www 266: <a name="$local" />
1.9 www 267: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
268: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
269: $local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt>
270: <br />$domaindescription{$hostdom{$local}}
1.19 www 271: $domain_city{$hostdom{$local}}
1.10 www 272: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
1.9 www 273: ENDHEADER
274: &login($local);&server($local);&users($local);&versions($local);
1.18 www 275: &announcement($local);
1.9 www 276: &loncron($local);&lond($local);&lonc($local);&runloncron($local);
1.11 www 277: print "</font></td></tr>";
278: if ($trouble) {
279: print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
280: }
281: print "<tr><td bgcolor='#BBBBBB'>";
1.22 ! www 282: # re-routing
! 283: if ($host{$local.'_reroute'}) {
! 284: print "<br />Reroute: ".$host{$local.'_reroute'};
! 285: &takeonline($local);
! 286: }
1.15 www 287: # version
288: if ($host{$local.'_version'}) {
289: print "<br />Version: ".$host{$local.'_version'}
290: }
1.9 www 291: # load
292: if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
293: print "<br />Load: ".$host{$local.'_load'}
294: }
295: # users
296: if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
297: print "<br />Active Users: ".$host{$local.'_users'}
298: }
299:
1.8 www 300: # checkrpms
301: if ($host{$local.'_checkrpms'}) {
302: print "<br />RPMs: ".$host{$local.'_checkrpms'}
303: }
304: # mysql
305: if ($host{$local.'_mysql'}) {
306: print "<br />MySQL Database: ".$host{$local.'_mysql'}
307: }
1.11 www 308: # connections
309: if ($host{$local.'_notconnected'}) {
310: print "<br />Not connected: ";
311: foreach (split(/ /,$host{$local.'_notconnected'})) {
312: if ($_) {
313: print " <a href='#$_'>$_</a>";
314: }
315: }
316: }
317: # errors
318: if ($host{$local.'_errors'}) {
319: print "<br />loncron errors: ".$host{$local.'_errors'};
320: }
1.9 www 321: print "</td></tr></table><br />";
322: }
323:
324: # =========================================================== Doomedness sorted
325:
326: sub doomedness {
327: my $crit=shift;
328: my %alldoomed=();
329: my @allhosts=();
330: foreach (keys %host) {
331: if ($_=~/^(\w+)\_$crit$/) {
332: if ($host{$_}) {
333: push (@allhosts,$1);
334: $alldoomed{$1}=$host{$_};
335: }
336: }
337: }
338: return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
1.8 www 339: }
1.1 www 340:
1.16 www 341: sub resetvars {
342: $maxusers=0;
343: $maxload=0;
344: $totalusers=0;
345: $stat_total=0;
346: $stat_notyet=0;
347: $stat_fromcache=0;
1.17 www 348: $concount=0;
1.16 www 349: undef %host;
350: %host=();
1.1 www 351: }
1.8 www 352:
1.16 www 353: sub mainloop {
354: &resetvars();
1.8 www 355: # ==================================================== Main Loop over all Hosts
356:
1.16 www 357: foreach my $local (sort keys %hostname) {
1.9 www 358: $host{$local.'_unresponsive_doomed'}=0;
1.8 www 359: # -- Check general status
360: &statuslist($local,'General');
361: my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
362: if (defined($loncron{'local_error'})) {
363: $host{$local.'_loncron'}='Could not determine.';
1.9 www 364: $host{$local.'_unresponsive_doomed'}++;
1.8 www 365: } else {
366: if ((time-$loncron{'time'})>$oneday) {
367: $host{$local.'_loncron'}='Stale.';
1.9 www 368: $host{$local.'_unresponsive_doomed'}++;
1.8 www 369: } else {
1.11 www 370: $host{$local.'_loncron_doomed'}=$loncron{'notices'}
371: +4*$loncron{'warnings'}
372: +100*$loncron{'errors'};
373: $host{$local.'_errors'}=$loncron{'errors'};
1.8 www 374: }
375: }
1.15 www 376: # -- Check version
377: &statuslist($local,'Version');
378: my $version=&request($local,'/lon-status/version.txt',7200);
379: if ($version eq 'local_error') {
380: $host{$local.'_version'}='Could not determine.';
381: $host{$local.'_unresponsive_doomed'}++;
382: } else {
383: $host{$local.'_version'}=$version;
384: }
1.8 www 385: # -- Check user status
386: &statuslist($local,'Users');
387: my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
388: if (defined($userstatus{'local_error'})) {
389: $host{$local.'_userstatus'}='Could not determine.';
1.9 www 390: $host{$local.'_unresponsive_doomed'}++;
1.8 www 391: } else {
1.9 www 392: $host{$local.'_users_doomed'}=$userstatus{'Active'};
393: $host{$local.'_users'}=$userstatus{'Active'};
1.11 www 394: unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
395: if ($host{$local.'_users'}>$maxusers) {
396: $maxusers=$host{$local.'_users'};
397: }
398: $totalusers+=$host{$local.'_users'};
1.9 www 399: my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
400: $host{$local.'_load_doomed'}=$mload;
1.11 www 401: if ($mload>$maxload) {
402: $maxload=$mload;
403: }
1.9 www 404: $host{$local.'_load'}=$userstatus{'loadavg'};
1.8 www 405: }
1.22 ! www 406: # -- Check reroute status
! 407: &statuslist($local,'Reroute');
! 408: my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800);
! 409: if ($reroute{'status'} eq 'rerouting') {
! 410: if ($reroute{'server'}) {
! 411: $host{$local.'_reroute'}=
! 412: 'Rerouting to <tt>'.$reroute{'server'}.
! 413: '</tt>, domain: '.$reroute{'domain'}.
! 414: ' (since '.localtime($reroute{'time'}).')';
! 415: } else {
! 416: $host{$local.'_reroute'}='offline';
! 417: }
! 418: }
1.8 www 419: # -- Check mysql status
420: &statuslist($local,'Database');
1.9 www 421: my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
1.8 www 422: if (defined($mysql{'local_error'})) {
423: $host{$local.'_mysql'}='Could not determine.';
1.9 www 424: $host{$local.'_unresponsive_doomed'}++;
1.8 www 425: } else {
426: if ((time-$mysql{'time'})>(7*$oneday)) {
427: if ($hostrole{$local} eq 'library') {
428: $host{$local.'_mysql'}='Stale.';
429: $host{$local.'_mysql_doomed'}=1;
430: }
431: if ($mysql{'mysql'} eq 'defunct') {
432: $host{$local.'_mysql'}='Defunct (maybe stale).';
433: $host{$local.'_mysql_doomed'}=2;
434: }
435: } elsif ($mysql{'mysql'} eq 'defunct') {
436: $host{$local.'_mysql'}='Defunct.';
437: $host{$local.'_mysql_doomed'}=3;
438: }
439: }
440: # -- Check rpm status
441: &statuslist($local,'RPMs');
1.9 www 442: my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
1.8 www 443: if (defined($checkrpms{'local_error'})) {
444: $host{$local.'_checkrpms'}='Could not determine.';
1.9 www 445: $host{$local.'_unresponsive_doomed'}++;
1.8 www 446: } else {
447: if ((time-$checkrpms{'time'})>(4*$oneday)) {
448: $host{$local.'_checkrpms'}='Stale.';
449: $host{$local.'_checkrpms_doomed'}=50;
1.9 www 450: $host{$local.'_unresponsive_doomed'}++;
1.8 www 451: } elsif ($checkrpms{'status'} eq 'fail') {
452: $host{$local.'_checkrpms'}='Could not checked RPMs.';
453: $host{$local.'_checkrpms_doomed'}=100;
454: } elsif ($checkrpms{'rpmcount'}) {
455: $host{$local.'_checkrpms'}='Outdated RPMs: '.
456: $checkrpms{'rpmcount'};
457: $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
458: }
459: }
460: # -- Check connections
461: &statuslist($local,'Connections');
462: $host{$local.'_notconnected'}='';
463: $host{$local.'_notconnected_doomed'}=0;
1.16 www 464: foreach my $remote (sort keys %hostname) {
1.8 www 465: my $status=&connected($local,$remote);
466: $connectionstatus{$local.'_TO_'.$remote}=$status;
467: unless (($status eq 'ok') || ($status eq 'not_yet')) {
468: $host{$local.'_notconnected'}.=' '.$remote;
469: $host{$local.'_notconnected_doomed'}++;
470: }
471: }
1.16 www 472: # =============================================================== End Main Loop
473: }
474:
1.8 www 475: }
1.16 www 476:
477: sub reports {
1.9 www 478: # ====================================================================== Output
479: if ($mode=~/\_doomed$/) {
480: # Output by doomedness
481: foreach (&doomedness($mode)) {
482: &serverstatus($_);
483: }
1.10 www 484: } elsif ($mode eq 'connections') {
485: print
486: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
487: "<tr><td bgcolor='#225522'> </td>";
1.11 www 488: foreach my $remote (sort keys %hostname) {
1.17 www 489: print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
1.10 www 490: }
491: print "</tr>\n";
492: # connection matrix
1.11 www 493: foreach my $local (sort keys %hostname) {
1.17 www 494: print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
1.11 www 495: foreach my $remote (sort keys %hostname) {
1.10 www 496: if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
1.14 www 497: my $cellcolor='#FFFFFF';
498: if ($local eq $remote) { $cellcolor='#DDDDDD'; }
499: print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
1.10 www 500: } elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
1.14 www 501: my $cellcolor='#BBDDBB';
502: if ($local eq $remote) { $cellcolor='#99DD99'; }
1.10 www 503: print
1.14 www 504: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>';
1.10 www 505: } else {
1.20 www 506: my $cellcolor='#DDCCAA';
1.14 www 507: if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
508: if ($local eq $remote) {
509: $cellcolor='#DD88AA';
510: } else {
511: $cellcolor='#DDAACC';
512: }
513: } else {
1.20 www 514: if ($local eq $remote) { $cellcolor='#DDBB77'; }
1.14 www 515: }
1.10 www 516: print
1.14 www 517: '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
1.10 www 518: $connectionstatus{$local.'_TO_'.$remote}.'<br />';
519: &lonc($local); &lond($remote);
520: print '</td>';
521: }
522: }
523: print "</tr>\n";
524: }
1.11 www 525: print "</table>";
526: } elsif ($mode eq 'users') {
527: # Users
528: if ($maxusers) {
529: my $factor=50/$maxusers;
530: print "<h3>Total active user(s): $totalusers</h3>".
531: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
532:
1.16 www 533: foreach my $local (sort keys %hostname) {
1.11 www 534: if (defined($host{$local.'_users'})) {
535: print
1.16 www 536: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
537: '</font><br /><font size="-2">'.
538: $domaindescription{$hostdom{$local}}.
539: '</font></td><td bgcolor="#DDDDBB">';
1.12 www 540: &users($local);
1.11 www 541: print
542: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
543: $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
544: &bar($factor*$host{$local.'_users'});
545: print "</td></tr>\n";
546: }
547: }
548: print "</table>";
549: } else {
550: print "No active users logged in.";
551: }
552: } elsif ($mode eq 'load') {
553: # Load
554: if ($maxload) {
555: my $factor=50/$maxload;
556: print
557: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
1.16 www 558: foreach my $local (sort keys %hostname) {
1.11 www 559: if (defined($host{$local.'_load_doomed'})) {
560: print
1.16 www 561: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
1.11 www 562: $local.
1.16 www 563: '</font><br /><font size="-2">'.
564: $domaindescription{$hostdom{$local}}.
565: '</font></td><td bgcolor="#DDDDBB">';
1.12 www 566: &server($local);
1.11 www 567: print
568: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
569: $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
570: &bar($factor*$host{$local.'_load_doomed'});
571: print "</td></tr>\n";
572: }
573: }
574: print "</table>";
575: } else {
576: print "No workload.";
577: }
578: } elsif ($mode eq 'trouble') {
579: my $count=0;
1.16 www 580: foreach my $local (sort keys %hostname) {
1.11 www 581: my $trouble='';
1.15 www 582: if ($host{$local.'_unresponsive_doomed'}>3) {
583: $trouble='Does not respond to several queries.<br />';
584: }
1.11 www 585: if ($host{$local.'_errors'}) {
586: $trouble='Has loncron errors.<br />';
587: } elsif ($host{$local.'_loncron_doomed'}>600) {
588: $trouble='High loncron count.<br />';
589: }
590: if ($host{$local.'_load_doomed'}>5) {
591: $trouble='High load.<br />';
592: }
593: if ($host{$local.'_users_doomed'}>200) {
594: $trouble='High user volume.<br />';
595: }
596: if ($host{$local.'_mysql_doomed'}>1) {
597: $trouble='MySQL database apparently offline.<br />';
598: }
599: if ($host{$local.'_checkrpms_doomed'}>100) {
600: $trouble='RPMs outdated.<br />';
1.22 ! www 601: }
! 602: if ($host{$local.'_reroute'}) {
! 603: $trouble='Re-Routing<br >';
1.11 www 604: }
605: if ($trouble) { $count++; &serverstatus($local,$trouble); }
606: }
607: unless ($count) { print "No mayor trouble."; }
1.9 www 608: }
1.16 www 609: }
610:
611: # ====================================================================== Status
612: sub statuslist {
613: my ($local,$what)=@_;
614: print
615: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
616: }
617:
618: # =============================================================================
619: # =============================================================================
620: # Main program
621: #
622: # ========================================================= Get form parameters
623: my $buffer;
624:
625: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
626: my @pairs=split(/&/,$buffer);
627: my $pair; my $name; my $value;
628: undef %FORM;
629: %FORM=();
630: foreach $pair (@pairs) {
631: ($name,$value) = split(/=/,$pair);
632: $value =~ tr/+/ /;
633: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
634: $FORM{$name}=$value;
635: }
636:
637: $buffer=$ENV{'QUERY_STRING'};
638: @pairs=split(/&/,$buffer);
639: foreach $pair (@pairs) {
640: ($name,$value) = split(/=/,$pair);
641: $value =~ tr/+/ /;
642: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
643: $FORM{$name}=$value;
644: }
645:
646: # ====================================================== Determine refresh rate
647:
648: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
649: if ($refresh<30) { $refresh=30; }
650: my $starttime=time;
651:
652: # ============================================================== Determine mode
653:
654: my %modes=('trouble' => 'Trouble',
655: 'users_doomed' => 'Doomed: Users',
656: 'loncron_doomed' => 'Doomed: General (loncron)',
657: 'mysql_doomed' => 'Doomed: Database (mysql)',
658: 'notconnected_doomed' => 'Doomed: Connections',
659: 'checkrpms_doomed' => 'Doomed: RPMs',
660: 'load_doomed' => 'Doomed: Load',
661: 'unresponsive_doomed' => 'Doomed: Status could not be determined',
662: 'users' => 'User Report',
663: 'load' => 'Load Report',
664: 'connections' => 'Connections Matrix');
665:
666: $mode=$FORM{'mode'};
667: unless ($modes{$mode}) { $mode='trouble'; }
668: # ================================================================ Send Headers
669: print "Content-type: text/html\n\n".
670: "<html><body bgcolor='#FFFFFF'>\n";
671: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
672: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
673: %perlvar=%{$perlvarref};
674: undef $perlvarref; # remove since sensitive and not needed
675: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
676: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
677:
678: # ------------------------------------------------------------- Read hosts file
679: {
680: my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
681:
682: while (my $configline=<$config>) {
683: $configline=~s/#.*$//;
684: unless ($configline=~/\w/) { next; }
685: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
686: $hostname{$id}=$name;
687: $hostdom{$id}=$domain;
688: $hostrole{$id}=$role;
689: $hostip{$id}=$ip;
690: if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
691: $libserv{$id}=$name;
692: }
693: }
694: }
695: # ------------------------------------------------------------ Read domain file
696: {
697: my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab');
698: if ($fh) {
699: while (<$fh>) {
700: next if (/^(\#|\s*$)/);
701: chomp;
1.19 www 702: my ($domain, $domain_description, $def_auth, $def_auth_arg,
703: $def_lang, $city, $longi, $lati) = split(/:/,$_);
704: $domain_auth_def{$domain}=$def_auth;
1.16 www 705: $domain_auth_arg_def{$domain}=$def_auth_arg;
1.19 www 706: $domaindescription{$domain}=$domain_description;
707: $domain_lang_def{$domain}=$def_lang;
708: $domain_city{$domain}=$city;
709: $domain_longi{$domain}=$longi;
710: $domain_lati{$domain}=$lati;
1.16 www 711: }
712: }
713: }
714:
715: print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>";
716: print "<form name='prgstat'>\n".
717: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
718: "</form>\n";;
719: print "<form name='status' method='post'>\n";
720: print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />';
721: &hidden('refresh',$refresh);
722:
723: if (!$FORM{'runonetime'}) {
724: print
725: "<h3>Gathering initial cluster data</h3>This may take some time ...<br />";
726: $fromcache=0;
727: &mainloop();
728: &statuslist('Done initial run.');
729: &reports();
730: } else {
731: $fromcache=1;
732: &mainloop();
733: &statuslist('Done gathering cached data');
734: &reports();
735: $fromcache=0;
736: &mainloop();
737: }
738: &hidden('runonetime',1);
739: print '<tt><br />Total number of queries: '.$stat_total.
740: '<br />Percent complete: '.
741: int(($stat_total-$stat_notyet)/$stat_total*100.).
742: '<br />Percent from cache: '.
743: int($stat_fromcache/$stat_total*100.).'</tt>';
744:
1.9 www 745: # ============================================================== Close, refresh
1.8 www 746: print "</form><script>";
1.16 www 747: my $runtime=time-$starttime;
748: if (($refresh-$runtime)<0) {
749: print "document.status.submit();";
1.8 www 750: } else {
1.16 www 751: my $refreshtime=int(1000*($refresh-$runtime));
1.11 www 752: print "setTimeout('document.status.submit()',$refreshtime);\n".
753: "document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'";
1.2 www 754: }
1.8 www 755: print "</script></body></html>";
756: exit 0;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to clusterstatus.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi