[BACK]Return to loncron CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom
File:  [LON-CAPA] / loncom / loncron
Revision 1.49: download - view: text, annotated - select for diffs
Tue May 11 21:08:55 2004 UTC (20 years ago) by albertel
Branches: MAIN
CVS tags: HEAD
- add command line args to loncron

#!/usr/bin/perl

# Housekeeping program, started by cron, loncontrol and loncron.pl
#
# $Id: loncron,v 1.49 2004/05/11 21:08:55 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

$|=1;
use strict;

use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;

use IO::File;
use IO::Socket;
use HTML::Entities;
use Getopt::Long;
#globals
use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);

my $statusdir="/home/httpd/html/lon-status";


# -------------------------------------------------- Non-critical communication
sub reply {
    my ($cmd,$server)=@_;
    my $peerfile="$perlvar{'lonSockDir'}/$server";
    my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                     Type    => SOCK_STREAM,
                                     Timeout => 10)
       or return "con_lost";
    print $client "$cmd\n";
    my $answer=<$client>;
    chomp($answer);
    if (!$answer) { $answer="con_lost"; }
    return $answer;
}

# --------------------------------------------------------- Output error status

sub log {
    my $fh=shift;
    if ($fh) {	print $fh @_  }
}

sub errout {
   my $fh=shift;
   &log($fh,(<<ENDERROUT));
     <table border="2" bgcolor="#CCCCCC">
     <tr><td>Notices</td><td>$notices</td></tr>
     <tr><td>Warnings</td><td>$warnings</td></tr>
     <tr><td>Errors</td><td>$errors</td></tr>
     </table><p><a href="#top">Top</a></p>
ENDERROUT
}

sub start_daemon {
    my ($fh,$daemon,$pidfile) = @_;
    my $progname=$daemon;
    if ($daemon eq 'lonc' && $ARGV[0] eq 'new') {
	$progname='loncnew'; 
	print "new ";
    }
    system("$perlvar{'lonDaemons'}/$progname 2>>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
    sleep 2;
    if (-e $pidfile) {
	&log($fh,"<p>Seems like it started ...</p>");
	my $lfh=IO::File->new("$pidfile");
	my $daemonpid=<$lfh>;
	chomp($daemonpid);
	sleep 2;
	if (kill 0 => $daemonpid) {
	    return 1;
	} else {
	    return 0;
	}
    }
    &log($fh,"<p>Seems like that did not work!</p>");
    $errors++;
    return 0;
}

sub checkon_daemon {
    my ($fh,$daemon,$maxsize,$sendusr1)=@_;

    &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
    printf("%-10s ",$daemon);
    if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
	open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
	while (my $line=<DFH>) { 
	    &log($fh,"$line");
	    if ($line=~/INFO/) { $notices++; }
	    if ($line=~/WARNING/) { $notices++; }
	    if ($line=~/CRITICAL/) { $warnings++; }
	};
	close (DFH);
    }
    &log($fh,"</tt></p>");
    
    my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
    
    my $restartflag=1;
    my $daemonpid;
    if (-e $pidfile) {
	my $lfh=IO::File->new("$pidfile");
	$daemonpid=<$lfh>;
	chomp($daemonpid);
	if (kill 0 => $daemonpid) {
	    &log($fh,"<h3>$daemon at pid $daemonpid responding");
	    if ($sendusr1) { &log($fh,", sending USR1"); }
	    &log($fh,"</h3>");
	    if ($sendusr1) { kill USR1 => $daemonpid; }
	    $restartflag=0;
	    print "running\n";
	} else {
	    $errors++;
	    &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
	    $restartflag=1;
	    &log($fh,"<h3>Decided to clean up stale .pid file and restart $daemon</h3>");
	}
    }
    if ($restartflag==1) {
	$simplestatus{$daemon}='off';
	$errors++;
	&log($fh,'<br><font color="red">Killall '.$daemon.': '.
	    `killall $daemon 2>&1`.' - ');
	sleep 2;
	&log($fh,unlink($pidfile).' - '.
	    `killall -9 $daemon 2>&1`.
	    '</font><br>');
	&log($fh,"<h3>$daemon not running, trying to start</h3>");
	
	if (&start_daemon($fh,$daemon,$pidfile)) {
	    &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
	    $simplestatus{$daemon}='restarted';
	    print "started\n";
	} else {
	    $errors++;
	    &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
	    &log($fh,"<p>Give it one more try ...</p>");
	    print " ";
	    if (&start_daemon($fh,$daemon,$pidfile)) {
		&log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
		$simplestatus{$daemon}='restarted';
		print "started\n";
	    } else {
		print " failed\n";
		$simplestatus{$daemon}='failed';
		$errors++; $errors++;
		&log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
		&log($fh,"<p>Unable to start $daemon</p>");
	    }
	}

	if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
	    &log($fh,"<p><pre>");
	    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
	    while (my $line=<DFH>) { 
		&log($fh,"$line");
		if ($line=~/WARNING/) { $notices++; }
		if ($line=~/CRITICAL/) { $notices++; }
	    };
	    close (DFH);
	    &log($fh,"</pre></p>");
	}
    }
    
    my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
    
    my ($dev,$ino,$mode,$nlink,
	$uid,$gid,$rdev,$size,
	$atime,$mtime,$ctime,
	$blksize,$blocks)=stat($fname);
    
    if ($size>$maxsize) {
	&log($fh,"<p>Rotating logs ...</p>");
	rename("$fname.2","$fname.3");
	rename("$fname.1","$fname.2");
	rename("$fname","$fname.1");
    }

    &errout($fh);
}

