File:
[LON-CAPA] /
loncom /
cgi /
clusterstatus.pl
Revision
1.24:
download - view:
text,
annotated -
select for diffs
Wed Apr 13 18:30:46 2005 UTC (19 years, 1 month ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_7_X,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
HEAD
- up the floor on the clusterstatus page
1: #!/usr/bin/perl
2: $|=1;
3: # Generates a html page showing various sataus reports about the cluster
4: # $Id: clusterstatus.pl,v 1.24 2005/04/13 18:30:46 albertel Exp $
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/
27: #
28:
29: use lib '/home/httpd/lib/perl/';
30: use LONCAPA::Configuration;
31: use strict;
32:
33: use LWP::UserAgent();
34: use HTTP::Headers;
35: use IO::File;
36:
37: my %host=();
38: my $oneday=60*60*24;
39:
40: my %connectionstatus=();
41: my %perlvar=();
42:
43: my $mode;
44: my $concount=0;
45: my $fromcache;
46:
47: my %domaindescription = ();
48: my %domain_auth_def = ();
49: my %domain_auth_arg_def = ();
50: my %domain_lang_def=();
51: my %domain_city=();
52: my %domain_longi=();
53: my %domain_lati=();
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;
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:
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)=@_;
98: $cachetime*=(0.5+rand);
99: my $key=&key($local,$url);
100: my $reply='';
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
113: if ($FORM{$key.'_time'}) {
114: if ((time-$FORM{$key.'_time'})<$cachetime) {
115: $reply=$FORM{$key};
116: &hidden($key.'_time',$FORM{$key.'_time'});
117: $stat_fromcache++;
118: }
119: }
120: unless ($reply) {
121: unless ($hostname{$local}) {
122: $reply='local_unknown';
123: } else {
124:
125: my $ua=new LWP::UserAgent(timeout => 10);
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?
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'; }
153: my $url='/cgi-bin/ping.pl?'.$remote;
154: #
155: # Slowly phase this in: if not cached, only do 5 percent of the cases,
156: # but always do the first five.
157: #
158: unless ($FORM{&key($local,$url)}) {
159: unless (($concount<=5) || (rand>0.95)) {
160: $stat_total++;
161: $stat_notyet++;
162: return 'not_yet';
163: } else {
164: $concount++;
165: }
166: }
167: #
168: # Actually do the query
169: #
170: &statuslist($local,'connecting '.$remote);
171: my $reply=&request($local,$url,3600);
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: }
190:
191: # ================================================================ Link to host
192:
193: sub otherwindow {
194: my ($local,$url,$label)=@_;
195: return
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');
238: }
239:
240: sub announcement {
241: my $local=shift;
242: print &otherwindow($local,'/announcement.txt','Announcement');
243: }
244:
245: sub takeonline {
246: my $local=shift;
247: print &otherwindow($local,'/cgi-bin/takeonline.pl','Take online');
248: }
249:
250: sub takeoffline {
251: my $local=shift;
252: print &otherwindow($local,'/cgi-bin/takeoffline.pl','Take offline');
253: }
254:
255: sub reroute {
256: my ($local,$remote)=@_;
257: print &otherwindow($local,'/cgi-bin/takeoffline.pl?'.
258: $hostname{$remote}.'&'.$hostdom{$local}
259: ,$remote)."\n";
260: }
261:
262: sub allreroutes {
263: my $local=shift;
264: &takeoffline($local);
265: print ' Reroute to: <font size="1">';
266: foreach my $remote (sort keys %hostname) {
267: unless ($local eq $remote) {
268: &reroute($local,$remote);
269: }
270: }
271: print '</font>';
272: }
273:
274: # ========================================================= Produce a green bar
275: sub bar {
276: my $parm=shift;
277: my $number=int($parm+0.5);
278: print "<table><tr><td bgcolor='#225522'><font color='#225522'>";
279: for (my $i=0;$i<$number;$i++) {
280: print "+";
281: }
282: print "</font></table>";
283: }
284:
285: # ========================================================== Show server status
286:
287: sub serverstatus {
288: my ($local,$trouble)=@_;
289: print (<<ENDHEADER);
290: <a name="$local" />
291: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
292: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
293: $local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt>
294: <br />$domaindescription{$hostdom{$local}}
295: $domain_city{$hostdom{$local}}
296: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
297: ENDHEADER
298: &login($local);&server($local);&users($local);&versions($local);
299: &announcement($local);
300: &loncron($local);&lond($local);&lonc($local);&runloncron($local);
301: print "</font></td></tr>";
302: if ($trouble) {
303: print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
304: }
305: print "<tr><td bgcolor='#BBBBBB'>";
306: # re-routing
307: if ($host{$local.'_reroute'}) {
308: print "<br />Reroute: ".$host{$local.'_reroute'};
309: &takeonline($local);
310: }
311: # version
312: if ($host{$local.'_version'}) {
313: print "<br />Version: ".$host{$local.'_version'}
314: }
315: # load
316: if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
317: print "<br />Load: ".$host{$local.'_load'}
318: }
319: # users
320: if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
321: print "<br />Active Users: ".$host{$local.'_users'}
322: }
323:
324: # checkrpms
325: if ($host{$local.'_checkrpms'}) {
326: print "<br />RPMs: ".$host{$local.'_checkrpms'}
327: }
328: # mysql
329: if ($host{$local.'_mysql'}) {
330: print "<br />MySQL Database: ".$host{$local.'_mysql'}
331: }
332: # connections
333: if ($host{$local.'_notconnected'}) {
334: print "<br />Not connected: ";
335: foreach (split(/ /,$host{$local.'_notconnected'})) {
336: if ($_) {
337: print " <a href='#$_'>$_</a>";
338: }
339: }
340: }
341: # errors
342: if ($host{$local.'_errors'}) {
343: print "<br />loncron errors: ".$host{$local.'_errors'};
344: }
345: print "</td></tr><tr><td bgcolor='#DDDDDD'>";
346: &allreroutes($local);
347: print "</td></tr></table><br />";
348: }
349:
350: # =========================================================== Doomedness sorted
351:
352: sub doomedness {
353: my $crit=shift;
354: my %alldoomed=();
355: my @allhosts=();
356: foreach (keys %host) {
357: if ($_=~/^(\w+)\_$crit$/) {
358: if ($host{$_}) {
359: push (@allhosts,$1);
360: $alldoomed{$1}=$host{$_};
361: }
362: }
363: }
364: return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
365: }
366:
367: sub resetvars {
368: $maxusers=0;
369: $maxload=0;
370: $totalusers=0;
371: $stat_total=0;
372: $stat_notyet=0;
373: $stat_fromcache=0;
374: $concount=0;
375: undef %host;
376: %host=();
377: }
378:
379: sub mainloop {
380: &resetvars();
381: # ==================================================== Main Loop over all Hosts
382:
383: foreach my $local (sort keys %hostname) {
384: $host{$local.'_unresponsive_doomed'}=0;
385: # -- Check general status
386: &statuslist($local,'General');
387: my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
388: if (defined($loncron{'local_error'})) {
389: $host{$local.'_loncron'}='Could not determine.';
390: $host{$local.'_unresponsive_doomed'}++;
391: } else {
392: if ((time-$loncron{'time'})>$oneday) {
393: $host{$local.'_loncron'}='Stale.';
394: $host{$local.'_unresponsive_doomed'}++;
395: } else {
396: $host{$local.'_loncron_doomed'}=$loncron{'notices'}
397: +4*$loncron{'warnings'}
398: +100*$loncron{'errors'};
399: $host{$local.'_errors'}=$loncron{'errors'};
400: }
401: }
402: # -- Check version
403: &statuslist($local,'Version');
404: my $version=&request($local,'/lon-status/version.txt',7200);
405: if ($version eq 'local_error') {
406: $host{$local.'_version'}='Could not determine.';
407: $host{$local.'_unresponsive_doomed'}++;
408: } else {
409: $host{$local.'_version'}=$version;
410: }
411: # -- Check user status
412: &statuslist($local,'Users');
413: my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
414: if (defined($userstatus{'local_error'})) {
415: $host{$local.'_userstatus'}='Could not determine.';
416: $host{$local.'_unresponsive_doomed'}++;
417: } else {
418: $host{$local.'_users_doomed'}=$userstatus{'Active'};
419: $host{$local.'_users'}=$userstatus{'Active'};
420: unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
421: if ($host{$local.'_users'}>$maxusers) {
422: $maxusers=$host{$local.'_users'};
423: }
424: $totalusers+=$host{$local.'_users'};
425: my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
426: $host{$local.'_load_doomed'}=$mload;
427: if ($mload>$maxload) {
428: $maxload=$mload;
429: }
430: $host{$local.'_load'}=$userstatus{'loadavg'};
431: }
432: # -- Check reroute status
433: &statuslist($local,'Reroute');
434: my %reroute=&replyhash($local,'/lon-status/reroute.txt',1800);
435: if ($reroute{'status'} eq 'rerouting') {
436: if ($reroute{'server'}) {
437: $host{$local.'_reroute'}=
438: 'Rerouting to <tt>'.$reroute{'server'}.
439: '</tt>, domain: '.$reroute{'domain'}.
440: ' (since '.localtime($reroute{'time'}).')';
441: } else {
442: $host{$local.'_reroute'}='offline';
443: }
444: }
445: # -- Check mysql status
446: &statuslist($local,'Database');
447: my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
448: if (defined($mysql{'local_error'})) {
449: $host{$local.'_mysql'}='Could not determine.';
450: $host{$local.'_unresponsive_doomed'}++;
451: } else {
452: if ((time-$mysql{'time'})>(7*$oneday)) {
453: if ($hostrole{$local} eq 'library') {
454: $host{$local.'_mysql'}='Stale.';
455: $host{$local.'_mysql_doomed'}=1;
456: }
457: if ($mysql{'mysql'} eq 'defunct') {
458: $host{$local.'_mysql'}='Defunct (maybe stale).';
459: $host{$local.'_mysql_doomed'}=2;
460: }
461: } elsif ($mysql{'mysql'} eq 'defunct') {
462: $host{$local.'_mysql'}='Defunct.';
463: $host{$local.'_mysql_doomed'}=3;
464: }
465: }
466: # -- Check rpm status
467: &statuslist($local,'RPMs');
468: my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
469: if (defined($checkrpms{'local_error'})) {
470: $host{$local.'_checkrpms'}='Could not determine.';
471: $host{$local.'_unresponsive_doomed'}++;
472: } else {
473: if ((time-$checkrpms{'time'})>(4*$oneday)) {
474: $host{$local.'_checkrpms'}='Stale.';
475: $host{$local.'_checkrpms_doomed'}=50;
476: $host{$local.'_unresponsive_doomed'}++;
477: } elsif ($checkrpms{'status'} eq 'fail') {
478: $host{$local.'_checkrpms'}='Could not checked RPMs.';
479: $host{$local.'_checkrpms_doomed'}=100;
480: } elsif ($checkrpms{'rpmcount'}) {
481: $host{$local.'_checkrpms'}='Outdated RPMs: '.
482: $checkrpms{'rpmcount'};
483: $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
484: }
485: }
486: # -- Check connections
487: &statuslist($local,'Connections');
488: $host{$local.'_notconnected'}='';
489: $host{$local.'_notconnected_doomed'}=0;
490: foreach my $remote (sort keys %hostname) {
491: my $status=&connected($local,$remote);
492: $connectionstatus{$local.'_TO_'.$remote}=$status;
493: unless (($status eq 'ok') || ($status eq 'not_yet')) {
494: $host{$local.'_notconnected'}.=' '.$remote;
495: $host{$local.'_notconnected_doomed'}++;
496: }
497: }
498: # =============================================================== End Main Loop
499: }
500:
501: }
502:
503: sub reports {
504: # ====================================================================== Output
505: if ($mode=~/\_doomed$/) {
506: # Output by doomedness
507: foreach (&doomedness($mode)) {
508: &serverstatus($_);
509: }
510: } elsif ($mode eq 'connections') {
511: print
512: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
513: "<tr><td bgcolor='#225522'> </td>";
514: foreach my $remote (sort keys %hostname) {
515: print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
516: }
517: print "</tr>\n";
518: # connection matrix
519: foreach my $local (sort keys %hostname) {
520: print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
521: foreach my $remote (sort keys %hostname) {
522: if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
523: my $cellcolor='#FFFFFF';
524: if ($local eq $remote) { $cellcolor='#DDDDDD'; }
525: print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
526: } elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
527: my $cellcolor='#BBDDBB';
528: if ($local eq $remote) { $cellcolor='#99DD99'; }
529: print
530: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>';
531: } else {
532: my $cellcolor='#DDCCAA';
533: if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
534: if ($local eq $remote) {
535: $cellcolor='#DD88AA';
536: } else {
537: $cellcolor='#DDAACC';
538: }
539: } else {
540: if ($local eq $remote) { $cellcolor='#DDBB77'; }
541: }
542: print
543: '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
544: $connectionstatus{$local.'_TO_'.$remote}.'<br />';
545: &lonc($local); &lond($remote);
546: print '</td>';
547: }
548: }
549: print "</tr>\n";
550: }
551: print "</table>";
552: } elsif ($mode eq 'users') {
553: # Users
554: if ($maxusers) {
555: my $factor=50/$maxusers;
556: print "<h3>Total active user(s): $totalusers</h3>".
557: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
558:
559: foreach my $local (sort keys %hostname) {
560: if (defined($host{$local.'_users'})) {
561: print
562: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
563: '</font><br /><font size="-2">'.
564: $domaindescription{$hostdom{$local}}.
565: '</font></td><td bgcolor="#DDDDBB">';
566: &users($local);
567: print
568: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
569: $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
570: &bar($factor*$host{$local.'_users'});
571: print "</td></tr>\n";
572: }
573: }
574: print "</table>";
575: } else {
576: print "No active users logged in.";
577: }
578: } elsif ($mode eq 'load') {
579: # Load
580: if ($maxload) {
581: my $factor=50/$maxload;
582: print
583: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
584: foreach my $local (sort keys %hostname) {
585: if (defined($host{$local.'_load_doomed'})) {
586: print
587: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
588: $local.
589: '</font><br /><font size="-2">'.
590: $domaindescription{$hostdom{$local}}.
591: '</font></td><td bgcolor="#DDDDBB">';
592: &server($local);
593: print
594: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
595: $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
596: &bar($factor*$host{$local.'_load_doomed'});
597: print "</td></tr>\n";
598: }
599: }
600: print "</table>";
601: } else {
602: print "No workload.";
603: }
604: } elsif ($mode eq 'trouble') {
605: my $count=0;
606: foreach my $local (sort keys %hostname) {
607: my $trouble='';
608: if ($host{$local.'_unresponsive_doomed'}>3) {
609: $trouble='Does not respond to several queries.<br />';
610: }
611: if ($host{$local.'_errors'}) {
612: $trouble='Has loncron errors.<br />';
613: } elsif ($host{$local.'_loncron_doomed'}>2500) {
614: $trouble='High loncron count.<br />';
615: }
616: if ($host{$local.'_load_doomed'}>5) {
617: $trouble='High load.<br />';
618: }
619: if ($host{$local.'_users_doomed'}>200) {
620: $trouble='High user volume.<br />';
621: }
622: if ($host{$local.'_mysql_doomed'}>1) {
623: $trouble='MySQL database apparently offline.<br />';
624: }
625: if ($host{$local.'_checkrpms_doomed'}>100) {
626: $trouble='RPMs outdated.<br />';
627: }
628: if ($host{$local.'_reroute'}) {
629: $trouble='Rerouting<br >';
630: }
631: if ($trouble) { $count++; &serverstatus($local,$trouble); }
632: }
633: unless ($count) { print "No mayor trouble."; }
634: }
635: }
636:
637: # ====================================================================== Status
638: sub statuslist {
639: my ($local,$what)=@_;
640: print
641: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
642: }
643:
644: # =============================================================================
645: # =============================================================================
646: # Main program
647: #
648: # ========================================================= Get form parameters
649: my $buffer;
650:
651: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
652: my @pairs=split(/&/,$buffer);
653: my $pair; my $name; my $value;
654: undef %FORM;
655: %FORM=();
656: foreach $pair (@pairs) {
657: ($name,$value) = split(/=/,$pair);
658: $value =~ tr/+/ /;
659: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
660: $FORM{$name}=$value;
661: }
662:
663: $buffer=$ENV{'QUERY_STRING'};
664: @pairs=split(/&/,$buffer);
665: foreach $pair (@pairs) {
666: ($name,$value) = split(/=/,$pair);
667: $value =~ tr/+/ /;
668: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
669: $FORM{$name}=$value;
670: }
671:
672: # ====================================================== Determine refresh rate
673:
674: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
675: if ($refresh<30) { $refresh=30; }
676: my $starttime=time;
677:
678: # ============================================================== Determine mode
679:
680: my %modes=('trouble' => 'Trouble',
681: 'users_doomed' => 'Doomed: Users',
682: 'loncron_doomed' => 'Doomed: General (loncron)',
683: 'mysql_doomed' => 'Doomed: Database (mysql)',
684: 'notconnected_doomed' => 'Doomed: Connections',
685: 'checkrpms_doomed' => 'Doomed: RPMs',
686: 'load_doomed' => 'Doomed: Load',
687: 'unresponsive_doomed' => 'Doomed: Status could not be determined',
688: 'users' => 'User Report',
689: 'load' => 'Load Report',
690: 'connections' => 'Connections Matrix');
691:
692: $mode=$FORM{'mode'};
693: unless ($modes{$mode}) { $mode='trouble'; }
694: # ================================================================ Send Headers
695: print "Content-type: text/html\n\n".
696: "<html><body bgcolor='#FFFFFF'>\n";
697: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
698: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
699: %perlvar=%{$perlvarref};
700: undef $perlvarref; # remove since sensitive and not needed
701: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
702: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
703:
704: # ------------------------------------------------------------- Read hosts file
705: {
706: my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
707:
708: while (my $configline=<$config>) {
709: $configline=~s/#.*$//;
710: unless ($configline=~/\w/) { next; }
711: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
712: $hostname{$id}=$name;
713: $hostdom{$id}=$domain;
714: $hostrole{$id}=$role;
715: $hostip{$id}=$ip;
716: if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
717: $libserv{$id}=$name;
718: }
719: }
720: }
721: # ------------------------------------------------------------ Read domain file
722: {
723: my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab');
724: if ($fh) {
725: while (<$fh>) {
726: next if (/^(\#|\s*$)/);
727: chomp;
728: my ($domain, $domain_description, $def_auth, $def_auth_arg,
729: $def_lang, $city, $longi, $lati) = split(/:/,$_);
730: $domain_auth_def{$domain}=$def_auth;
731: $domain_auth_arg_def{$domain}=$def_auth_arg;
732: $domaindescription{$domain}=$domain_description;
733: $domain_lang_def{$domain}=$def_lang;
734: $domain_city{$domain}=$city;
735: $domain_longi{$domain}=$longi;
736: $domain_lati{$domain}=$lati;
737: }
738: }
739: }
740:
741: print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>";
742: print "<form name='prgstat'>\n".
743: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
744: "</form>\n";;
745: print "<form name='status' method='post'>\n";
746: print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />';
747: &hidden('refresh',$refresh);
748:
749: if (!$FORM{'runonetime'}) {
750: print
751: "<h3>Gathering initial cluster data</h3>This may take some time ...<br />";
752: $fromcache=0;
753: &mainloop();
754: &statuslist('Done initial run.');
755: &reports();
756: } else {
757: $fromcache=1;
758: &mainloop();
759: &statuslist('Done gathering cached data');
760: &reports();
761: $fromcache=0;
762: &mainloop();
763: }
764: &hidden('runonetime',1);
765: print '<tt><br />Total number of queries: '.$stat_total.
766: '<br />Percent complete: '.
767: int(($stat_total-$stat_notyet)/$stat_total*100.).
768: '<br />Percent from cache: '.
769: int($stat_fromcache/$stat_total*100.).'</tt>';
770:
771: # ============================================================== Close, refresh
772: print "</form><script>";
773: my $runtime=time-$starttime;
774: if (($refresh-$runtime)<0) {
775: print "document.status.submit();";
776: } else {
777: my $refreshtime=int(1000*($refresh-$runtime));
778: print "setTimeout('document.status.submit()',$refreshtime);\n".
779: "document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'";
780: }
781: print "</script></body></html>";
782: 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