[BACK]Return to loncron CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/loncron between versions 1.42 and 1.58

version 1.42, 2003/09/10 19:13:09 version 1.58, 2005/04/13 18:56:07
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
 # The LearningOnline Network  # Housekeeping program, started by cron, loncontrol and loncron.pl
 # Housekeeping program, started by cron  
 #  #
 # (TCP networking package  # $Id$
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,  #
 # 7/1,7/2,7/9,7/10,7/12 Gerd Kortemeyer)  # 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/
 #  #
 # 7/14,7/15,7/19,7/21,7/22,11/18,  
 # 2/8 Gerd Kortemeyer  
 # 12/23 Gerd Kortemeyer  
 # YEAR=2001  
 # 09/04,09/06,11/26 Gerd Kortemeyer  
   
 $|=1;  $|=1;
   use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
 use IO::File;  use IO::File;
 use IO::Socket;  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  # -------------------------------------------------- Non-critical communication
 sub reply {  sub reply {
Line 38  sub reply { Line 60  sub reply {
   
 # --------------------------------------------------------- Output error status  # --------------------------------------------------------- Output error status
   
   sub log {
       my $fh=shift;
       if ($fh) { print $fh @_  }
   }
   
 sub errout {  sub errout {
    my $fh=shift;     my $fh=shift;
    print $fh (<<ENDERROUT);     &log($fh,(<<ENDERROUT));
      <p><table border=2 bgcolor="#CCCCCC">       <table border="2" bgcolor="#CCCCCC">
      <tr><td>Notices</td><td>$notices</td></tr>       <tr><td>Notices</td><td>$notices</td></tr>
      <tr><td>Warnings</td><td>$warnings</td></tr>       <tr><td>Warnings</td><td>$warnings</td></tr>
      <tr><td>Errors</td><td>$errors</td></tr>       <tr><td>Errors</td><td>$errors</td></tr>
      </table><p><a href="#top">Top</a><p>       </table><p><a href="#top">Top</a></p>
 ENDERROUT  ENDERROUT
 }  }
   
 sub start_daemon {  sub start_daemon {
     my ($fh,$daemon,$pidfile) = @_;      my ($fh,$daemon,$pidfile,$args) = @_;
     system("$perlvar{'lonDaemons'}/$daemon 2>>$perlvar{'lonDaemons'}/logs/${daemon}_errors");      my $progname=$daemon;
       if ($daemon eq 'lonc' && $args eq 'new') {
    $progname='loncnew'; 
    print "new ";
       }
       my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
       my $size=(stat($error_fname))[7];
       if ($size>40000) {
    &log($fh,"<p>Rotating error logs ...</p>");
    rename("$error_fname.2","$error_fname.3");
    rename("$error_fname.1","$error_fname.2");
    rename("$error_fname","$error_fname.1");
       }
       system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
     sleep 2;      sleep 2;
     if (-e $pidfile) {      if (-e $pidfile) {
  print $fh "Seems like it started ...<p>";   &log($fh,"<p>Seems like it started ...</p>");
  my $lfh=IO::File->new("$pidfile");   my $lfh=IO::File->new("$pidfile");
  my $daemonpid=<$lfh>;   my $daemonpid=<$lfh>;
  chomp($daemonpid);   chomp($daemonpid);
Line 65  sub start_daemon { Line 105  sub start_daemon {
     return 0;      return 0;
  }   }
     }      }
     print $fh "Seems like that did not work!<p>";      &log($fh,"<p>Seems like that did not work!</p>");
     $errors++;      $errors++;
     return 0;      return 0;
 }  }
   
 sub checkon_daemon {  sub checkon_daemon {
     my ($fh,$daemon,$maxsize,$sendusr1)=@_;      my ($fh,$daemon,$maxsize,$sendusr1,$args)=@_;
   
     print $fh '<hr><a name="'.$daemon.'"><h2>'.$daemon.'</h2><h3>Log</h3><pre>';      &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
     printf("%-10s ",$daemon);      printf("%-15s ",$daemon);
     if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){      if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
  open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");   open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
  while ($line=<DFH>) {    while (my $line=<DFH>) { 
     print $fh "$line";      &log($fh,"$line");
     if ($line=~/INFO/) { $notices++; }      if ($line=~/INFO/) { $notices++; }
     if ($line=~/WARNING/) { $notices++; }      if ($line=~/WARNING/) { $notices++; }
     if ($line=~/CRITICAL/) { $warnings++; }      if ($line=~/CRITICAL/) { $warnings++; }
  };   };
  close (DFH);   close (DFH);
     }      }
     print $fh "</pre>";      &log($fh,"</tt></p>");
           
     my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";      my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
           
     my $restartflag=1;      my $restartflag=1;
           my $daemonpid;
     if (-e $pidfile) {      if (-e $pidfile) {
  my $lfh=IO::File->new("$pidfile");   my $lfh=IO::File->new("$pidfile");
  my $daemonpid=<$lfh>;   $daemonpid=<$lfh>;
  chomp($daemonpid);   chomp($daemonpid);
  if (kill 0 => $daemonpid) {   if (kill 0 => $daemonpid) {
     print $fh "<h3>$daemon at pid $daemonpid responding";      &log($fh,"<h3>$daemon at pid $daemonpid responding");
     if ($sendusr1) { print $fh ", sending USR1"; }      if ($sendusr1) { &log($fh,", sending USR1"); }
     print $fh "</h3>";      &log($fh,"</h3>");
     if ($sendusr1) { kill USR1 => $daemonpid; }      if ($sendusr1) { kill USR1 => $daemonpid; }
     $restartflag=0;      $restartflag=0;
     print "running\n";      print "running\n";
  } else {   } else {
     $errors++;      $errors++;
     print $fh "<h3>$daemon at pid $daemonpid not responding</h3>";      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
     $restartflag=1;      $restartflag=1;
     print $fh "<h3>Decided to clean up stale .pid file and restart $daemon</h3>";      &log($fh,"<h3>Decided to clean up stale .pid file and restart $daemon</h3>");
  }   }
     }      }
     if ($restartflag==1) {      if ($restartflag==1) {
  $simplestatus{$daemon}='off';   $simplestatus{$daemon}='off';
  $errors++;   $errors++;
  print $fh '<br><font color="red">Killall '.$daemon.': '.   my $kadaemon=$daemon;
     `killall $daemon 2>&1`.' - ';   if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
    &log($fh,'<br><font color="red">Killall '.$daemon.': '.
       `killall $kadaemon 2>&1`.' - ');
  sleep 2;   sleep 2;
  print $fh unlink($pidfile).' - '.   &log($fh,unlink($pidfile).' - '.
     `killall -9 $daemon 2>&1`.      `killall -9 $kadaemon 2>&1`.
     '</font><br>';      '</font><br>');
  print $fh "<h3>$daemon not running, trying to start</h3>";   &log($fh,"<h3>$daemon not running, trying to start</h3>");
   
  if (&start_daemon($fh,$daemon,$pidfile)) {   if (&start_daemon($fh,$daemon,$pidfile,$args)) {
     print $fh "<h3>$daemon at pid $daemonpid responding</h3>";      &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
     $simplestatus{$daemon}='restarted';      $simplestatus{$daemon}='restarted';
     print "started\n";      print "started\n";
  } else {   } else {
     $errors++;      $errors++;
     print $fh "<h3>$daemon at pid $daemonpid not responding</h3>";      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
     print $fh "Give it one more try ...<p>";      &log($fh,"<p>Give it one more try ...</p>");
     print " ";      print " ";
     if (&start_daemon($fh,$daemon,$pidfile)) {      if (&start_daemon($fh,$daemon,$pidfile,$args)) {
  print $fh "<h3>$daemon at pid $daemonpid responding</h3>";   &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
  $simplestatus{$daemon}='restarted';   $simplestatus{$daemon}='restarted';
  print "started\n";   print "started\n";
     } else {      } else {
  print " failed\n";   print " failed\n";
  $simplestatus{$daemon}='failed';   $simplestatus{$daemon}='failed';
  $errors++; $errors++;   $errors++; $errors++;
  print $fh "<h3>$daemon at pid $daemonpid not responding</h3>";   &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
  print $fh "Unable to start $daemon<p>";   &log($fh,"<p>Unable to start $daemon</p>");
     }      }
  }   }
   
  if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){   if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
     print $fh "<p><pre>";      &log($fh,"<p><pre>");
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");      open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
     while ($line=<DFH>) {       while (my $line=<DFH>) { 
  print $fh "$line";   &log($fh,"$line");
  if ($line=~/WARNING/) { $notices++; }   if ($line=~/WARNING/) { $notices++; }
  if ($line=~/CRITICAL/) { $notices++; }   if ($line=~/CRITICAL/) { $notices++; }
     };      };
     close (DFH);      close (DFH);
     print $fh "</pre>";      &log($fh,"</pre></p>");
  }   }
     }      }
           
     $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";      my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
           
     my ($dev,$ino,$mode,$nlink,      my ($dev,$ino,$mode,$nlink,
  $uid,$gid,$rdev,$size,   $uid,$gid,$rdev,$size,
Line 163  sub checkon_daemon { Line 205  sub checkon_daemon {
  $blksize,$blocks)=stat($fname);   $blksize,$blocks)=stat($fname);
           
     if ($size>$maxsize) {      if ($size>$maxsize) {
  print $fh "Rotating logs ...<p>";   &log($fh,"<p>Rotating logs ...</p>");
  rename("$fname.2","$fname.3");   rename("$fname.2","$fname.3");
  rename("$fname.1","$fname.2");   rename("$fname.1","$fname.2");
  rename("$fname","$fname.1");   rename("$fname","$fname.1");
Line 171  sub checkon_daemon { Line 213  sub checkon_daemon {
   
     &errout($fh);      &errout($fh);
 }  }
 # ================================================================ Main Program  
   
 # --------------------------------- 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");  
    $emailto=$perlvar{'lonSysEMail'};  
    $hostname=`/bin/hostname`;  
    chop $hostname;  
    $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell  
    $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  # --------------------------------------------------------------------- Machine
 my $wwwid=getpwnam('www');  sub log_machine_info {
 if ($wwwid!=$<) {      my ($fh)=@_;
    print("User ID mismatch.  This program must be run as user 'www'\n");      &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      &log($fh,"<h3>loadavg</h3>");
    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";  
    system("echo 'User ID mismatch.  loncron must be run as user www.' |\      open (LOADAVGH,"/proc/loadavg");
  mailto $emailto -s '$subj' > /dev/null");      my $loadavg=<LOADAVGH>;
    exit 1;      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++;
       }
   
 # ------------------------------------------------------------- Read hosts file      &log($fh,"<h3>df</h3>");
 {      &log($fh,"<pre>");
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");  
   
     while (my $configline=<$config>) {      open (DFH,"df|");
  my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);      while (my $line=<DFH>) { 
  if ($id && $domain && $role && $name && $ip) {   &log($fh,&encode_entities($line,'<>&"')); 
     $hostname{$id}=$name;   @parts=split(/\s+/,$line);
     $hostdom{$id}=$domain;   my $usage=$parts[4];
     $hostip{$id}=$ip;   $usage=~s/\W//g;
     $hostrole{$id}=$role;   if ($usage>90) { 
     if ($domdescr) { $domaindescription{$domain}=$domdescr; }      $warnings++;
     if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {      $notices++; 
  $libserv{$id}=$name;   } elsif ($usage>80) {
     }      $warnings++;
  } else {   } elsif ($usage>60) {
     if ($configline) {      $notices++;
 # &logthis("Skipping hosts.tab line -$configline-");  
     }  
  }   }
    if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
     }      }
 }      close (DFH);
       &log($fh,"</pre>");
   
 # ------------------------------------------------------ Read spare server file  
 {  
     my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");  
   
     while (my $configline=<$config>) {      &log($fh,"<h3>ps</h3>");
        chomp($configline);      &log($fh,"<pre>");
        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {      my $psproc=0;
           $spareid{$configline}=1;  
        }      open (PSH,"ps aux --cols 140 |");
       while (my $line=<PSH>) { 
    &log($fh,&encode_entities($line,'<>&"')); 
    $psproc++;
     }      }
 }      close (PSH);
       &log($fh,"</pre>");
   
 # ---------------------------------------------------------------- Start report      if ($psproc>200) { $notices++; }
       if ($psproc>250) { $notices++; }
 $statusdir="/home/httpd/html/lon-status";  
   
 $errors=0;  
 $warnings=0;  
 $notices=0;  
   
 $now=time;      &errout($fh);
 $date=localtime($now);  }
   
 {  sub start_logging {
 my $fh=IO::File->new(">$statusdir/newstatus.html");      my ($hostdom,$hostrole,$hostname,$spareid)=@_;
 my %simplestatus=();      my $fh=IO::File->new(">$statusdir/newstatus.html");
       my %simplestatus=();
       my $now=time;
       my $date=localtime($now);
       
   
 print $fh (<<ENDHEADERS);      &log($fh,(<<ENDHEADERS));
 <html>  <html>
 <head>  <head>
 <title>LON Status Report $perlvar{'lonHostID'}</title>  <title>LON Status Report $perlvar{'lonHostID'}</title>
 </head>  </head>
 <body bgcolor="#AAAAAA">  <body bgcolor="#AAAAAA">
 <a name="top">  <a name="top" />
 <h1>LON Status Report $perlvar{'lonHostID'}</h1>  <h1>LON Status Report $perlvar{'lonHostID'}</h1>
 <h2>$date ($now)</h2>  <h2>$date ($now)</h2>
 <ol>  <ol>
 <li><a href="#configuration">Configuration</a>  <li><a href="#configuration">Configuration</a></li>
 <li><a href="#machine">Machine Information</a>  <li><a href="#machine">Machine Information</a></li>
 <li><a href="#tmp">Temporary Files</a>  <li><a href="#tmp">Temporary Files</a></li>
 <li><a href="#tokens">Session Tokens</a>  <li><a href="#tokens">Session Tokens</a></li>
 <li><a href="#httpd">httpd</a>  <li><a href="#httpd">httpd</a></li>
 <li><a href="#lonsql">lonsql</a>  <li><a href="#lonsql">lonsql</a></li>
 <li><a href="#lond">lond</a>  <li><a href="#lond">lond</a></li>
 <li><a href="#lonc">lonc</a>  <li><a href="#lonc">lonc</a></li>
 <li><a href="#lonhttpd">lonhttpd</a>  <li><a href="#lonhttpd">lonhttpd</a></li>
 <li><a href="#lonnet">lonnet</a>  <li><a href="#lonnet">lonnet</a></li>
 <li><a href="#connections">Connections</a>  <li><a href="#connections">Connections</a></li>
 <li><a href="#delayed">Delayed Messages</a>  <li><a href="#delayed">Delayed Messages</a></li>
 <li><a href="#errcount">Error Count</a>  <li><a href="#errcount">Error Count</a></li>
 </ol>  </ol>
 <hr>  <hr />
 <a name="configuration">  <a name="configuration" />
 <h2>Configuration</h2>  <h2>Configuration</h2>
 <h3>PerlVars</h3>  <h3>PerlVars</h3>
 <table border=2>  <table border="2">
 ENDHEADERS  ENDHEADERS
   
 foreach $varname (sort(keys(%perlvar))) {      foreach my $varname (sort(keys(%perlvar))) {
     print $fh "<tr><td>$varname</td><td>$perlvar{$varname}</td></tr>\n";   &log($fh,"<tr><td>$varname</td><td>".
 }       &encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n");
 print $fh "</table><h3>Hosts</h3><table border=2>";      }
 foreach $id (sort(keys(%hostname))) {      &log($fh,"</table><h3>Hosts</h3><table border='2'>");
     print $fh       foreach my $id (sort(keys(%{$hostname}))) {
  "<tr><td>$id</td><td>$hostdom{$id}</td><td>$hostrole{$id}</td>";   &log($fh,
     print $fh "<td>$hostname{$id}</td><td>$hostip{$id}</td></tr>\n";      "<tr><td>$id</td><td>".$hostdom->{$id}.
 }      "</td><td>".$hostrole->{$id}.
 print $fh "</table><h3>Spare Hosts</h3><ol>";      "</td><td>".$hostname->{$id}."</td></tr>\n");
 foreach $id (sort(keys(%spareid))) {      }
     print $fh "<li>$id\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;
 }  }
   
 print $fh "</ol>\n";  # --------------------------------------------------------------- clean out tmp
   sub clean_tmp {
 # --------------------------------------------------------------------- Machine      my ($fh)=@_;
       &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
 print $fh '<hr><a name="machine"><h2>Machine Information</h2>';      my $cleaned=0;
 print $fh "<h3>loadavg</h3>";      my $old=0;
       while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {
 open (LOADAVGH,"/proc/loadavg");   my ($dev,$ino,$mode,$nlink,
 $loadavg=<LOADAVGH>;      $uid,$gid,$rdev,$size,
 close (LOADAVGH);      $atime,$mtime,$ctime,
       $blksize,$blocks)=stat($fname);
 print $fh "<tt>$loadavg</tt>";   my $now=time;
    my $since=$now-$mtime;
 @parts=split(/\s+/,$loadavg);   if ($since>$perlvar{'lonExpire'}) {
 if ($parts[1]>4.0) {      my $line='';
     $errors++;      if (open(PROBE,$fname)) {
 } elsif ($parts[1]>2.0) {   $line=<PROBE>;
     $warnings++;   close(PROBE);
 } elsif ($parts[1]>1.0) {      }
     $notices++;      unless ($line=~/^CHECKOUTTOKEN\&/) {
 }   $cleaned++;
    unlink("$fname");
 print $fh "<h3>df</h3>";      } else {
 print $fh "<pre>";   if ($since>365*$perlvar{'lonExpire'}) {
       $cleaned++;
 open (DFH,"df|");      unlink("$fname");
 while ($line=<DFH>) {    } else { $old++; }
    print $fh "$line";       }
    @parts=split(/\s+/,$line);   }
    $usage=$parts[4];      }
    $usage=~s/\W//g;      &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens).");
    if ($usage>90) {   
       $warnings++;  
       $notices++;   
    } elsif ($usage>80) {  
       $warnings++;  
    } elsif ($usage>60) {  
       $notices++;  
    }  
    if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }  
 }  
 close (DFH);  
 print $fh "</pre>";  
   
   
 print $fh "<h3>ps</h3>";  
 print $fh "<pre>";  
 $psproc=0;  
   
 open (PSH,"ps -aux|");  
 while ($line=<PSH>) {   
    print $fh "$line";   
    $psproc++;  
 }  }
 close (PSH);  
 print $fh "</pre>";  
   
 if ($psproc>200) { $notices++; }  # ------------------------------------------------------------ clean out lonIDs
 if ($psproc>250) { $notices++; }  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>");
   }
   
 &errout($fh);  
   
 # --------------------------------------------------------------- clean out tmp  # ----------------------------------------------------------------------- httpd
 print $fh '<hr><a name="tmp"><h2>Temporary Files</h2>';  sub check_httpd_logs {
 $cleaned=0;      my ($fh)=@_;
 $old=0;      &log($fh,'<hr /><a name="httpd" /><h2>httpd</h2><h3>Access Log</h3><pre>');
 while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) {  
                           my ($dev,$ino,$mode,$nlink,  
                               $uid,$gid,$rdev,$size,  
                               $atime,$mtime,$ctime,  
                               $blksize,$blocks)=stat($fname);  
                           $now=time;  
                           $since=$now-$mtime;  
                           if ($since>$perlvar{'lonExpire'}) {  
                               $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++; }  
                               }  
                           }  
           
       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);
 }  }
 print $fh "Cleaned up ".$cleaned." files (".$old." old checkout tokens).";  
   
 # ------------------------------------------------------------ clean out lonIDs  # ---------------------------------------------------------------------- lonnet
 print $fh '<hr><a name="tokens"><h2>Session Tokens</h2>';  
 $cleaned=0;  sub rotate_lonnet_logs {
 $active=0;      my ($fh)=@_;
 while ($fname=<$perlvar{'lonIDsDir'}/*>) {      &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
                           my ($dev,$ino,$mode,$nlink,      print "checking logs\n";
                               $uid,$gid,$rdev,$size,      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
                               $atime,$mtime,$ctime,   open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
                               $blksize,$blocks)=stat($fname);   while (my $line=<DFH>) { 
                           $now=time;      &log($fh,&encode_entities($line,'<>&"'));
                           $since=$now-$mtime;   }
                           if ($since>$perlvar{'lonExpire'}) {   close (DFH);
                               $cleaned++;      }
                               print $fh "Unlinking $fname<br>";      &log($fh,"</pre><h3>Perm Log</h3><pre>");
                               unlink("$fname");  
                           } else {  
                               $active++;  
                           }  
           
 }      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
 print $fh "<p>Cleaned up ".$cleaned." stale session token(s).";   open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
 print $fh "<h3>$active open session(s)</h3>";   while (my $line=<DFH>) { 
       &log($fh,&encode_entities($line,'<>&"'));
    }
    close (DFH);
       } else { &log($fh,"No perm log\n") }
   
 # ----------------------------------------------------------------------- httpd      my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
   
 print $fh '<hr><a name="httpd"><h2>httpd</h2><h3>Access Log</h3><pre>';      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");
       }
   
 open (DFH,"tail -n25 /etc/httpd/logs/access_log|");      &log($fh,"</pre>");
 while ($line=<DFH>) { print $fh "$line" };      &errout($fh);
 close (DFH);  }
   
 print $fh "</pre><h3>Error Log</h3><pre>";  # ----------------------------------------------------------------- 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("ping",$tryserver);
    if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
       $result="<b>ok</b>";
       $good++;
    } else {
       $result=$answer;
       $warnings++;
       if ($answer eq 'con_lost') {
    $bad++;
    $warnings++;
       } else {
    $good++; #self connection
       }
    }
    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);
   }
   
 open (DFH,"tail -n25 /etc/httpd/logs/error_log|");  
 while ($line=<DFH>) {   
    print $fh "$line";  
    if ($line=~/\[error\]/) { $notices++; }   
 };  
 close (DFH);  
 print $fh "</pre>";  
 &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>');
   
 # ---------------------------------------------------------------------- lonsql      my $unsend=0;
   
 &checkon_daemon($fh,'lonsql',200000);      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++; }
       }
   
 # ------------------------------------------------------------------------ lond      &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
       $warnings=$warnings+5*$unsend;
   
 &checkon_daemon($fh,'lond',40000,1);      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
       &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");
   
 # ------------------------------------------------------------------------ lonc      open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
       while (my $line=<DFH>) { 
    &log($fh,&encode_entities($line,'<>&"'));
       }
       &log($fh,"</pre>\n");
       close (DFH);
   }
   
 &checkon_daemon($fh,'lonc',40000,1);  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;
   }
   
 # -------------------------------------------------------------------- lonhttpd  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();
   }
   
 &checkon_daemon($fh,'lonhttpd',40000);  sub send_mail {
       print "sending mail\n";
       my $emailto="$perlvar{'lonAdmEMail'}";
       if ($totalcount>2500) {
    $emailto.=",$perlvar{'lonSysEMail'}";
       }
       my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; 
   
 # ---------------------------------------------------------------------- lonnet      my $result=system("metasend -b -S 4000000 -t $emailto -s '$subj' -f $statusdir/index.html -m text/html >& /dev/null");
       if ($result != 0) {
    $result=system("mail -s '$subj' $emailto < $statusdir/index.html");
       }
   }
   
 print $fh '<hr><a name="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>';  sub usage {
 print "checking logs\n";      print(<<USAGE);
 if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){  loncron - housekeeping program that checks up on various parts of Lon-CAPA
 open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");  
 while ($line=<DFH>) {   Options:
     print $fh "$line";     --help     Display help
 };     --oldlonc  When starting the lonc daemon use 'lonc' not 'loncnew'
 close (DFH);     --noemail  Do not send the status email
 }     --justcheckconnections  Only check the current status of the lonc/d
 print $fh "</pre><h3>Perm Log</h3><pre>";                                  connections, do not send emails do not
                                   check if the daemons are running, do not
 if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {                                  generate lon-status
     open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");     --justcheckdaemons      Only check that all of the Lon-CAPA daemons are
 while ($line=<DFH>) {                                   running, do not send emails do not
    print $fh "$line";                                  check the lonc/d connections, do not
 };                                  generate lon-status
 close (DFH);                             
 } else { print $fh "No perm log\n" }  USAGE
   
 $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) {  
     print $fh "Rotating logs ...<p>";  
     rename("$fname.2","$fname.3");  
     rename("$fname.1","$fname.2");  
     rename("$fname","$fname.1");  
 }  }
   
 print $fh "</pre>";  # ================================================================ Main Program
 &errout($fh);  sub main () {
 # ----------------------------------------------------------------- Connections      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
   
 print $fh '<hr><a name="connections"><h2>Connections</h2>';  # --------------------------------------- Make sure that LON-CAPA is configured
 print "testing connections\n";  # I only test for one thing here (lonHostID).  This is just a safeguard.
 print $fh "<table border=2>";      if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
 foreach $tryserver (sort(keys(%hostname))) {   print("Unconfigured machine.\n");
     print(".");   my $emailto=$perlvar{'lonSysEMail'};
     $answer=reply("pong",$tryserver);   my $hostname=`/bin/hostname`;
     if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {   chop $hostname;
  $result="<b>ok</b>";   $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
     } else {   my $subj="LON: Unconfigured machine $hostname";
         $result=$answer;   system("echo 'Unconfigured machine $hostname.' |\
         $warnings++;   mailto $emailto -s '$subj' > /dev/null");
         if ($answer eq 'con_lost') { $warnings++; }   exit 1;
     }      }
     if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }  
     print $fh "<tr><td>$tryserver</td><td>$result</td></tr>\n";  
   
 }  # ----------------------------- Make sure this process is running from user=www
 print $fh "</table>";      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;
       }
   
 &errout($fh);  # ------------------------------------------------------------- Read hosts file
 # ------------------------------------------------------------ Delayed messages      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)=split(/:/,$configline);
    if ($id && $domain && $role && $name) {
       $name=~s/\s//g;
       $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;
   
 print $fh '<hr><a name="delayed"><h2>Delayed Messages</h2>';  # ---------------------------------------------------------------- Start report
 print "checking buffers\n";  
   
 print $fh '<h3>Scanning Permanent Log</h3>';      $errors=0;
       $warnings=0;
       $notices=0;
   
 $unsend=0;  
 {      my $fh;
     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");      if (!$justcheckdaemons && !$justcheckconnections) {
     while ($line=<$dfh>) {   $fh=&start_logging(\%hostdom,\%hostrole,\%hostname,\%spareid);
  ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);  
         if ($sdf eq 'F') {    &log_machine_info($fh);
     $local=localtime($time);   &clean_tmp($fh);
             print $fh "<b>Failed: $time, $dserv, $dcmd</b><br>";   &clean_lonIDs($fh);
             $warnings++;   &check_httpd_logs($fh);
         }   &rotate_lonnet_logs($fh);
         if ($sdf eq 'S') { $unsend--; }      }
         if ($sdf eq 'D') { $unsend++; }      if (!$justcheckconnections) {
     }   &checkon_daemon($fh,'lonsql',200000);
 }   &checkon_daemon($fh,'lond',40000,1);
 print $fh "Total unsend messages: <b>$unsend</b><p>\n";   my $args='new';
 $warnings=$warnings+5*$unsend;   if ($oldlonc) { $args = ''; }
    &checkon_daemon($fh,'lonc',40000,1,$args);
 if ($unsend) { $simplestatus{'unsend'}=$unsend; }   &checkon_daemon($fh,'lonhttpd',40000);
 print $fh "<h3>Outgoing Buffer</h3>";   &checkon_daemon($fh,'lonmemcached',40000);
       }
 open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");      if (!$justcheckdaemons) {
 while ($line=<DFH>) {    &test_connections($fh,\%hostname);
     print $fh "$line<br>";      }
 };      if (!$justcheckdaemons && !$justcheckconnections) {
 close (DFH);   &check_delayed_msg($fh);
    &finish_logging($fh);
 # ------------------------------------------------------------------------- End   &log_simplestatus();
 print $fh "<a name=errcount>\n";  
 $totalcount=$notices+4*$warnings+100*$errors;   if ($totalcount>200 && !$noemail) { &send_mail(); }
 &errout($fh);      }
 print $fh "<h1>Total Error Count: $totalcount</h1>";  
 $now=time;  
 $date=localtime($now);  
 print $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;  
   
 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();  
 }  
 if ($totalcount>200) {  
    print "sending mail\n";  
    $emailto="$perlvar{'lonAdmEMail'}";  
    if ($totalcount>1000) {  
       $emailto.=",$perlvar{'lonSysEMail'}";  
    }  
    $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";   
    system(  
  "metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html");  
 }  }
   
   &main();
 1;  1;
   
   
Removed from v.1.42  
changed lines
  Added in v.1.58

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.