# --------------------------------------------------------------------- Machine
sub log_machine_info {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
    &log($fh,"<h3>loadavg</h3>");
	
    open (LOADAVGH,"/proc/loadavg");
    my $loadavg=<LOADAVGH>;
    close (LOADAVGH);
    
    &log($fh,"<tt>$loadavg</tt>");
    
    my @parts=split(/\s+/,$loadavg);
    if ($parts[1]>4.0) {
	$errors++;
    } elsif ($parts[1]>2.0) {
	$warnings++;
    } elsif ($parts[1]>1.0) {
	$notices++;
    }

    &log($fh,"<h3>df</h3>");
    &log($fh,"<pre>");

    open (DFH,"df|");
    while (my $line=<DFH>) { 
	&log($fh,&encode_entities($line,'<>&"')); 
	@parts=split(/\s+/,$line);
	my $usage=$parts[4];
	$usage=~s/\W//g;
	if ($usage>90) { 
	    $warnings++;
	    $notices++; 
	} elsif ($usage>80) {
	    $warnings++;
	} elsif ($usage>60) {
	    $notices++;
	}
	if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
    }
    close (DFH);
    &log($fh,"</pre>");


    &log($fh,"<h3>ps</h3>");
    &log($fh,"<pre>");
    my $psproc=0;

    open (PSH,"ps -aux --cols 140 |");
    while (my $line=<PSH>) { 
	&log($fh,&encode_entities($line,'<>&"')); 
	$psproc++;
    }
    close (PSH);
    &log($fh,"</pre>");

    if ($psproc>200) { $notices++; }
    if ($psproc>250) { $notices++; }

    &errout($fh);
}

