File:  [LON-CAPA] / loncom / loncron
Revision 1.89: download - view: text, annotated - select for diffs
Sat May 14 16:12:53 2011 UTC (13 years, 1 month ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Duplicated &try_to_lock() routine moved to one location (in LONCAPA.pm).
- Try to get locks for lock_apachereload and lock_lciptables before
  making system calls (in lond and loncron respectively).

    1: #!/usr/bin/perl
    2: 
    3: # Housekeeping program, started by cron, loncontrol and loncron.pl
    4: #
    5: # $Id: loncron,v 1.89 2011/05/14 16:12:53 raeburn Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: 
   30: $|=1;
   31: use strict;
   32: 
   33: use lib '/home/httpd/lib/perl/';
   34: use LONCAPA::Configuration;
   35: use LONCAPA;
   36: use Apache::lonnet;
   37: use Apache::loncommon;
   38: 
   39: use IO::File;
   40: use IO::Socket;
   41: use HTML::Entities;
   42: use Getopt::Long;
   43: #globals
   44: use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
   45: 
   46: my $statusdir="/home/httpd/html/lon-status";
   47: 
   48: 
   49: # --------------------------------------------------------- Output error status
   50: 
   51: sub log {
   52:     my $fh=shift;
   53:     if ($fh) {	print $fh @_  }
   54: }
   55: 
   56: sub errout {
   57:    my $fh=shift;
   58:    &log($fh,(<<ENDERROUT));
   59:      <table border="2" bgcolor="#CCCCCC">
   60:      <tr><td>Notices</td><td>$notices</td></tr>
   61:      <tr><td>Warnings</td><td>$warnings</td></tr>
   62:      <tr><td>Errors</td><td>$errors</td></tr>
   63:      </table><p><a href="#top">Top</a></p>
   64: ENDERROUT
   65: }
   66: 
   67: sub rotate_logfile {
   68:     my ($file,$fh,$description) = @_;
   69:     my $size=(stat($file))[7];
   70:     if ($size>40000) {
   71: 	&log($fh,"<p>Rotating $description ...</p>");
   72: 	rename("$file.2","$file.3");
   73: 	rename("$file.1","$file.2");
   74: 	rename("$file","$file.1");
   75:     } 
   76: }
   77: 
   78: sub start_daemon {
   79:     my ($fh,$daemon,$pidfile,$args) = @_;
   80:     my $progname=$daemon;
   81:     if ($daemon eq 'lonc') {
   82: 	$progname='loncnew'; 
   83:     }
   84:     my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
   85:     &rotate_logfile($error_fname,$fh,'error logs');
   86:     if ($daemon eq 'lonc') {
   87: 	&clean_sockets($fh);
   88:     }
   89:     system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
   90:     sleep 1;
   91:     if (-e $pidfile) {
   92: 	&log($fh,"<p>Seems like it started ...</p>");
   93: 	my $lfh=IO::File->new("$pidfile");
   94: 	my $daemonpid=<$lfh>;
   95: 	chomp($daemonpid);
   96: 	if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
   97: 	    return 1;
   98: 	} else {
   99: 	    return 0;
  100: 	}
  101:     }
  102:     &log($fh,"<p>Seems like that did not work!</p>");
  103:     $errors++;
  104:     return 0;
  105: }
  106: 
  107: sub checkon_daemon {
  108:     my ($fh,$daemon,$maxsize,$send,$args)=@_;
  109: 
  110:     my $result;
  111:     &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
  112:     printf("%-15s ",$daemon);
  113:     if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
  114: 	open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
  115: 	while (my $line=<DFH>) { 
  116: 	    &log($fh,"$line");
  117: 	    if ($line=~/INFO/) { $notices++; }
  118: 	    if ($line=~/WARNING/) { $notices++; }
  119: 	    if ($line=~/CRITICAL/) { $warnings++; }
  120: 	};
  121: 	close (DFH);
  122:     }
  123:     &log($fh,"</tt></p>");
  124:     
  125:     my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
  126:     
  127:     my $restartflag=1;
  128:     my $daemonpid;
  129:     if (-e $pidfile) {
  130: 	my $lfh=IO::File->new("$pidfile");
  131: 	$daemonpid=<$lfh>;
  132: 	chomp($daemonpid);
  133: 	if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
  134: 	    &log($fh,"<h3>$daemon at pid $daemonpid responding");
  135: 	    if ($send) { &log($fh,", sending $send"); }
  136: 	    &log($fh,"</h3>");
  137: 	    if ($send eq 'USR1') { kill USR1 => $daemonpid; }
  138: 	    if ($send eq 'USR2') { kill USR2 => $daemonpid; }
  139: 	    $restartflag=0;
  140: 	    if ($send eq 'USR2') {
  141: 		$result = 'reloaded';
  142: 		print "reloaded\n";
  143: 	    } else {
  144: 		$result = 'running';
  145: 		print "running\n";
  146: 	    }
  147: 	} else {
  148: 	    $errors++;
  149: 	    &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
  150: 	    $restartflag=1;
  151: 	    &log($fh,"<h3>Decided to clean up stale .pid file and restart $daemon</h3>");
  152: 	}
  153:     }
  154:     if ($restartflag==1) {
  155: 	$simplestatus{$daemon}='off';
  156: 	$errors++;
  157: 	my $kadaemon=$daemon;
  158: 	if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
  159: 	&log($fh,'<br><font color="red">Killall '.$daemon.': '.
  160: 	    `killall $kadaemon 2>&1`.' - ');
  161: 	sleep 1;
  162: 	&log($fh,unlink($pidfile).' - '.
  163: 	    `killall -9 $kadaemon 2>&1`.
  164: 	    '</font><br>');
  165: 	&log($fh,"<h3>$daemon not running, trying to start</h3>");
  166: 	
  167: 	if (&start_daemon($fh,$daemon,$pidfile,$args)) {
  168: 	    &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
  169: 	    $simplestatus{$daemon}='restarted';
  170: 	    $result = 'started';
  171: 	    print "started\n";
  172: 	} else {
  173: 	    $errors++;
  174: 	    &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
  175: 	    &log($fh,"<p>Give it one more try ...</p>");
  176: 	    print " ";
  177: 	    if (&start_daemon($fh,$daemon,$pidfile,$args)) {
  178: 		&log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
  179: 		$simplestatus{$daemon}='restarted';
  180: 		$result = 'started';
  181: 		print "started\n";
  182: 	    } else {
  183: 		$result = 'failed';
  184: 		print " failed\n";
  185: 		$simplestatus{$daemon}='failed';
  186: 		$errors++; $errors++;
  187: 		&log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
  188: 		&log($fh,"<p>Unable to start $daemon</p>");
  189: 	    }
  190: 	}
  191: 
  192: 	if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
  193: 	    &log($fh,"<p><pre>");
  194: 	    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
  195: 	    while (my $line=<DFH>) { 
  196: 		&log($fh,"$line");
  197: 		if ($line=~/WARNING/) { $notices++; }
  198: 		if ($line=~/CRITICAL/) { $notices++; }
  199: 	    };
  200: 	    close (DFH);
  201: 	    &log($fh,"</pre></p>");
  202: 	}
  203:     }
  204:     
  205:     my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
  206:     &rotate_logfile($fname,$fh,'logs');
  207: 
  208:     &errout($fh);
  209:     return $result;
  210: }
  211: 
  212: # --------------------------------------------------------------------- Machine
  213: sub log_machine_info {
  214:     my ($fh)=@_;
  215:     &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
  216:     &log($fh,"<h3>loadavg</h3>");
  217: 	
  218:     open (LOADAVGH,"/proc/loadavg");
  219:     my $loadavg=<LOADAVGH>;
  220:     close (LOADAVGH);
  221:     
  222:     &log($fh,"<tt>$loadavg</tt>");
  223:     
  224:     my @parts=split(/\s+/,$loadavg);
  225:     if ($parts[1]>4.0) {
  226: 	$errors++;
  227:     } elsif ($parts[1]>2.0) {
  228: 	$warnings++;
  229:     } elsif ($parts[1]>1.0) {
  230: 	$notices++;
  231:     }
  232: 
  233:     &log($fh,"<h3>df</h3>");
  234:     &log($fh,"<pre>");
  235: 
  236:     open (DFH,"df|");
  237:     while (my $line=<DFH>) { 
  238: 	&log($fh,&encode_entities($line,'<>&"')); 
  239: 	@parts=split(/\s+/,$line);
  240: 	my $usage=$parts[4];
  241: 	$usage=~s/\W//g;
  242: 	if ($usage>90) { 
  243: 	    $warnings++;
  244: 	    $notices++; 
  245: 	} elsif ($usage>80) {
  246: 	    $warnings++;
  247: 	} elsif ($usage>60) {
  248: 	    $notices++;
  249: 	}
  250: 	if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
  251:     }
  252:     close (DFH);
  253:     &log($fh,"</pre>");
  254: 
  255: 
  256:     &log($fh,"<h3>ps</h3>");
  257:     &log($fh,"<pre>");
  258:     my $psproc=0;
  259: 
  260:     open (PSH,"ps aux --cols 140 |");
  261:     while (my $line=<PSH>) { 
  262: 	&log($fh,&encode_entities($line,'<>&"')); 
  263: 	$psproc++;
  264:     }
  265:     close (PSH);
  266:     &log($fh,"</pre>");
  267: 
  268:     if ($psproc>200) { $notices++; }
  269:     if ($psproc>250) { $notices++; }
  270: 
  271:     &log($fh,"<h3>distprobe</h3>");
  272:     &log($fh,"<pre>");
  273:     open(DSH,"$perlvar{'lonDaemons'}/distprobe |");
  274:     while (my $line=<DSH>) { 
  275: 	&log($fh,&encode_entities($line,'<>&"')); 
  276: 	$psproc++;
  277:     }
  278:     close(DSH);
  279:     &log($fh,"</pre>");
  280: 
  281:     &errout($fh);
  282: }
  283: 
  284: sub start_logging {
  285:     my $fh=IO::File->new(">$statusdir/newstatus.html");
  286:     my %simplestatus=();
  287:     my $now=time;
  288:     my $date=localtime($now);
  289:     
  290: 
  291:     &log($fh,(<<ENDHEADERS));
  292: <html>
  293: <head>
  294: <title>LON Status Report $perlvar{'lonHostID'}</title>
  295: </head>
  296: <body bgcolor="#AAAAAA">
  297: <a name="top" />
  298: <h1>LON Status Report $perlvar{'lonHostID'}</h1>
  299: <h2>$date ($now)</h2>
  300: <ol>
  301: <li><a href="#configuration">Configuration</a></li>
  302: <li><a href="#machine">Machine Information</a></li>
  303: <li><a href="#tmp">Temporary Files</a></li>
  304: <li><a href="#tokens">Session Tokens</a></li>
  305: <li><a href="#httpd">httpd</a></li>
  306: <li><a href="#lonsql">lonsql</a></li>
  307: <li><a href="#lond">lond</a></li>
  308: <li><a href="#lonc">lonc</a></li>
  309: <li><a href="#lonnet">lonnet</a></li>
  310: <li><a href="#connections">Connections</a></li>
  311: <li><a href="#delayed">Delayed Messages</a></li>
  312: <li><a href="#errcount">Error Count</a></li>
  313: </ol>
  314: <hr />
  315: <a name="configuration" />
  316: <h2>Configuration</h2>
  317: <h3>PerlVars</h3>
  318: <table border="2">
  319: ENDHEADERS
  320: 
  321:     foreach my $varname (sort(keys(%perlvar))) {
  322: 	&log($fh,"<tr><td>$varname</td><td>".
  323: 	     &encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n");
  324:     }
  325:     &log($fh,"</table><h3>Hosts</h3><table border='2'>");
  326:     my %hostname = &Apache::lonnet::all_hostnames();
  327:     foreach my $id (sort(keys(%hostname))) {
  328: 	my $role = (&Apache::lonnet::is_library($id) ? 'library'
  329: 		                                     : 'access');
  330: 	&log($fh,
  331: 	    "<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id).
  332: 	    "</td><td>".$role.
  333: 	    "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
  334:     }
  335:     &log($fh,"</table><h3>Spare Hosts</h3><ul>");
  336:     foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
  337: 	&log($fh,"<li>$type\n<ol>");
  338: 	foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {
  339: 	    &log($fh,"<li>$id</li>\n");
  340: 	}
  341: 	&log($fh,"</ol>\n</li>\n");
  342:     }
  343:     &log($fh,"</ul>\n");
  344:     return $fh;
  345: }
  346: 
  347: # --------------------------------------------------------------- clean out tmp
  348: sub clean_tmp {
  349:     my ($fh)=@_;
  350:     &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
  351:     my ($cleaned,$old,$removed) = (0,0,0);
  352:     my %errors = (
  353:                      dir       => [],
  354:                      file      => [],
  355:                      failopen  => [],
  356:                  );
  357:     my %error_titles = (
  358:                          dir       => 'failed to remove empty directory:',
  359:                          file      => 'failed to unlike stale file',
  360:                          failopen  => 'failed to open file or directory'
  361:                        );
  362:     ($cleaned,$old,$removed) = &recursive_clean_tmp('',$cleaned,$old,$removed,\%errors);
  363:     &log($fh,"Cleaned up: ".$cleaned." files; removed: $removed empty directories; (found: $old old checkout tokens)");
  364:     foreach my $key (sort(keys(%errors))) {
  365:         if (ref($errors{$key}) eq 'ARRAY') {
  366:             if (@{$errors{$key}} > 0) {
  367:                 &log($fh,"Error during cleanup ($error_titles{$key}):<ul><li>".
  368:                      join('</li><li><tt>',@{$errors{$key}}).'</tt></li></ul><br />');
  369:             }
  370:         }
  371:     }
  372: }
  373: 
  374: sub recursive_clean_tmp {
  375:     my ($subdir,$cleaned,$old,$removed,$errors) = @_;
  376:     my $base = "$perlvar{'lonDaemons'}/tmp";
  377:     my $path = $base;
  378:     next if ($subdir =~ m{\.\./});
  379:     next unless (ref($errors) eq 'HASH');
  380:     unless ($subdir eq '') {
  381:         $path .= '/'.$subdir;
  382:     }
  383:     if (opendir(my $dh,"$path")) {
  384:         while (my $file = readdir($dh)) {
  385:             next if ($file =~ /^\.\.?$/);
  386:             my $fname = "$path/$file";
  387:             if (-d $fname) {
  388:                 my $innerdir;
  389:                 if ($subdir eq '') {
  390:                     $innerdir = $file;
  391:                 } else {
  392:                     $innerdir = $subdir.'/'.$file;
  393:                 }
  394:                 ($cleaned,$old,$removed) = 
  395:                      &recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
  396:                 my @doms = &Apache::lonnet::current_machine_domains();
  397:                 
  398:                 if (open(my $dirhandle,$fname)) {
  399:                     unless (($innerdir eq 'helprequests') ||
  400:                             (($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {
  401:                         my @contents = grep {!/^\.\.?$/} readdir($dirhandle);
  402:                                       join('&&',@contents)."\n";    
  403:                         if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
  404:                             closedir($dirhandle);
  405:                             if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
  406:                                 if (rmdir($fname)) {
  407:                                     $removed ++;
  408:                                 } elsif (ref($errors->{dir}) eq 'ARRAY') {
  409:                                     push(@{$errors->{dir}},$fname);
  410:                                 }
  411:                             }
  412:                         }
  413:                     } else {
  414:                         closedir($dirhandle);
  415:                     }
  416:                 }
  417:             } else {
  418:                 my ($dev,$ino,$mode,$nlink,
  419:                     $uid,$gid,$rdev,$size,
  420:                     $atime,$mtime,$ctime,
  421:                     $blksize,$blocks)=stat($fname);
  422:                 my $now=time;
  423:                 my $since=$now-$mtime;
  424:                 if ($since>$perlvar{'lonExpire'}) {
  425:                     if ($subdir eq '') {
  426:                         my $line='';
  427:                         if ($fname =~ /\.db$/) {
  428:                             if (unlink($fname)) {
  429:                                 $cleaned++;
  430:                             } elsif (ref($errors->{file}) eq 'ARRAY') {
  431:                                 push(@{$errors->{file}},$fname);
  432:                             }
  433:                         } elsif (open(PROBE,$fname)) {
  434:                             my $line='';
  435:                             $line=<PROBE>;
  436:                             close(PROBE);
  437:                             if ($line=~/^CHECKOUTTOKEN\&/) {
  438:                                 if ($since>365*$perlvar{'lonExpire'}) {
  439:                                     if (unlink($fname)) {
  440:                                         $cleaned++; 
  441:                                     } elsif (ref($errors->{file}) eq 'ARRAY') {
  442:                                         push(@{$errors->{file}},$fname);
  443:                                     }
  444:                                 } else {
  445:                                     $old++;
  446:                                 }
  447:                             } else {
  448:                                 if (unlink($fname)) {
  449:                                     $cleaned++;
  450:                                 } elsif (ref($errors->{file}) eq 'ARRAY') {
  451:                                     push(@{$errors->{file}},$fname);
  452:                                 }
  453:                             }
  454:                         } elsif (ref($errors->{failopen}) eq 'ARRAY') {
  455:                             push(@{$errors->{failopen}},$fname); 
  456:                         }
  457:                     } else {
  458:                         if (unlink($fname)) {
  459:                             $cleaned++;
  460:                         } elsif (ref($errors->{file}) eq 'ARRAY') {
  461:                             push(@{$errors->{file}},$fname);
  462:                         }
  463:                     }
  464:                 }
  465:             }
  466:         }
  467:         closedir($dh);
  468:     } elsif (ref($errors->{failopen}) eq 'ARRAY') {
  469:         push(@{$errors->{failopen}},$path);
  470:     }
  471:     return ($cleaned,$old,$removed);
  472: }
  473: 
  474: # ------------------------------------------------------------ clean out lonIDs
  475: sub clean_lonIDs {
  476:     my ($fh)=@_;
  477:     &log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>');
  478:     my $cleaned=0;
  479:     my $active=0;
  480:     while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
  481: 	my ($dev,$ino,$mode,$nlink,
  482: 	    $uid,$gid,$rdev,$size,
  483: 	    $atime,$mtime,$ctime,
  484: 	    $blksize,$blocks)=stat($fname);
  485: 	my $now=time;
  486: 	my $since=$now-$mtime;
  487: 	if ($since>$perlvar{'lonExpire'}) {
  488: 	    $cleaned++;
  489: 	    &log($fh,"Unlinking $fname<br>");
  490: 	    unlink("$fname");
  491: 	} else {
  492: 	    $active++;
  493: 	}
  494:     }
  495:     &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
  496:     &log($fh,"<h3>$active open session(s)</h3>");
  497: }
  498: 
  499: # ----------------------------------------------------------- clean out sockets
  500: sub clean_sockets {
  501:     my ($fh)=@_;
  502:     my $cleaned=0;
  503:     opendir(SOCKETS,$perlvar{'lonSockDir'});
  504:     while (my $fname=readdir(SOCKETS)) {
  505: 	next if (-d $fname 
  506: 		 || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
  507: 	$cleaned++;
  508: 	&log($fh,"Unlinking $fname<br />");
  509: 	unlink("/home/httpd/sockets/$fname");
  510:     }
  511:     &log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>");
  512: }
  513: 
  514: 
  515: # ----------------------------------------------------------------------- httpd
  516: sub check_httpd_logs {
  517:     my ($fh)=@_;
  518:     &log($fh,'<hr /><a name="httpd" /><h2>httpd</h2><h3>Access Log</h3><pre>');
  519:     
  520:     open (DFH,"tail -n25 /etc/httpd/logs/access_log|");
  521:     while (my $line=<DFH>) { &log($fh,&encode_entities($line,'<>&"')) };
  522:     close (DFH);
  523: 	
  524:     &log($fh,"</pre><h3>Error Log</h3><pre>");
  525: 	
  526:     open (DFH,"tail -n25 /etc/httpd/logs/error_log|");
  527:     while (my $line=<DFH>) { 
  528: 	&log($fh,"$line");
  529: 	if ($line=~/\[error\]/) { $notices++; } 
  530:     }
  531:     close (DFH);
  532:     &log($fh,"</pre>");
  533:     &errout($fh);
  534: }
  535: 
  536: # ---------------------------------------------------------------------- lonnet
  537: 
  538: sub rotate_lonnet_logs {
  539:     my ($fh)=@_;
  540:     &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
  541:     print "checking logs\n";
  542:     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
  543: 	open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
  544: 	while (my $line=<DFH>) { 
  545: 	    &log($fh,&encode_entities($line,'<>&"'));
  546: 	}
  547: 	close (DFH);
  548:     }
  549:     &log($fh,"</pre><h3>Perm Log</h3><pre>");
  550:     
  551:     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
  552: 	open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
  553: 	while (my $line=<DFH>) { 
  554: 	    &log($fh,&encode_entities($line,'<>&"'));
  555: 	}
  556: 	close (DFH);
  557:     } else { &log($fh,"No perm log\n") }
  558: 
  559:     my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
  560:     &rotate_logfile($fname,$fh,'lonnet log');
  561: 
  562:     &log($fh,"</pre>");
  563:     &errout($fh);
  564: }
  565: 
  566: sub rotate_other_logs {
  567:     my ($fh) = @_;
  568:     my %logs = (
  569:                   autoenroll          => 'Auto Enroll log',
  570:                   autocreate          => 'Create Course log',
  571:                   searchcat           => 'Search Cataloguing log',
  572:                   autoupdate          => 'Auto Update log',
  573:                   refreshcourseids_db => 'Refresh CourseIDs db log',
  574:                );
  575:     foreach my $item (keys(%logs)) {
  576:         my $fname=$perlvar{'lonDaemons'}.'/logs/'.$item.'.log';
  577:         &rotate_logfile($fname,$fh,$logs{$item});
  578:     }
  579: }
  580: 
  581: # ----------------------------------------------------------------- Connections
  582: sub test_connections {
  583:     my ($fh)=@_;
  584:     &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
  585:     print "testing connections\n";
  586:     &log($fh,"<table border='2'>");
  587:     my ($good,$bad)=(0,0);
  588:     my %hostname = &Apache::lonnet::all_hostnames();
  589:     foreach my $tryserver (sort(keys(%hostname))) {
  590: 	print(".");
  591: 	my $result;
  592: 	my $answer=&Apache::lonnet::reply("ping",$tryserver);
  593: 	if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
  594: 	    $result="<b>ok</b>";
  595: 	    $good++;
  596: 	} else {
  597: 	    $result=$answer;
  598: 	    $warnings++;
  599: 	    if ($answer eq 'con_lost') {
  600: 		$bad++;
  601: 		$warnings++;
  602: 	    } else {
  603: 		$good++; #self connection
  604: 	    }
  605: 	}
  606: 	if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }
  607: 	&log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n");
  608:     }
  609:     &log($fh,"</table>");
  610:     print "\n$good good, $bad bad connections\n";
  611:     &errout($fh);
  612: }
  613: 
  614: 
  615: # ------------------------------------------------------------ Delayed messages
  616: sub check_delayed_msg {
  617:     my ($fh)=@_;
  618:     &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
  619:     print "checking buffers\n";
  620:     
  621:     &log($fh,'<h3>Scanning Permanent Log</h3>');
  622: 
  623:     my $unsend=0;
  624: 
  625:     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
  626:     while (my $line=<$dfh>) {
  627: 	my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
  628: 	if ($sdf eq 'F') { 
  629: 	    my $local=localtime($time);
  630: 	    &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br>");
  631: 	    $warnings++;
  632: 	}
  633: 	if ($sdf eq 'S') { $unsend--; }
  634: 	if ($sdf eq 'D') { $unsend++; }
  635:     }
  636: 
  637:     &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
  638:     $warnings=$warnings+5*$unsend;
  639: 
  640:     if ($unsend) { $simplestatus{'unsend'}=$unsend; }
  641:     &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");
  642: # list directory with delayed messages and remember offline servers
  643:     my %servers=();
  644:     open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
  645:     while (my $line=<DFH>) {
  646:         my ($server)=($line=~/\.(\w+)$/);
  647:         if ($server) { $servers{$server}=1; }
  648: 	&log($fh,&encode_entities($line,'<>&"'));
  649:     }
  650:     &log($fh,"</pre>\n");
  651:     close (DFH);
  652: # pong to all servers that have delayed messages
  653: # this will trigger a reverse connection, which should flush the buffers
  654:     foreach my $tryserver (keys %servers) {
  655: 	my $answer=&Apache::lonnet::reply("pong",$tryserver);
  656: 	&log($fh,"Pong to $tryserver: $answer<br />");
  657:     }
  658: }
  659: 
  660: sub finish_logging {
  661:     my ($fh)=@_;
  662:     &log($fh,"<a name='errcount' />\n");
  663:     $totalcount=$notices+4*$warnings+100*$errors;
  664:     &errout($fh);
  665:     &log($fh,"<h1>Total Error Count: $totalcount</h1>");
  666:     my $now=time;
  667:     my $date=localtime($now);
  668:     &log($fh,"<hr />$date ($now)</body></html>\n");
  669:     print "lon-status webpage updated\n";
  670:     $fh->close();
  671: 
  672:     if ($errors) { $simplestatus{'errors'}=$errors; }
  673:     if ($warnings) { $simplestatus{'warnings'}=$warnings; }
  674:     if ($notices) { $simplestatus{'notices'}=$notices; }
  675:     $simplestatus{'time'}=time;
  676: }
  677: 
  678: sub log_simplestatus {
  679:     rename("$statusdir/newstatus.html","$statusdir/index.html");
  680:     
  681:     my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
  682:     foreach (keys %simplestatus) {
  683: 	print $sfh $_.'='.$simplestatus{$_}.'&';
  684:     }
  685:     print $sfh "\n";
  686:     $sfh->close();
  687: }
  688: 
  689: sub write_loncaparevs {
  690:     if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
  691:         my %hostname = &Apache::lonnet::all_hostnames();
  692:         foreach my $id (sort(keys(%hostname))) {
  693:             if ($id ne '') {
  694:                 my $loncaparev = &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
  695:                 if ($loncaparev =~ /^[\w.\-]+$/) {
  696:                     print $fh $id.':'.$loncaparev."\n";
  697:                 }
  698:             }
  699:         }
  700:         close($fh);
  701:     }
  702:     return;
  703: }
  704: 
  705: sub write_serverhomeIDs {
  706:     if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
  707:         my %name_to_host = &Apache::lonnet::all_names();
  708:         foreach my $name (sort(keys(%name_to_host))) {
  709:             if ($name ne '') {
  710:                 if (ref($name_to_host{$name}) eq 'ARRAY') {
  711:                     my $serverhomeID = &Apache::lonnet::get_server_homeID($name,1,'loncron');
  712:                     if ($serverhomeID ne '') {
  713:                         print $fh $name.':'.$serverhomeID."\n";
  714:                     } else {
  715:                         print $fh $name.':'.$name_to_host{$name}->[0]."\n";
  716:                     }
  717:                 }
  718:             }
  719:         }
  720:         close($fh);
  721:     }
  722:     return;
  723: }
  724: 
  725: sub send_mail {
  726:     print "sending mail\n";
  727:     my $defdom = $perlvar{'lonDefDomain'};
  728:     my $origmail = $perlvar{'lonAdmEMail'};
  729:     my $emailto = &Apache::loncommon::build_recipient_list(undef,
  730:                                    'lonstatusmail',$defdom,$origmail);
  731:     if ($totalcount>2500) {
  732: 	$emailto.=",$perlvar{'lonSysEMail'}";
  733:     }
  734:     my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; 
  735: 
  736:     my $result=system("metasend -b -S 4000000 -t $emailto -s '$subj' -f $statusdir/index.html -m text/html >& /dev/null");
  737:     if ($result != 0) {
  738: 	$result=system("mail -s '$subj' $emailto < $statusdir/index.html");
  739:     }
  740: }
  741: 
  742: sub usage {
  743:     print(<<USAGE);
  744: loncron - housekeeping program that checks up on various parts of Lon-CAPA
  745: 
  746: Options:
  747:    --help     Display 
  748:    --noemail  Do not send the status email
  749:    --justcheckconnections  Only check the current status of the lonc/d
  750:                                 connections, do not send emails do not
  751:                                 check if the daemons are running, do not
  752:                                 generate lon-status
  753:    --justcheckdaemons      Only check that all of the Lon-CAPA daemons are
  754:                                 running, do not send emails do not
  755:                                 check the lonc/d connections, do not
  756:                                 generate lon-status
  757:    --justreload            Only tell the daemons to reload the config files,
  758: 				do not send emails do not
  759:                                 check if the daemons are running, do not
  760:                                 generate lon-status
  761:                            
  762: USAGE
  763: }
  764: 
  765: # ================================================================ Main Program
  766: sub main () {
  767:     my ($help,$justcheckdaemons,$noemail,$justcheckconnections,
  768: 	$justreload);
  769:     &GetOptions("help"                 => \$help,
  770: 		"justcheckdaemons"     => \$justcheckdaemons,
  771: 		"noemail"              => \$noemail,
  772: 		"justcheckconnections" => \$justcheckconnections,
  773: 		"justreload"           => \$justreload
  774: 		);
  775:     if ($help) { &usage(); return; }
  776: # --------------------------------- Read loncapa_apache.conf and loncapa.conf
  777:     my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
  778:     %perlvar=%{$perlvarref};
  779:     undef $perlvarref;
  780:     delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
  781:     delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
  782:     chdir($perlvar{'lonDaemons'});
  783: # --------------------------------------- Make sure that LON-CAPA is configured
  784: # I only test for one thing here (lonHostID).  This is just a safeguard.
  785:     if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
  786: 	print("Unconfigured machine.\n");
  787: 	my $emailto=$perlvar{'lonSysEMail'};
  788: 	my $hostname=`/bin/hostname`;
  789: 	chop $hostname;
  790: 	$hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
  791: 	my $subj="LON: Unconfigured machine $hostname";
  792: 	system("echo 'Unconfigured machine $hostname.' |\
  793:  mailto $emailto -s '$subj' > /dev/null");
  794: 	exit 1;
  795:     }
  796: 
  797: # ----------------------------- Make sure this process is running from user=www
  798:     my $wwwid=getpwnam('www');
  799:     if ($wwwid!=$<) {
  800: 	print("User ID mismatch.  This program must be run as user 'www'\n");
  801: 	my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  802: 	my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
  803: 	system("echo 'User ID mismatch.  loncron must be run as user www.' |\
  804:  mailto $emailto -s '$subj' > /dev/null");
  805: 	exit 1;
  806:     }
  807: 
  808: # -------------------------------------------- Force reload of host information
  809:     &Apache::lonnet::load_hosts_tab(1);
  810:     &Apache::lonnet::load_domain_tab(1);
  811:     &Apache::lonnet::get_iphost(1);
  812: 
  813: # ----------------------------------------- Force firewall update for lond port  
  814: 
  815:     if ((!$justcheckdaemons) && (!$justreload)) {
  816:         my $now = time;
  817:         my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
  818:                       $now.$$.int(rand(10000));
  819:         if (open(my $fh,">$tmpfile")) {
  820:             my %iphosts = &Apache::lonnet::get_iphost();
  821:             foreach my $key (keys(%iphosts)) {
  822:                 print $fh "$key\n";
  823:             }
  824:             close($fh);
  825:             if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {
  826:                 my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
  827:                 system("$execpath $tmpfile");
  828:                 unlink('/tmp/lock_lciptables');  # Remove the lock file. 
  829:             }
  830:             unlink($tmpfile);
  831:         }
  832:     }
  833: 
  834: # ---------------------------------------------------------------- Start report
  835: 
  836:     $errors=0;
  837:     $warnings=0;
  838:     $notices=0;
  839: 
  840: 	
  841:     my $fh;
  842:     if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  843: 	$fh=&start_logging();
  844: 
  845: 	&log_machine_info($fh);
  846: 	&clean_tmp($fh);
  847: 	&clean_lonIDs($fh);
  848: 	&check_httpd_logs($fh);
  849: 	&rotate_lonnet_logs($fh);
  850: 	&rotate_other_logs($fh);
  851:     }
  852:     if (!$justcheckconnections && !$justreload) {
  853: 	&checkon_daemon($fh,'lonmemcached',40000);
  854: 	&checkon_daemon($fh,'lonsql',200000);
  855: 	if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
  856: 	    &checkon_daemon($fh,'lond',40000,'USR2');
  857: 	}
  858: 	&checkon_daemon($fh,'lonc',40000,'USR1');
  859:         &checkon_daemon($fh,'lonmaxima',40000);
  860:         &checkon_daemon($fh,'lonr',40000);
  861:     }
  862:     if ($justreload) {
  863: 	&checkon_daemon($fh,'lond',40000,'USR2');
  864: 	&checkon_daemon($fh,'lonc',40000,'USR2');
  865:     }
  866:     if ($justcheckconnections) {
  867: 	&test_connections($fh);
  868:     }
  869:     if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  870: 	&check_delayed_msg($fh);
  871: 	&finish_logging($fh);
  872: 	&log_simplestatus();
  873:         &write_loncaparevs();
  874:         &write_serverhomeIDs();
  875: 	
  876: 	if ($totalcount>200 && !$noemail) { &send_mail(); }
  877:     }
  878: }
  879: 
  880: &main();
  881: 1;
  882: 
  883: 
  884: 
  885: 
  886: 
  887: 
  888: 
  889: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.