Annotation of loncom/cgi/clusterstatus.pl, revision 1.21
1.1 www 1: #!/usr/bin/perl
2: $|=1;
1.21 ! albertel 3: # Generates a html page showing various sataus reports about the cluster
! 4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www 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/
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.11 www 245: # ========================================================= Produce a green bar
246: sub bar {
247: my $parm=shift;
248: my $number=int($parm+0.5);
249: print "<table><tr><td bgcolor='#225522'><font color='#225522'>";
250: for (my $i=0;$i<$number;$i++) {
251: print "+";
252: }
253: print "</font></table>";
254: }
255:
1.9 www 256: # ========================================================== Show server status
257:
1.8 www 258: sub serverstatus {
1.11 www 259: my ($local,$trouble)=@_;
1.9 www 260: print (<<ENDHEADER);
1.11 www 261: <a name="$local" />
1.9 www 262: <table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
263: <tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
264: $local $hostdom{$local}</b> <tt>($hostname{$local}; $hostrole{$local})</tt>
265: <br />$domaindescription{$hostdom{$local}}
1.19 www 266: $domain_city{$hostdom{$local}}
1.10 www 267: </font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
1.9 www 268: ENDHEADER
269: &login($local);&server($local);&users($local);&versions($local);
1.18 www 270: &announcement($local);
1.9 www 271: &loncron($local);&lond($local);&lonc($local);&runloncron($local);
1.11 www 272: print "</font></td></tr>";
273: if ($trouble) {
274: print ("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
275: }
276: print "<tr><td bgcolor='#BBBBBB'>";
1.15 www 277: # version
278: if ($host{$local.'_version'}) {
279: print "<br />Version: ".$host{$local.'_version'}
280: }
1.9 www 281: # load
282: if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
283: print "<br />Load: ".$host{$local.'_load'}
284: }
285: # users
286: if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
287: print "<br />Active Users: ".$host{$local.'_users'}
288: }
289:
1.8 www 290: # checkrpms
291: if ($host{$local.'_checkrpms'}) {
292: print "<br />RPMs: ".$host{$local.'_checkrpms'}
293: }
294: # mysql
295: if ($host{$local.'_mysql'}) {
296: print "<br />MySQL Database: ".$host{$local.'_mysql'}
297: }
1.11 www 298: # connections
299: if ($host{$local.'_notconnected'}) {
300: print "<br />Not connected: ";
301: foreach (split(/ /,$host{$local.'_notconnected'})) {
302: if ($_) {
303: print " <a href='#$_'>$_</a>";
304: }
305: }
306: }
307: # errors
308: if ($host{$local.'_errors'}) {
309: print "<br />loncron errors: ".$host{$local.'_errors'};
310: }
1.9 www 311: print "</td></tr></table><br />";
312: }
313:
314: # =========================================================== Doomedness sorted
315:
316: sub doomedness {
317: my $crit=shift;
318: my %alldoomed=();
319: my @allhosts=();
320: foreach (keys %host) {
321: if ($_=~/^(\w+)\_$crit$/) {
322: if ($host{$_}) {
323: push (@allhosts,$1);
324: $alldoomed{$1}=$host{$_};
325: }
326: }
327: }
328: return sort { $alldoomed{$b} <=> $alldoomed{$a} } @allhosts;
1.8 www 329: }
1.1 www 330:
1.16 www 331: sub resetvars {
332: $maxusers=0;
333: $maxload=0;
334: $totalusers=0;
335: $stat_total=0;
336: $stat_notyet=0;
337: $stat_fromcache=0;
1.17 www 338: $concount=0;
1.16 www 339: undef %host;
340: %host=();
1.1 www 341: }
1.8 www 342:
1.16 www 343: sub mainloop {
344: &resetvars();
1.8 www 345: # ==================================================== Main Loop over all Hosts
346:
1.16 www 347: foreach my $local (sort keys %hostname) {
1.9 www 348: $host{$local.'_unresponsive_doomed'}=0;
1.8 www 349: # -- Check general status
350: &statuslist($local,'General');
351: my %loncron=&replyhash($local,'/lon-status/loncron_simple.txt',1200);
352: if (defined($loncron{'local_error'})) {
353: $host{$local.'_loncron'}='Could not determine.';
1.9 www 354: $host{$local.'_unresponsive_doomed'}++;
1.8 www 355: } else {
356: if ((time-$loncron{'time'})>$oneday) {
357: $host{$local.'_loncron'}='Stale.';
1.9 www 358: $host{$local.'_unresponsive_doomed'}++;
1.8 www 359: } else {
1.11 www 360: $host{$local.'_loncron_doomed'}=$loncron{'notices'}
361: +4*$loncron{'warnings'}
362: +100*$loncron{'errors'};
363: $host{$local.'_errors'}=$loncron{'errors'};
1.8 www 364: }
365: }
1.15 www 366: # -- Check version
367: &statuslist($local,'Version');
368: my $version=&request($local,'/lon-status/version.txt',7200);
369: if ($version eq 'local_error') {
370: $host{$local.'_version'}='Could not determine.';
371: $host{$local.'_unresponsive_doomed'}++;
372: } else {
373: $host{$local.'_version'}=$version;
374: }
1.8 www 375: # -- Check user status
376: &statuslist($local,'Users');
377: my %userstatus=&replyhash($local,'/cgi-bin/userstatus.pl?simple',600);
378: if (defined($userstatus{'local_error'})) {
379: $host{$local.'_userstatus'}='Could not determine.';
1.9 www 380: $host{$local.'_unresponsive_doomed'}++;
1.8 www 381: } else {
1.9 www 382: $host{$local.'_users_doomed'}=$userstatus{'Active'};
383: $host{$local.'_users'}=$userstatus{'Active'};
1.11 www 384: unless ($host{$local.'_users'}) { $host{$local.'_users'}=0; }
385: if ($host{$local.'_users'}>$maxusers) {
386: $maxusers=$host{$local.'_users'};
387: }
388: $totalusers+=$host{$local.'_users'};
1.9 www 389: my ($sload,$mload,$lload)=split(/ /,$userstatus{'loadavg'});
390: $host{$local.'_load_doomed'}=$mload;
1.11 www 391: if ($mload>$maxload) {
392: $maxload=$mload;
393: }
1.9 www 394: $host{$local.'_load'}=$userstatus{'loadavg'};
1.8 www 395: }
396: # -- Check mysql status
397: &statuslist($local,'Database');
1.9 www 398: my %mysql=&replyhash($local,'/lon-status/mysql.txt',3600);
1.8 www 399: if (defined($mysql{'local_error'})) {
400: $host{$local.'_mysql'}='Could not determine.';
1.9 www 401: $host{$local.'_unresponsive_doomed'}++;
1.8 www 402: } else {
403: if ((time-$mysql{'time'})>(7*$oneday)) {
404: if ($hostrole{$local} eq 'library') {
405: $host{$local.'_mysql'}='Stale.';
406: $host{$local.'_mysql_doomed'}=1;
407: }
408: if ($mysql{'mysql'} eq 'defunct') {
409: $host{$local.'_mysql'}='Defunct (maybe stale).';
410: $host{$local.'_mysql_doomed'}=2;
411: }
412: } elsif ($mysql{'mysql'} eq 'defunct') {
413: $host{$local.'_mysql'}='Defunct.';
414: $host{$local.'_mysql_doomed'}=3;
415: }
416: }
417: # -- Check rpm status
418: &statuslist($local,'RPMs');
1.9 www 419: my %checkrpms=&replyhash($local,'/lon-status/checkrpms.txt',7200);
1.8 www 420: if (defined($checkrpms{'local_error'})) {
421: $host{$local.'_checkrpms'}='Could not determine.';
1.9 www 422: $host{$local.'_unresponsive_doomed'}++;
1.8 www 423: } else {
424: if ((time-$checkrpms{'time'})>(4*$oneday)) {
425: $host{$local.'_checkrpms'}='Stale.';
426: $host{$local.'_checkrpms_doomed'}=50;
1.9 www 427: $host{$local.'_unresponsive_doomed'}++;
1.8 www 428: } elsif ($checkrpms{'status'} eq 'fail') {
429: $host{$local.'_checkrpms'}='Could not checked RPMs.';
430: $host{$local.'_checkrpms_doomed'}=100;
431: } elsif ($checkrpms{'rpmcount'}) {
432: $host{$local.'_checkrpms'}='Outdated RPMs: '.
433: $checkrpms{'rpmcount'};
434: $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
435: }
436: }
437: # -- Check connections
438: &statuslist($local,'Connections');
439: $host{$local.'_notconnected'}='';
440: $host{$local.'_notconnected_doomed'}=0;
1.16 www 441: foreach my $remote (sort keys %hostname) {
1.8 www 442: my $status=&connected($local,$remote);
443: $connectionstatus{$local.'_TO_'.$remote}=$status;
444: unless (($status eq 'ok') || ($status eq 'not_yet')) {
445: $host{$local.'_notconnected'}.=' '.$remote;
446: $host{$local.'_notconnected_doomed'}++;
447: }
448: }
1.16 www 449: # =============================================================== End Main Loop
450: }
451:
1.8 www 452: }
1.16 www 453:
454: sub reports {
1.9 www 455: # ====================================================================== Output
456: if ($mode=~/\_doomed$/) {
457: # Output by doomedness
458: foreach (&doomedness($mode)) {
459: &serverstatus($_);
460: }
1.10 www 461: } elsif ($mode eq 'connections') {
462: print
463: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
464: "<tr><td bgcolor='#225522'> </td>";
1.11 www 465: foreach my $remote (sort keys %hostname) {
1.17 www 466: print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
1.10 www 467: }
468: print "</tr>\n";
469: # connection matrix
1.11 www 470: foreach my $local (sort keys %hostname) {
1.17 www 471: print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
1.11 www 472: foreach my $remote (sort keys %hostname) {
1.10 www 473: if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
1.14 www 474: my $cellcolor='#FFFFFF';
475: if ($local eq $remote) { $cellcolor='#DDDDDD'; }
476: print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
1.10 www 477: } elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
1.14 www 478: my $cellcolor='#BBDDBB';
479: if ($local eq $remote) { $cellcolor='#99DD99'; }
1.10 www 480: print
1.14 www 481: '<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>ok</b></td>';
1.10 www 482: } else {
1.20 www 483: my $cellcolor='#DDCCAA';
1.14 www 484: if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
485: if ($local eq $remote) {
486: $cellcolor='#DD88AA';
487: } else {
488: $cellcolor='#DDAACC';
489: }
490: } else {
1.20 www 491: if ($local eq $remote) { $cellcolor='#DDBB77'; }
1.14 www 492: }
1.10 www 493: print
1.14 www 494: '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
1.10 www 495: $connectionstatus{$local.'_TO_'.$remote}.'<br />';
496: &lonc($local); &lond($remote);
497: print '</td>';
498: }
499: }
500: print "</tr>\n";
501: }
1.11 www 502: print "</table>";
503: } elsif ($mode eq 'users') {
504: # Users
505: if ($maxusers) {
506: my $factor=50/$maxusers;
507: print "<h3>Total active user(s): $totalusers</h3>".
508: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
509:
1.16 www 510: foreach my $local (sort keys %hostname) {
1.11 www 511: if (defined($host{$local.'_users'})) {
512: print
1.16 www 513: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
514: '</font><br /><font size="-2">'.
515: $domaindescription{$hostdom{$local}}.
516: '</font></td><td bgcolor="#DDDDBB">';
1.12 www 517: &users($local);
1.11 www 518: print
519: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
520: $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB"';
521: &bar($factor*$host{$local.'_users'});
522: print "</td></tr>\n";
523: }
524: }
525: print "</table>";
526: } else {
527: print "No active users logged in.";
528: }
529: } elsif ($mode eq 'load') {
530: # Load
531: if ($maxload) {
532: my $factor=50/$maxload;
533: print
534: "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
1.16 www 535: foreach my $local (sort keys %hostname) {
1.11 www 536: if (defined($host{$local.'_load_doomed'})) {
537: print
1.16 www 538: '<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
1.11 www 539: $local.
1.16 www 540: '</font><br /><font size="-2">'.
541: $domaindescription{$hostdom{$local}}.
542: '</font></td><td bgcolor="#DDDDBB">';
1.12 www 543: &server($local);
1.11 www 544: print
545: '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
546: $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB"';
547: &bar($factor*$host{$local.'_load_doomed'});
548: print "</td></tr>\n";
549: }
550: }
551: print "</table>";
552: } else {
553: print "No workload.";
554: }
555: } elsif ($mode eq 'trouble') {
556: my $count=0;
1.16 www 557: foreach my $local (sort keys %hostname) {
1.11 www 558: my $trouble='';
1.15 www 559: if ($host{$local.'_unresponsive_doomed'}>3) {
560: $trouble='Does not respond to several queries.<br />';
561: }
1.11 www 562: if ($host{$local.'_errors'}) {
563: $trouble='Has loncron errors.<br />';
564: } elsif ($host{$local.'_loncron_doomed'}>600) {
565: $trouble='High loncron count.<br />';
566: }
567: if ($host{$local.'_load_doomed'}>5) {
568: $trouble='High load.<br />';
569: }
570: if ($host{$local.'_users_doomed'}>200) {
571: $trouble='High user volume.<br />';
572: }
573: if ($host{$local.'_mysql_doomed'}>1) {
574: $trouble='MySQL database apparently offline.<br />';
575: }
576: if ($host{$local.'_checkrpms_doomed'}>100) {
577: $trouble='RPMs outdated.<br />';
578: }
579: if ($trouble) { $count++; &serverstatus($local,$trouble); }
580: }
581: unless ($count) { print "No mayor trouble."; }
1.9 www 582: }
1.16 www 583: }
584:
585: # ====================================================================== Status
586: sub statuslist {
587: my ($local,$what)=@_;
588: print
589: "<script>document.prgstat.progress.value='Testing $local ($hostname{$local}): $what';</script>\n";
590: }
591:
592: # =============================================================================
593: # =============================================================================
594: # Main program
595: #
596: # ========================================================= Get form parameters
597: my $buffer;
598:
599: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
600: my @pairs=split(/&/,$buffer);
601: my $pair; my $name; my $value;
602: undef %FORM;
603: %FORM=();
604: foreach $pair (@pairs) {
605: ($name,$value) = split(/=/,$pair);
606: $value =~ tr/+/ /;
607: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
608: $FORM{$name}=$value;
609: }
610:
611: $buffer=$ENV{'QUERY_STRING'};
612: @pairs=split(/&/,$buffer);
613: foreach $pair (@pairs) {
614: ($name,$value) = split(/=/,$pair);
615: $value =~ tr/+/ /;
616: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
617: $FORM{$name}=$value;
618: }
619:
620: # ====================================================== Determine refresh rate
621:
622: my $refresh=(($FORM{'refresh'}=~/^\d+$/)?$FORM{'refresh'}:30);
623: if ($refresh<30) { $refresh=30; }
624: my $starttime=time;
625:
626: # ============================================================== Determine mode
627:
628: my %modes=('trouble' => 'Trouble',
629: 'users_doomed' => 'Doomed: Users',
630: 'loncron_doomed' => 'Doomed: General (loncron)',
631: 'mysql_doomed' => 'Doomed: Database (mysql)',
632: 'notconnected_doomed' => 'Doomed: Connections',
633: 'checkrpms_doomed' => 'Doomed: RPMs',
634: 'load_doomed' => 'Doomed: Load',
635: 'unresponsive_doomed' => 'Doomed: Status could not be determined',
636: 'users' => 'User Report',
637: 'load' => 'Load Report',
638: 'connections' => 'Connections Matrix');
639:
640: $mode=$FORM{'mode'};
641: unless ($modes{$mode}) { $mode='trouble'; }
642: # ================================================================ Send Headers
643: print "Content-type: text/html\n\n".
644: "<html><body bgcolor='#FFFFFF'>\n";
645: # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
646: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
647: %perlvar=%{$perlvarref};
648: undef $perlvarref; # remove since sensitive and not needed
649: delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
650: delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
651:
652: # ------------------------------------------------------------- Read hosts file
653: {
654: my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
655:
656: while (my $configline=<$config>) {
657: $configline=~s/#.*$//;
658: unless ($configline=~/\w/) { next; }
659: my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
660: $hostname{$id}=$name;
661: $hostdom{$id}=$domain;
662: $hostrole{$id}=$role;
663: $hostip{$id}=$ip;
664: if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
665: $libserv{$id}=$name;
666: }
667: }
668: }
669: # ------------------------------------------------------------ Read domain file
670: {
671: my $fh=IO::File->new($perlvar{'lonTabDir'}.'/domain.tab');
672: if ($fh) {
673: while (<$fh>) {
674: next if (/^(\#|\s*$)/);
675: chomp;
1.19 www 676: my ($domain, $domain_description, $def_auth, $def_auth_arg,
677: $def_lang, $city, $longi, $lati) = split(/:/,$_);
678: $domain_auth_def{$domain}=$def_auth;
1.16 www 679: $domain_auth_arg_def{$domain}=$def_auth_arg;
1.19 www 680: $domaindescription{$domain}=$domain_description;
681: $domain_lang_def{$domain}=$def_lang;
682: $domain_city{$domain}=$city;
683: $domain_longi{$domain}=$longi;
684: $domain_lati{$domain}=$lati;
1.16 www 685: }
686: }
687: }
688:
689: print "<img src='/adm/lonIcons/lonlogos.gif' align='right' /><h1>LON-CAPA Cluster Status ".localtime()."</h1>";
690: print "<form name='prgstat'>\n".
691: "<input type='text' name='progress' value='Starting ...' size='100' /><br />".
692: "</form>\n";;
693: print "<form name='status' method='post'>\n";
694: print 'Choose next report: '.&select_form($mode,'mode',%modes).'<hr />';
695: &hidden('refresh',$refresh);
696:
697: if (!$FORM{'runonetime'}) {
698: print
699: "<h3>Gathering initial cluster data</h3>This may take some time ...<br />";
700: $fromcache=0;
701: &mainloop();
702: &statuslist('Done initial run.');
703: &reports();
704: } else {
705: $fromcache=1;
706: &mainloop();
707: &statuslist('Done gathering cached data');
708: &reports();
709: $fromcache=0;
710: &mainloop();
711: }
712: &hidden('runonetime',1);
713: print '<tt><br />Total number of queries: '.$stat_total.
714: '<br />Percent complete: '.
715: int(($stat_total-$stat_notyet)/$stat_total*100.).
716: '<br />Percent from cache: '.
717: int($stat_fromcache/$stat_total*100.).'</tt>';
718:
1.9 www 719: # ============================================================== Close, refresh
1.8 www 720: print "</form><script>";
1.16 www 721: my $runtime=time-$starttime;
722: if (($refresh-$runtime)<0) {
723: print "document.status.submit();";
1.8 www 724: } else {
1.16 www 725: my $refreshtime=int(1000*($refresh-$runtime));
1.11 www 726: print "setTimeout('document.status.submit()',$refreshtime);\n".
727: "document.prgstat.progress.value='Will automatically refresh ($refresh secs refresh cycle)'";
1.2 www 728: }
1.8 www 729: print "</script></body></html>";
730: exit 0;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>