sub start_logging {
    my ($hostdom,$hostrole,$hostname,$spareid)=@_;
    my $fh=IO::File->new(">$statusdir/newstatus.html");
    my %simplestatus=();
    my $now=time;
    my $date=localtime($now);
    

    &log($fh,(<<ENDHEADERS));
<html>
<head>
<title>LON Status Report $perlvar{'lonHostID'}</title>
</head>
<body bgcolor="#AAAAAA">
<a name="top" />
<h1>LON Status Report $perlvar{'lonHostID'}</h1>
<h2>$date ($now)</h2>
<ol>
<li><a href="#configuration">Configuration</a></li>
<li><a href="#machine">Machine Information</a></li>
<li><a href="#tmp">Temporary Files</a></li>
<li><a href="#tokens">Session Tokens</a></li>
<li><a href="#httpd">httpd</a></li>
<li><a href="#lonsql">lonsql</a></li>
<li><a href="#lond">lond</a></li>
<li><a href="#lonc">lonc</a></li>
<li><a href="#lonhttpd">lonhttpd</a></li>
<li><a href="#lonnet">lonnet</a></li>
<li><a href="#connections">Connections</a></li>
<li><a href="#delayed">Delayed Messages</a></li>
<li><a href="#errcount">Error Count</a></li>
</ol>
<hr />
<a name="configuration" />
<h2>Configuration</h2>
<h3>PerlVars</h3>
<table border="2">
ENDHEADERS

    foreach my $varname (sort(keys(%perlvar))) {
	&log($fh,"<tr><td>$varname</td><td>".
	     &encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n");
    }
    &log($fh,"</table><h3>Hosts</h3><table border='2'>");
    foreach my $id (sort(keys(%{$hostname}))) {
	&log($fh,
	    "<tr><td>$id</td><td>".$hostdom->{$id}.
	    "</td><td>".$hostrole->{$id}.
	    "</td><td>".$hostname->{$id}."</td></tr>\n");
    }
    &log($fh,"</table><h3>Spare Hosts</h3><ol>");
    foreach my $id (sort(keys(%{$spareid}))) {
	&log($fh,"<li>$id\n</li>");
    }
    &log($fh,"</ol>\n");
    return $fh;
}

# --------------------------------------------------------------- clean out tmp
sub clean_tmp {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
    my $cleaned=0;
    my $old=0;
    while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {
	my ($dev,$ino,$mode,$nlink,
	    $uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,
	    $blksize,$blocks)=stat($fname);
	my $now=time;
	my $since=$now-$mtime;
	if ($since>$perlvar{'lonExpire'}) {
	    my $line='';
	    if (open(PROBE,$fname)) {
		$line=<PROBE>;
		close(PROBE);
	    }
	    unless ($line=~/^CHECKOUTTOKEN\&/) {
		$cleaned++;
		unlink("$fname");
	    } else {
		if ($since>365*$perlvar{'lonExpire'}) {
		    $cleaned++;
		    unlink("$fname");
		} else { $old++; }
	    }
	}
    }
    &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens).");
}

# ------------------------------------------------------------ clean out lonIDs
sub clean_lonIDs {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>');
    my $cleaned=0;
    my $active=0;
    while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
	my ($dev,$ino,$mode,$nlink,
	    $uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,
	    $blksize,$blocks)=stat($fname);
	my $now=time;
	my $since=$now-$mtime;
	if ($since>$perlvar{'lonExpire'}) {
	    $cleaned++;
	    &log($fh,"Unlinking $fname<br>");
	    unlink("$fname");
	} else {
	    $active++;
	}
    }
    &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
    &log($fh,"<h3>$active open session(s)</h3>");
}


# ----------------------------------------------------------------------- httpd
sub check_httpd_logs {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="httpd" /><h2>httpd</h2><h3>Access Log</h3><pre>');
    
    open (DFH,"tail -n25 /etc/httpd/logs/access_log|");
    while (my $line=<DFH>) { &log($fh,&encode_entities($line,'<>&"')) };
    close (DFH);
	
    &log($fh,"</pre><h3>Error Log</h3><pre>");
	
    open (DFH,"tail -n25 /etc/httpd/logs/error_log|");
    while (my $line=<DFH>) { 
	&log($fh,"$line");
	if ($line=~/\[error\]/) { $notices++; } 
    }
    close (DFH);
    &log($fh,"</pre>");
    &errout($fh);
}

# ---------------------------------------------------------------------- lonnet

