Diff for /loncom/loncron between versions 1.46 and 1.77

version 1.46, 2004/05/11 19:12:50 version 1.77, 2008/11/04 21:06:21
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 Apache::lonnet;
   
 use IO::File;  use IO::File;
 use IO::Socket;  use IO::Socket;
 use strict;  use HTML::Entities;
   use Getopt::Long;
 #globals  #globals
 use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);  use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
   
 my $statusdir="/home/httpd/html/lon-status";  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  # --------------------------------------------------------- Output error status
   
 sub log {  sub log {
Line 52  sub log { Line 54  sub log {
 sub errout {  sub errout {
    my $fh=shift;     my $fh=shift;
    &log($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 rotate_logfile {
       my ($file,$fh,$description) = @_;
       my $size=(stat($file))[7];
       if ($size>40000) {
    &log($fh,"<p>Rotating $description ...</p>");
    rename("$file.2","$file.3");
    rename("$file.1","$file.2");
    rename("$file","$file.1");
       } 
   }
   
 sub start_daemon {  sub start_daemon {
     my ($fh,$daemon,$pidfile) = @_;      my ($fh,$daemon,$pidfile,$args) = @_;
     my $progname=$daemon;      my $progname=$daemon;
     if ($daemon eq 'lonc' && $ARGV[0] eq 'new') {      if ($daemon eq 'lonc') {
  $progname='loncnew';    $progname='loncnew'; 
  print "new ";  
     }      }
     system("$perlvar{'lonDaemons'}/$progname 2>>$perlvar{'lonDaemons'}/logs/${daemon}_errors");      my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
     sleep 2;      &rotate_logfile($error_fname,$fh,'error logs');
       if ($daemon eq 'lonc') {
    &clean_sockets($fh);
       }
       system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
       sleep 1;
     if (-e $pidfile) {      if (-e $pidfile) {
  &log($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);
  sleep 2;   if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
  if (kill 0 => $daemonpid) {  
     return 1;      return 1;
  } else {   } else {
     return 0;      return 0;
  }   }
     }      }
     &log($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,$send,$args)=@_;
   
     &log($fh,'<hr><a name="'.$daemon.'"><h2>'.$daemon.'</h2><h3>Log</h3><pre>');      my $result;
     printf("%-10s ",$daemon);      &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
       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 (my $line=<DFH>) {    while (my $line=<DFH>) { 
Line 101  sub checkon_daemon { Line 118  sub checkon_daemon {
  };   };
  close (DFH);   close (DFH);
     }      }
     &log($fh,"</pre>");      &log($fh,"</tt></p>");
           
     my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";      my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
           
Line 111  sub checkon_daemon { Line 128  sub checkon_daemon {
  my $lfh=IO::File->new("$pidfile");   my $lfh=IO::File->new("$pidfile");
  $daemonpid=<$lfh>;   $daemonpid=<$lfh>;
  chomp($daemonpid);   chomp($daemonpid);
  if (kill 0 => $daemonpid) {   if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
     &log($fh,"<h3>$daemon at pid $daemonpid responding");      &log($fh,"<h3>$daemon at pid $daemonpid responding");
     if ($sendusr1) { &log($fh,", sending USR1"); }      if ($send) { &log($fh,", sending $send"); }
     &log($fh,"</h3>");      &log($fh,"</h3>");
     if ($sendusr1) { kill USR1 => $daemonpid; }      if ($send eq 'USR1') { kill USR1 => $daemonpid; }
       if ($send eq 'USR2') { kill USR2 => $daemonpid; }
     $restartflag=0;      $restartflag=0;
     print "running\n";      if ($send eq 'USR2') {
    $result = 'reloaded';
    print "reloaded\n";
       } else {
    $result = 'running';
    print "running\n";
       }
  } else {   } else {
     $errors++;      $errors++;
     &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
Line 128  sub checkon_daemon { Line 152  sub checkon_daemon {
     if ($restartflag==1) {      if ($restartflag==1) {
  $simplestatus{$daemon}='off';   $simplestatus{$daemon}='off';
  $errors++;   $errors++;
    my $kadaemon=$daemon;
    if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
  &log($fh,'<br><font color="red">Killall '.$daemon.': '.   &log($fh,'<br><font color="red">Killall '.$daemon.': '.
     `killall $daemon 2>&1`.' - ');      `killall $kadaemon 2>&1`.' - ');
  sleep 2;   sleep 1;
  &log($fh,unlink($pidfile).' - '.   &log($fh,unlink($pidfile).' - '.
     `killall -9 $daemon 2>&1`.      `killall -9 $kadaemon 2>&1`.
     '</font><br>');      '</font><br>');
  &log($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)) {
     &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");      &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
     $simplestatus{$daemon}='restarted';      $simplestatus{$daemon}='restarted';
       $result = 'started';
     print "started\n";      print "started\n";
  } else {   } else {
     $errors++;      $errors++;
     &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
     &log($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)) {
  &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");   &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
  $simplestatus{$daemon}='restarted';   $simplestatus{$daemon}='restarted';
    $result = 'started';
  print "started\n";   print "started\n";
     } else {      } else {
    $result = 'failed';
  print " failed\n";   print " failed\n";
  $simplestatus{$daemon}='failed';   $simplestatus{$daemon}='failed';
  $errors++; $errors++;   $errors++; $errors++;
  &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");   &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
  &log($fh,"Unable to start $daemon<p>");   &log($fh,"<p>Unable to start $daemon</p>");
     }      }
  }   }
   
Line 167  sub checkon_daemon { Line 196  sub checkon_daemon {
  if ($line=~/CRITICAL/) { $notices++; }   if ($line=~/CRITICAL/) { $notices++; }
     };      };
     close (DFH);      close (DFH);
     &log($fh,"</pre>");      &log($fh,"</pre></p>");
  }   }
     }      }
           
     my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";      my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
           &rotate_logfile($fname,$fh,'logs');
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
       
     if ($size>$maxsize) {  
  &log($fh,"Rotating logs ...<p>");  
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &errout($fh);      &errout($fh);
       return $result;
 }  }
   
 # --------------------------------------------------------------------- Machine  # --------------------------------------------------------------------- Machine
 sub log_machine_info {  sub log_machine_info {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="machine"><h2>Machine Information</h2>');      &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
     &log($fh,"<h3>loadavg</h3>");      &log($fh,"<h3>loadavg</h3>");
   
     open (LOADAVGH,"/proc/loadavg");      open (LOADAVGH,"/proc/loadavg");
Line 214  sub log_machine_info { Line 233  sub log_machine_info {
   
     open (DFH,"df|");      open (DFH,"df|");
     while (my $line=<DFH>) {       while (my $line=<DFH>) { 
  &log($fh,"$line");    &log($fh,&encode_entities($line,'<>&"')); 
  @parts=split(/\s+/,$line);   @parts=split(/\s+/,$line);
  my $usage=$parts[4];   my $usage=$parts[4];
  $usage=~s/\W//g;   $usage=~s/\W//g;
Line 236  sub log_machine_info { Line 255  sub log_machine_info {
     &log($fh,"<pre>");      &log($fh,"<pre>");
     my $psproc=0;      my $psproc=0;
   
     open (PSH,"ps -aux --cols 140 |");      open (PSH,"ps aux --cols 140 |");
     while (my $line=<PSH>) {       while (my $line=<PSH>) { 
  &log($fh,"$line");    &log($fh,&encode_entities($line,'<>&"')); 
  $psproc++;   $psproc++;
     }      }
     close (PSH);      close (PSH);
Line 247  sub log_machine_info { Line 266  sub log_machine_info {
     if ($psproc>200) { $notices++; }      if ($psproc>200) { $notices++; }
     if ($psproc>250) { $notices++; }      if ($psproc>250) { $notices++; }
   
       &log($fh,"<h3>distprobe</h3>");
       &log($fh,"<pre>");
       open(DSH,"$perlvar{'lonDaemons'}/distprobe |");
       while (my $line=<DSH>) { 
    &log($fh,&encode_entities($line,'<>&"')); 
    $psproc++;
       }
       close(DSH);
       &log($fh,"</pre>");
   
     &errout($fh);      &errout($fh);
 }  }
   
 sub start_logging {  sub start_logging {
     my ($hostdom,$hostrole,$hostname,$spareid)=@_;  
     my $fh=IO::File->new(">$statusdir/newstatus.html");      my $fh=IO::File->new(">$statusdir/newstatus.html");
     my %simplestatus=();      my %simplestatus=();
     my $now=time;      my $now=time;
Line 264  sub start_logging { Line 292  sub start_logging {
 <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="#lonnet">lonnet</a></li>
 <li><a href="#lonnet">lonnet</a>  <li><a href="#connections">Connections</a></li>
 <li><a href="#connections">Connections</a>  <li><a href="#delayed">Delayed Messages</a></li>
 <li><a href="#delayed">Delayed Messages</a>  <li><a href="#errcount">Error Count</a></li>
 <li><a href="#errcount">Error Coindex.html.unt</a>  
 </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 my $varname (sort(keys(%perlvar))) {      foreach my $varname (sort(keys(%perlvar))) {
  &log($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");
     }      }
     &log($fh,"</table><h3>Hosts</h3><table border=2>");      &log($fh,"</table><h3>Hosts</h3><table border='2'>");
     foreach my $id (sort(keys(%{$hostname}))) {      my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $id (sort(keys(%hostname))) {
    my $role = (&Apache::lonnet::is_library($id) ? 'library'
                                        : 'access');
  &log($fh,   &log($fh,
     "<tr><td>$id</td><td>".$hostdom->{$id}.      "<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id).
     "</td><td>".$hostrole->{$id}.      "</td><td>".$role.
     "</td><td>".$hostname->{$id}."</td></tr>\n");      "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
     }      }
     &log($fh,"</table><h3>Spare Hosts</h3><ol>");      &log($fh,"</table><h3>Spare Hosts</h3><ul>");
     foreach my $id (sort(keys(%{$spareid}))) {      foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
  &log($fh,"<li>$id\n");   &log($fh,"<li>$type\n<ol>");
    foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {
       &log($fh,"<li>$id</li>\n");
    }
    &log($fh,"</ol>\n</li>\n");
     }      }
     &log($fh,"</ol>\n");      &log($fh,"</ul>\n");
     return $fh;      return $fh;
 }  }
   
 # --------------------------------------------------------------- clean out tmp  # --------------------------------------------------------------- clean out tmp
 sub clean_tmp {  sub clean_tmp {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="tmp"><h2>Temporary Files</h2>');      &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
     my $cleaned=0;      my $cleaned=0;
     my $old=0;      my $old=0;
     while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {      while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {
Line 343  sub clean_tmp { Line 378  sub clean_tmp {
 # ------------------------------------------------------------ clean out lonIDs  # ------------------------------------------------------------ clean out lonIDs
 sub clean_lonIDs {  sub clean_lonIDs {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="tokens"><h2>Session Tokens</h2>');      &log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>');
     my $cleaned=0;      my $cleaned=0;
     my $active=0;      my $active=0;
     while (my $fname=<$perlvar{'lonIDsDir'}/*>) {      while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
Line 361  sub clean_lonIDs { Line 396  sub clean_lonIDs {
     $active++;      $active++;
  }   }
     }      }
     &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).");      &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
     &log($fh,"<h3>$active open session(s)</h3>");      &log($fh,"<h3>$active open session(s)</h3>");
 }  }
   
   # ----------------------------------------------------------- clean out sockets
   sub clean_sockets {
       my ($fh)=@_;
       my $cleaned=0;
       opendir(SOCKETS,$perlvar{'lonSockDir'});
       while (my $fname=readdir(SOCKETS)) {
    next if (-d $fname 
    || $fname=~/(mysqlsock|maximasock|\Q$perlvar{'lonSockDir'}\E)/);
    $cleaned++;
    &log($fh,"Unlinking $fname<br />");
    unlink("/home/httpd/sockets/$fname");
       }
       &log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>");
   }
   
   
 # ----------------------------------------------------------------------- httpd  # ----------------------------------------------------------------------- httpd
 sub check_httpd_logs {  sub check_httpd_logs {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="httpd"><h2>httpd</h2><h3>Access Log</h3><pre>');      &log($fh,'<hr /><a name="httpd" /><h2>httpd</h2><h3>Access Log</h3><pre>');
           
     open (DFH,"tail -n25 /etc/httpd/logs/access_log|");      open (DFH,"tail -n25 /etc/httpd/logs/access_log|");
     while (my $line=<DFH>) { &log($fh,"$line") };      while (my $line=<DFH>) { &log($fh,&encode_entities($line,'<>&"')) };
     close (DFH);      close (DFH);
   
     &log($fh,"</pre><h3>Error Log</h3><pre>");      &log($fh,"</pre><h3>Error Log</h3><pre>");
Line 389  sub check_httpd_logs { Line 439  sub check_httpd_logs {
   
 # ---------------------------------------------------------------------- lonnet  # ---------------------------------------------------------------------- lonnet
   
 sub rotate_logs {  sub rotate_lonnet_logs {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>');      &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
     print "checking logs\n";      print "checking logs\n";
     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
  open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");   open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
  while (my $line=<DFH>) {    while (my $line=<DFH>) { 
     &log($fh,"$line");      &log($fh,&encode_entities($line,'<>&"'));
  }   }
  close (DFH);   close (DFH);
     }      }
Line 405  sub rotate_logs { Line 455  sub rotate_logs {
     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
  open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");   open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
  while (my $line=<DFH>) {    while (my $line=<DFH>) { 
     &log($fh,"$line");      &log($fh,&encode_entities($line,'<>&"'));
  }   }
  close (DFH);   close (DFH);
     } else { &log($fh,"No perm log\n") }      } else { &log($fh,"No perm log\n") }
   
     my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";      my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
       &rotate_logfile($fname,$fh,'lonnet log');
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
   
     if ($size>40000) {  
  &log($fh,"Rotating logs ...<p>");  
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &log($fh,"</pre>");      &log($fh,"</pre>");
     &errout($fh);      &errout($fh);
 }  }
   
   sub rotate_other_logs {
       my ($fh) = @_;
       my $fname="$perlvar{'lonDaemons'}/logs/autoenroll.log";
       &rotate_logfile($fname,$fh,'Auto Enroll log');
       $fname="$perlvar{'lonDaemons'}/logs/autocreate.log";
       &rotate_logfile($fname,$fh,'Create Course log');
       $fname="$perlvar{'lonDaemons'}/logs/searchcat.log";
       &rotate_logfile($fname,$fh,'Search Cataloguing log');
   }
   
 # ----------------------------------------------------------------- Connections  # ----------------------------------------------------------------- Connections
 sub test_connections {  sub test_connections {
     my ($fh,$hostname)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="connections"><h2>Connections</h2>');      &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
     print "testing connections\n";      print "testing connections\n";
     &log($fh,"<table border=2>");      &log($fh,"<table border='2'>");
     foreach my $tryserver (sort(keys(%{$hostname}))) {      my ($good,$bad)=(0,0);
       my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $tryserver (sort(keys(%hostname))) {
  print(".");   print(".");
  my $result;   my $result;
  my $answer=reply("pong",$tryserver);   my $answer=&Apache::lonnet::reply("ping",$tryserver);
  if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {   if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
     $result="<b>ok</b>";      $result="<b>ok</b>";
       $good++;
  } else {   } else {
     $result=$answer;      $result=$answer;
     $warnings++;      $warnings++;
     if ($answer eq 'con_lost') { $warnings++; }      if ($answer eq 'con_lost') {
    $bad++;
    $warnings++;
       } else {
    $good++; #self connection
       }
  }   }
  if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }   if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }
  &log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n");   &log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n");
     }      }
     &log($fh,"</table>");      &log($fh,"</table>");
       print "\n$good good, $bad bad connections\n";
     &errout($fh);      &errout($fh);
 }  }
   
Line 457  sub test_connections { Line 514  sub test_connections {
 # ------------------------------------------------------------ Delayed messages  # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {  sub check_delayed_msg {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr><a name="delayed"><h2>Delayed Messages</h2>');      &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
     print "checking buffers\n";      print "checking buffers\n";
           
     &log($fh,'<h3>Scanning Permanent Log</h3>');      &log($fh,'<h3>Scanning Permanent Log</h3>');
Line 476  sub check_delayed_msg { Line 533  sub check_delayed_msg {
  if ($sdf eq 'D') { $unsend++; }   if ($sdf eq 'D') { $unsend++; }
     }      }
   
     &log($fh,"Total unsend messages: <b>$unsend</b><p>\n");      &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
     $warnings=$warnings+5*$unsend;      $warnings=$warnings+5*$unsend;
   
     if ($unsend) { $simplestatus{'unsend'}=$unsend; }      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
     &log($fh,"<h3>Outgoing Buffer</h3>");      &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");
   # list directory with delayed messages and remember offline servers
       my %servers=();
     open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");      open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
     while (my $line=<DFH>) {       while (my $line=<DFH>) {
  &log($fh,"$line<br>");          my ($server)=($line=~/\.(\w+)$/);
           if ($server) { $servers{$server}=1; }
    &log($fh,&encode_entities($line,'<>&"'));
     }      }
       &log($fh,"</pre>\n");
     close (DFH);      close (DFH);
   # pong to all servers that have delayed messages
   # this will trigger a reverse connection, which should flush the buffers
       foreach my $tryserver (keys %servers) {
    my $answer=&Apache::lonnet::reply("pong",$tryserver);
    &log($fh,"Pong to $tryserver: $answer<br />");
       }
 }  }
   
 sub finish_logging {  sub finish_logging {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,"<a name=errcount>\n");      &log($fh,"<a name='errcount' />\n");
     $totalcount=$notices+4*$warnings+100*$errors;      $totalcount=$notices+4*$warnings+100*$errors;
     &errout($fh);      &errout($fh);
     &log($fh,"<h1>Total Error Count: $totalcount</h1>");      &log($fh,"<h1>Total Error Count: $totalcount</h1>");
     my $now=time;      my $now=time;
     my $date=localtime($now);      my $date=localtime($now);
     &log($fh,"<hr>$date ($now)</body></html>\n");      &log($fh,"<hr />$date ($now)</body></html>\n");
     print "lon-status webpage updated\n";      print "lon-status webpage updated\n";
     $fh->close();      $fh->close();
   
Line 508  sub finish_logging { Line 575  sub finish_logging {
 }  }
   
 sub log_simplestatus {  sub log_simplestatus {
     rename ("$statusdir/newstatus.html","$statusdir/index.html");      rename("$statusdir/newstatus.html","$statusdir/index.html");
           
     my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");      my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
     foreach (keys %simplestatus) {      foreach (keys %simplestatus) {
Line 521  sub log_simplestatus { Line 588  sub log_simplestatus {
 sub send_mail {  sub send_mail {
     print "sending mail\n";      print "sending mail\n";
     my $emailto="$perlvar{'lonAdmEMail'}";      my $emailto="$perlvar{'lonAdmEMail'}";
     if ($totalcount>1000) {      if ($totalcount>2500) {
  $emailto.=",$perlvar{'lonSysEMail'}";   $emailto.=",$perlvar{'lonSysEMail'}";
     }      }
     my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";       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");  
       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");
       }
   }
   
   sub usage {
       print(<<USAGE);
   loncron - housekeeping program that checks up on various parts of Lon-CAPA
   
   Options:
      --help     Display 
      --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
      --justreload            Only tell the daemons to reload the config files,
    do not send emails do not
                                   check if the daemons are running, do not
                                   generate lon-status
                              
   USAGE
 }  }
   
 # ================================================================ Main Program  # ================================================================ Main Program
 sub main () {  sub main () {
       my ($help,$justcheckdaemons,$noemail,$justcheckconnections,
    $justreload);
       &GetOptions("help"                 => \$help,
    "justcheckdaemons"     => \$justcheckdaemons,
    "noemail"              => \$noemail,
    "justcheckconnections" => \$justcheckconnections,
    "justreload"           => \$justreload
    );
       if ($help) { &usage(); return; }
 # --------------------------------- Read loncapa_apache.conf and loncapa.conf  # --------------------------------- Read loncapa_apache.conf and loncapa.conf
     my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');      my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
     %perlvar=%{$perlvarref};      %perlvar=%{$perlvarref};
     undef $perlvarref;      undef $perlvarref;
     delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed      delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
     delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed      delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
       chdir($perlvar{'lonDaemons'});
 # --------------------------------------- Make sure that LON-CAPA is configured  # --------------------------------------- Make sure that LON-CAPA is configured
 # I only test for one thing here (lonHostID).  This is just a safeguard.  # I only test for one thing here (lonHostID).  This is just a safeguard.
     if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {      if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
Line 562  sub main () { Line 665  sub main () {
  exit 1;   exit 1;
     }      }
   
 # ------------------------------------------------------------- Read hosts file  # -------------------------------------------- Force reload of host information
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");      &Apache::lonnet::load_hosts_tab(1);
           &Apache::lonnet::load_domain_tab(1);
     my (%hostname,%hostdom,%hostrole,%spareid);      &Apache::lonnet::get_iphost(1);
     while (my $configline=<$config>) {  
  my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);  
  if ($id && $domain && $role && $name && $ip) {  
     $hostname{$id}=$name;  
     $hostdom{$id}=$domain;  
     $hostrole{$id}=$role;  
  } else {  
     if ($configline) {  
 # &logthis("Skipping hosts.tab line -$configline-");  
     }  
  }  
     }  
     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  # ---------------------------------------------------------------- Start report
   
Line 597  sub main () { Line 676  sub main () {
     $warnings=0;      $warnings=0;
     $notices=0;      $notices=0;
   
     my $fh=&start_logging(\%hostdom,\%hostrole,\%hostname,\%spareid);  
   
     &log_machine_info($fh);  
     &clean_tmp($fh);  
     &clean_lonIDs($fh);  
     &check_httpd_logs($fh);  
     &checkon_daemon($fh,'lonsql',200000);  
     &checkon_daemon($fh,'lond',40000,1);  
     &checkon_daemon($fh,'lonc',40000,1);  
     &checkon_daemon($fh,'lonhttpd',40000);  
       
     &test_connections($fh,\%hostname);  
     &check_delayed_msg($fh);  
   
     &finish_logging($fh);  
     &log_simplestatus();  
   
     if ($totalcount>200) { &send_mail(); }      my $fh;
       if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
    $fh=&start_logging();
   
    &log_machine_info($fh);
    &clean_tmp($fh);
    &clean_lonIDs($fh);
    &check_httpd_logs($fh);
    &rotate_lonnet_logs($fh);
    &rotate_other_logs($fh);
       }
       if (!$justcheckconnections && !$justreload) {
    &checkon_daemon($fh,'lonmemcached',40000);
    &checkon_daemon($fh,'lonsql',200000);
    if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
       &checkon_daemon($fh,'lond',40000,'USR2');
    }
    &checkon_daemon($fh,'lonc',40000,'USR1');
           &checkon_daemon($fh,'lonmaxima',40000);
       }
       if ($justreload) {
    &checkon_daemon($fh,'lond',40000,'USR2');
    &checkon_daemon($fh,'lonc',40000,'USR2');
       }
       if ($justcheckconnections) {
    &test_connections($fh);
       }
       if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
    &check_delayed_msg($fh);
    &finish_logging($fh);
    &log_simplestatus();
   
    if ($totalcount>200 && !$noemail) { &send_mail(); }
       }
 }  }
   
 &main();  &main();

Removed from v.1.46  
changed lines
  Added in v.1.77


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.