sub rotate_lonnet_logs {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
    print "checking logs\n";
    if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
	open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
	while (my $line=<DFH>) { 
	    &log($fh,&encode_entities($line,'<>&"'));
	}
	close (DFH);
    }
    &log($fh,"</pre><h3>Perm Log</h3><pre>");
    
    if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
	open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
	while (my $line=<DFH>) { 
	    &log($fh,&encode_entities($line,'<>&"'));
	}
	close (DFH);
    } else { &log($fh,"No perm log\n") }

    my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";

    my ($dev,$ino,$mode,$nlink,
	$uid,$gid,$rdev,$size,
	$atime,$mtime,$ctime,
	$blksize,$blocks)=stat($fname);

    if ($size>40000) {
	&log($fh,"<p>Rotating logs ...</p>");
	rename("$fname.2","$fname.3");
	rename("$fname.1","$fname.2");
	rename("$fname","$fname.1");
    }

    &log($fh,"</pre>");
    &errout($fh);
}

# ----------------------------------------------------------------- Connections
sub test_connections {
    my ($fh,$hostname)=@_;
    &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
    print "testing connections\n";
    &log($fh,"<table border='2'>");
    my ($good,$bad)=(0,0);
    foreach my $tryserver (sort(keys(%{$hostname}))) {
	print(".");
	my $result;
	my $answer=reply("pong",$tryserver);
	if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
	    $result="<b>ok</b>";
	    $good++;
	} else {
	    $result=$answer;
	    $warnings++;
	    if ($answer eq 'con_lost') {
		$bad++;
		$warnings++;
	    }
	}
	if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }
	&log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n");
    }
    &log($fh,"</table>");
    print "\n$good good, $bad bad connections\n";
    &errout($fh);
}


# ------------------------------------------------------------ Delayed messages
sub check_delayed_msg {
    my ($fh)=@_;
    &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
    print "checking buffers\n";
    
    &log($fh,'<h3>Scanning Permanent Log</h3>');

    my $unsend=0;

    my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
    while (my $line=<$dfh>) {
	my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
	if ($sdf eq 'F') { 
	    my $local=localtime($time);
	    &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br>");
	    $warnings++;
	}
	if ($sdf eq 'S') { $unsend--; }
	if ($sdf eq 'D') { $unsend++; }
    }

    &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
    $warnings=$warnings+5*$unsend;

    if ($unsend) { $simplestatus{'unsend'}=$unsend; }
    &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");

    open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
    while (my $line=<DFH>) { 
	&log($fh,&encode_entities($line,'<>&"'));
    }
    &log($fh,"</pre>\n");
    close (DFH);
}

sub finish_logging {
    my ($fh)=@_;
    &log($fh,"<a name='errcount' />\n");
    $totalcount=$notices+4*$warnings+100*$errors;
    &errout($fh);
    &log($fh,"<h1>Total Error Count: $totalcount</h1>");
    my $now=time;
    my $date=localtime($now);
    &log($fh,"<hr />$date ($now)</body></html>\n");
    print "lon-status webpage updated\n";
    $fh->close();

    if ($errors) { $simplestatus{'errors'}=$errors; }
    if ($warnings) { $simplestatus{'warnings'}=$warnings; }
    if ($notices) { $simplestatus{'notices'}=$notices; }
    $simplestatus{'time'}=time;
}

sub log_simplestatus {
    rename ("$statusdir/newstatus.html","$statusdir/index.html");
    
    my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
    foreach (keys %simplestatus) {
	print $sfh $_.'='.$simplestatus{$_}.'&';
    }
    print $sfh "\n";
    $sfh->close();
}

sub send_mail {
    print "sending mail\n";
    my $emailto="$perlvar{'lonAdmEMail'}";
    if ($totalcount>1000) {
	$emailto.=",$perlvar{'lonSysEMail'}";
    }
    my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; 
    system("metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html");
}

sub usage {
    print(<<USAGE);
loncron - housekeeping program that checks up on various parts of Lon-CAPA

Options:
   --help     Display help
   --oldlonc  When starting the lonc daemon use 'lonc' not 'loncnew'
   --noemail  Do not send the status email
   --justcheckconnections  Only check the current status of the lonc/d
                                connections, do not send emails do not
                                check if the daemons are running, do not
                                generate lon-status
   --justcheckdaemons      Only check that all of the Lon-CAPA daemons are
                                running, do not send emails do not
                                check the lonc/d connections, do not
                                generate lon-status
                           
USAGE
}

# ================================================================ Main Program
sub main () {
    my ($oldlonc,$help,$justcheckdaemons,$noemail,$justcheckconnections);
    &GetOptions("help"                 => \$help,
		"oldlonc"              => \$oldlonc,
		"justcheckdaemons"     => \$justcheckdaemons,
		"noemail"              => \$noemail,
		"justcheckconnections" => \$justcheckconnections
		);
    if ($help) { &usage(); return; }
# --------------------------------- Read loncapa_apache.conf and loncapa.conf
    my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
    %perlvar=%{$perlvarref};
    undef $perlvarref;
    delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
    delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed

# --------------------------------------- Make sure that LON-CAPA is configured
# I only test for one thing here (lonHostID).  This is just a safeguard.
    if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
	print("Unconfigured machine.\n");
	my $emailto=$perlvar{'lonSysEMail'};
	my $hostname=`/bin/hostname`;
	chop $hostname;
	$hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
	my $subj="LON: Unconfigured machine $hostname";
	system("echo 'Unconfigured machine $hostname.' |\
 mailto $emailto -s '$subj' > /dev/null");
	exit 1;
    }

# ----------------------------- Make sure this process is running from user=www
    my $wwwid=getpwnam('www');
    if ($wwwid!=$<) {
	print("User ID mismatch.  This program must be run as user 'www'\n");
	my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
	my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
	system("echo 'User ID mismatch.  loncron must be run as user www.' |\
 mailto $emailto -s '$subj' > /dev/null");
	exit 1;
    }

# ------------------------------------------------------------- Read hosts file
    my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
    
    my (%hostname,%hostdom,%hostrole,%spareid);
    while (my $configline=<$config>) {
	next if ($configline =~ /^(\#|\s*\$)/);
	my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
	if ($id && $domain && $role && $name && $ip) {
	    $hostname{$id}=$name;
	    $hostdom{$id}=$domain;
	    $hostrole{$id}=$role;
	}
    }
    undef $config;

# ------------------------------------------------------ Read spare server file
    $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");
    
    while (my $configline=<$config>) {
	chomp($configline);
	if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
	    $spareid{$configline}=1;
	}
    }
    undef $config;

# ---------------------------------------------------------------- Start report

    $errors=0;
    $warnings=0;
    $notices=0;

	
    my $fh;
    if (!$justcheckdaemons && !$justcheckconnections) {
	$fh=&start_logging(\%hostdom,\%hostrole,\%hostname,\%spareid);

	&log_machine_info($fh);
	&clean_tmp($fh);
	&clean_lonIDs($fh);
	&check_httpd_logs($fh);
	&rotate_lonnet_logs($fh);
    }
    if (!$justcheckconnections) {
	&checkon_daemon($fh,'lonsql',200000);
	&checkon_daemon($fh,'lond',40000,1);
	&checkon_daemon($fh,'lonc',40000,1);
	&checkon_daemon($fh,'lonhttpd',40000);
    }
    if (!$justcheckdaemons) {
	&test_connections($fh,\%hostname);
    }
    if (!$justcheckdaemons && !$justcheckconnections) {
	&check_delayed_msg($fh);
	&finish_logging($fh);
	&log_simplestatus();
	
	if ($totalcount>200 && !$noemail) { &send_mail(); }
    }
}

&main();
1;
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.