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

Diff for /loncom/loncron between versions 1.43 and 1.97

version 1.43, 2003/09/11 19:49:59 version 1.97, 2013/02/02 14:42:01
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 LONCAPA::Checksumming;
   use LONCAPA;
   use Apache::lonnet;
   use Apache::loncommon;
   
 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  
 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 {
       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 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) = @_;
     system("$perlvar{'lonDaemons'}/$daemon 2>>$perlvar{'lonDaemons'}/logs/${daemon}_errors");      my $progname=$daemon;
     sleep 2;      if ($daemon eq 'lonc') {
    $progname='loncnew'; 
       }
       my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
       &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) {
  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);
  sleep 2;   if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
  if (kill 0 => $daemonpid) {  
     return 1;      return 1;
  } else {   } else {
     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,$send,$args)=@_;
   
     print $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 ($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 ($daemonpid =~ /^\d+$/ && 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 ($send) { &log($fh,", sending $send"); }
     print $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++;
     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'; }
  sleep 2;   &log($fh,'<br><font color="red">Killall '.$daemon.': '.
  print $fh unlink($pidfile).' - '.      `killall $kadaemon 2>&1`.' - ');
     `killall -9 $daemon 2>&1`.   sleep 1;
     '</font><br>';   &log($fh,unlink($pidfile).' - '.
  print $fh "<h3>$daemon not running, trying to start</h3>";      `killall -9 $kadaemon 2>&1`.
       '</font><br>');
    &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';
       $result = 'started';
     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';
    $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++;
  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";
           &rotate_logfile($fname,$fh,'logs');
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
       
     if ($size>$maxsize) {  
  print $fh "Rotating logs ...<p>";  
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &errout($fh);      &errout($fh);
 }      return $result;
 # ================================================================ 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  
 my $wwwid=getpwnam('www');  
 if ($wwwid!=$<) {  
     print("User ID mismatch.  This program must be run as user 'www'\n");  
     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";  
     $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");  
       
     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;  
     $hostip{$id}=$ip;  
     $hostrole{$id}=$role;  
     if ($domdescr) { $domaindescription{$domain}=$domdescr; }  
     if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {  
  $libserv{$id}=$name;  
     }  
  } else {  
     if ($configline) {  
 # &logthis("Skipping hosts.tab line -$configline-");  
     }  
  }  
     }  
 }  
   
 # ------------------------------------------------------ Read spare server file  
 {  
     my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");  
       
     while (my $configline=<$config>) {  
  chomp($configline);  
  if (($configline) && ($configline ne $perlvar{'lonHostID'})) {  
     $spareid{$configline}=1;  
  }  
     }  
 }  }
   
 # ---------------------------------------------------------------- Start report  
   
 $statusdir="/home/httpd/html/lon-status";  
   
 $errors=0;  
 $warnings=0;  
 $notices=0;  
   
 $now=time;  
 $date=localtime($now);  
   
 {  
     my $fh=IO::File->new(">$statusdir/newstatus.html");  
     my %simplestatus=();  
       
     print $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><a href="#machine">Machine Information</a>  
 <li><a href="#tmp">Temporary Files</a>  
 <li><a href="#tokens">Session Tokens</a>  
 <li><a href="#httpd">httpd</a>  
 <li><a href="#lonsql">lonsql</a>  
 <li><a href="#lond">lond</a>  
 <li><a href="#lonc">lonc</a>  
 <li><a href="#lonhttpd">lonhttpd</a>  
 <li><a href="#lonnet">lonnet</a>  
 <li><a href="#connections">Connections</a>  
 <li><a href="#delayed">Delayed Messages</a>  
 <li><a href="#errcount">Error Count</a>  
 </ol>  
 <hr>  
 <a name="configuration">  
 <h2>Configuration</h2>  
 <h3>PerlVars</h3>  
 <table border=2>  
 ENDHEADERS  
   
     foreach $varname (sort(keys(%perlvar))) {  
  print $fh "<tr><td>$varname</td><td>$perlvar{$varname}</td></tr>\n";  
     }  
     print $fh "</table><h3>Hosts</h3><table border=2>";  
     foreach $id (sort(keys(%hostname))) {  
  print $fh   
     "<tr><td>$id</td><td>$hostdom{$id}</td><td>$hostrole{$id}</td>";  
  print $fh "<td>$hostname{$id}</td><td>$hostip{$id}</td></tr>\n";  
     }  
     print $fh "</table><h3>Spare Hosts</h3><ol>";  
     foreach $id (sort(keys(%spareid))) {  
  print $fh "<li>$id\n";  
     }  
       
     print $fh "</ol>\n";  
   
 # --------------------------------------------------------------------- Machine  # --------------------------------------------------------------------- Machine
       sub log_machine_info {
     print $fh '<hr><a name="machine"><h2>Machine Information</h2>';      my ($fh)=@_;
     print $fh "<h3>loadavg</h3>";      &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
           &log($fh,"<h3>loadavg</h3>");
   
     open (LOADAVGH,"/proc/loadavg");      open (LOADAVGH,"/proc/loadavg");
     $loadavg=<LOADAVGH>;      my $loadavg=<LOADAVGH>;
     close (LOADAVGH);      close (LOADAVGH);
           
     print $fh "<tt>$loadavg</tt>";      &log($fh,"<tt>$loadavg</tt>");
           
     @parts=split(/\s+/,$loadavg);      my @parts=split(/\s+/,$loadavg);
     if ($parts[1]>4.0) {      if ($parts[1]>4.0) {
  $errors++;   $errors++;
     } elsif ($parts[1]>2.0) {      } elsif ($parts[1]>2.0) {
Line 322  ENDHEADERS Line 231  ENDHEADERS
  $notices++;   $notices++;
     }      }
   
     print $fh "<h3>df</h3>";      &log($fh,"<h3>df</h3>");
     print $fh "<pre>";      &log($fh,"<pre>");
   
     open (DFH,"df|");      open (DFH,"df|");
     while ($line=<DFH>) {       while (my $line=<DFH>) { 
  print $fh "$line";    &log($fh,&encode_entities($line,'<>&"')); 
  @parts=split(/\s+/,$line);   @parts=split(/\s+/,$line);
  $usage=$parts[4];   my $usage=$parts[4];
  $usage=~s/\W//g;   $usage=~s/\W//g;
  if ($usage>90) {    if ($usage>90) { 
     $warnings++;      $warnings++;
Line 342  ENDHEADERS Line 251  ENDHEADERS
  if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }   if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
     }      }
     close (DFH);      close (DFH);
     print $fh "</pre>";      &log($fh,"</pre>");
   
   
     print $fh "<h3>ps</h3>";      &log($fh,"<h3>ps</h3>");
     print $fh "<pre>";      &log($fh,"<pre>");
     $psproc=0;      my $psproc=0;
   
     open (PSH,"ps -aux|");      open (PSH,"ps aux --cols 140 |");
     while ($line=<PSH>) {       while (my $line=<PSH>) { 
  print $fh "$line";    &log($fh,&encode_entities($line,'<>&"')); 
  $psproc++;   $psproc++;
     }      }
     close (PSH);      close (PSH);
     print $fh "</pre>";      &log($fh,"</pre>");
   
     if ($psproc>200) { $notices++; }      if ($psproc>200) { $notices++; }
     if ($psproc>250) { $notices++; }      if ($psproc>250) { $notices++; }
   
       &log($fh,"<h3>distprobe</h3>");
       &log($fh,"<pre>");
       &get_distro($perlvar{'lonDaemons'},$fh);
       &log($fh,"</pre>");
   
     &errout($fh);      &errout($fh);
   }
   
 # --------------------------------------------------------------- clean out tmp  sub start_logging {
     print $fh '<hr><a name="tmp"><h2>Temporary Files</h2>';      my $fh=IO::File->new(">$statusdir/newstatus.html");
     $cleaned=0;      my %simplestatus=();
     $old=0;      my $now=time;
     while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) {      my $date=localtime($now);
  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++; }  
     }  
  }  
           
   
       &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="#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'>");
       my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $id (sort(keys(%hostname))) {
    my $role = (&Apache::lonnet::is_library($id) ? 'library'
                                        : 'access');
    &log($fh,
       "<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id).
       "</td><td>".$role.
       "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
       }
       &log($fh,"</table><h3>Spare Hosts</h3><ul>");
       foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
    &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");
     }      }
     print $fh "Cleaned up ".$cleaned." files (".$old." old checkout tokens).";      &log($fh,"</ul>\n");
       return $fh;
   }
   
   # --------------------------------------------------------------- clean out tmp
   sub clean_tmp {
       my ($fh)=@_;
       &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
       my ($cleaned,$old,$removed) = (0,0,0);
       my %errors = (
                        dir       => [],
                        file      => [],
                        failopen  => [],
                    );
       my %error_titles = (
                            dir       => 'failed to remove empty directory:',
                            file      => 'failed to unlike stale file',
                            failopen  => 'failed to open file or directory'
                          );
       ($cleaned,$old,$removed) = &recursive_clean_tmp('',$cleaned,$old,$removed,\%errors);
       &log($fh,"Cleaned up: ".$cleaned." files; removed: $removed empty directories; (found: $old old checkout tokens)");
       foreach my $key (sort(keys(%errors))) {
           if (ref($errors{$key}) eq 'ARRAY') {
               if (@{$errors{$key}} > 0) {
                   &log($fh,"Error during cleanup ($error_titles{$key}):<ul><li>".
                        join('</li><li><tt>',@{$errors{$key}}).'</tt></li></ul><br />');
               }
           }
       }
   }
   
   sub recursive_clean_tmp {
       my ($subdir,$cleaned,$old,$removed,$errors) = @_;
       my $base = "$perlvar{'lonDaemons'}/tmp";
       my $path = $base;
       next if ($subdir =~ m{\.\./});
       next unless (ref($errors) eq 'HASH');
       unless ($subdir eq '') {
           $path .= '/'.$subdir;
       }
       if (opendir(my $dh,"$path")) {
           while (my $file = readdir($dh)) {
               next if ($file =~ /^\.\.?$/);
               my $fname = "$path/$file";
               if (-d $fname) {
                   my $innerdir;
                   if ($subdir eq '') {
                       $innerdir = $file;
                   } else {
                       $innerdir = $subdir.'/'.$file;
                   }
                   ($cleaned,$old,$removed) = 
                        &recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
                   my @doms = &Apache::lonnet::current_machine_domains();
                   
                   if (open(my $dirhandle,$fname)) {
                       unless (($innerdir eq 'helprequests') ||
                               (($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {
                           my @contents = grep {!/^\.\.?$/} readdir($dirhandle);
                                         join('&&',@contents)."\n";    
                           if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
                               closedir($dirhandle);
                               if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
                                   if (rmdir($fname)) {
                                       $removed ++;
                                   } elsif (ref($errors->{dir}) eq 'ARRAY') {
                                       push(@{$errors->{dir}},$fname);
                                   }
                               }
                           }
                       } else {
                           closedir($dirhandle);
                       }
                   }
               } else {
                   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'}) {
                       if ($subdir eq '') {
                           my $line='';
                           if ($fname =~ /\.db$/) {
                               if (unlink($fname)) {
                                   $cleaned++;
                               } elsif (ref($errors->{file}) eq 'ARRAY') {
                                   push(@{$errors->{file}},$fname);
                               }
                           } elsif (open(PROBE,$fname)) {
                               my $line='';
                               $line=<PROBE>;
                               close(PROBE);
                               if ($line=~/^CHECKOUTTOKEN\&/) {
                                   if ($since>365*$perlvar{'lonExpire'}) {
                                       if (unlink($fname)) {
                                           $cleaned++; 
                                       } elsif (ref($errors->{file}) eq 'ARRAY') {
                                           push(@{$errors->{file}},$fname);
                                       }
                                   } else {
                                       $old++;
                                   }
                               } else {
                                   if (unlink($fname)) {
                                       $cleaned++;
                                   } elsif (ref($errors->{file}) eq 'ARRAY') {
                                       push(@{$errors->{file}},$fname);
                                   }
                               }
                           } elsif (ref($errors->{failopen}) eq 'ARRAY') {
                               push(@{$errors->{failopen}},$fname); 
                           }
                       } else {
                           if (unlink($fname)) {
                               $cleaned++;
                           } elsif (ref($errors->{file}) eq 'ARRAY') {
                               push(@{$errors->{file}},$fname);
                           }
                       }
                   }
               }
           }
           closedir($dh);
       } elsif (ref($errors->{failopen}) eq 'ARRAY') {
           push(@{$errors->{failopen}},$path);
       }
       return ($cleaned,$old,$removed);
   }
   
 # ------------------------------------------------------------ clean out lonIDs  # ------------------------------------------------------------ clean out lonIDs
     print $fh '<hr><a name="tokens"><h2>Session Tokens</h2>';  sub clean_lonIDs {
     $cleaned=0;      my ($fh)=@_;
     $active=0;      &log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>');
     while ($fname=<$perlvar{'lonIDsDir'}/*>) {      my $cleaned=0;
       my $active=0;
       while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
  my ($dev,$ino,$mode,$nlink,   my ($dev,$ino,$mode,$nlink,
     $uid,$gid,$rdev,$size,      $uid,$gid,$rdev,$size,
     $atime,$mtime,$ctime,      $atime,$mtime,$ctime,
     $blksize,$blocks)=stat($fname);      $blksize,$blocks)=stat($fname);
  $now=time;   my $now=time;
  $since=$now-$mtime;   my $since=$now-$mtime;
  if ($since>$perlvar{'lonExpire'}) {   if ($since>$perlvar{'lonExpire'}) {
     $cleaned++;      $cleaned++;
     print $fh "Unlinking $fname<br>";      &log($fh,"Unlinking $fname<br>");
     unlink("$fname");      unlink("$fname");
  } else {   } else {
     $active++;      $active++;
  }   }
   
     }      }
     print $fh "<p>Cleaned up ".$cleaned." stale session token(s).";      &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
     print $fh "<h3>$active open session(s)</h3>";      &log($fh,"<h3>$active open session(s)</h3>");
   }
 # ----------------------------------------------------------------------- httpd  
   
     print $fh '<hr><a name="httpd"><h2>httpd</h2><h3>Access Log</h3><pre>';  # ----------------------------------------------------------- clean out sockets
       sub clean_sockets {
     open (DFH,"tail -n25 /etc/httpd/logs/access_log|");      my ($fh)=@_;
     while ($line=<DFH>) { print $fh "$line" };      my $cleaned=0;
     close (DFH);      opendir(SOCKETS,$perlvar{'lonSockDir'});
       while (my $fname=readdir(SOCKETS)) {
    next if (-d $fname 
    || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
    $cleaned++;
    &log($fh,"Unlinking $fname<br />");
    unlink("/home/httpd/sockets/$fname");
       }
       &log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>");
   }
   
     print $fh "</pre><h3>Error Log</h3><pre>";  
   
     open (DFH,"tail -n25 /etc/httpd/logs/error_log|");  # ----------------------------------------------------------------------- httpd
     while ($line=<DFH>) {   sub check_httpd_logs {
  print $fh "$line";      my ($fh)=@_;
  if ($line=~/\[error\]/) { $notices++; }       if (open(PIPE,"./lchttpdlogs|")) {
     };          while (my $line=<PIPE>) {
     close (DFH);              &log($fh,$line);
     print $fh "</pre>";              if ($line=~/\[error\]/) { $notices++; }
           }
           close(PIPE);
       }
     &errout($fh);      &errout($fh);
   }
   
 # ---------------------------------------------------------------------- lonsql  
   
     &checkon_daemon($fh,'lonsql',200000);  
   
 # ------------------------------------------------------------------------ lond  
   
     &checkon_daemon($fh,'lond',40000,1);  
   
 # ------------------------------------------------------------------------ lonc  
   
     &checkon_daemon($fh,'lonc',40000,1);  
   
 # -------------------------------------------------------------------- lonhttpd  
   
     &checkon_daemon($fh,'lonhttpd',40000);  
   
 # ---------------------------------------------------------------------- lonnet  # ---------------------------------------------------------------------- lonnet
   
     print $fh '<hr><a name="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>';  sub rotate_lonnet_logs {
       my ($fh)=@_;
       &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 ($line=<DFH>) {    while (my $line=<DFH>) { 
     print $fh "$line";      &log($fh,&encode_entities($line,'<>&"'));
  };   }
  close (DFH);   close (DFH);
     }      }
     print $fh "</pre><h3>Perm Log</h3><pre>";      &log($fh,"</pre><h3>Perm Log</h3><pre>");
           
     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 ($line=<DFH>) {    while (my $line=<DFH>) { 
     print $fh "$line";      &log($fh,&encode_entities($line,'<>&"'));
  };   }
  close (DFH);   close (DFH);
     } else { print $fh "No perm log\n" }      } else { &log($fh,"No perm log\n") }
   
     $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";      my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
       &rotate_logfile($fname,$fh,'lonnet log');
   
     my ($dev,$ino,$mode,$nlink,      &log($fh,"</pre>");
  $uid,$gid,$rdev,$size,      &errout($fh);
  $atime,$mtime,$ctime,  }
  $blksize,$blocks)=stat($fname);  
   
     if ($size>40000) {  sub rotate_other_logs {
  print $fh "Rotating logs ...<p>";      my ($fh) = @_;
  rename("$fname.2","$fname.3");      my %logs = (
  rename("$fname.1","$fname.2");                    autoenroll          => 'Auto Enroll log',
  rename("$fname","$fname.1");                    autocreate          => 'Create Course log',
                     searchcat           => 'Search Cataloguing log',
                     autoupdate          => 'Auto Update log',
                     refreshcourseids_db => 'Refresh CourseIDs db log',
                  );
       foreach my $item (keys(%logs)) {
           my $fname=$perlvar{'lonDaemons'}.'/logs/'.$item.'.log';
           &rotate_logfile($fname,$fh,$logs{$item});
     }      }
   }
   
     print $fh "</pre>";  
     &errout($fh);  
 # ----------------------------------------------------------------- Connections  # ----------------------------------------------------------------- Connections
   sub test_connections {
     print $fh '<hr><a name="connections"><h2>Connections</h2>';      my ($fh)=@_;
       &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
     print "testing connections\n";      print "testing connections\n";
     print $fh "<table border=2>";      &log($fh,"<table border='2'>");
     foreach $tryserver (sort(keys(%hostname))) {      my ($good,$bad)=(0,0);
       my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $tryserver (sort(keys(%hostname))) {
  print(".");   print(".");
  $answer=reply("pong",$tryserver);   my $result;
    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"); }
  print $fh "<tr><td>$tryserver</td><td>$result</td></tr>\n";   &log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n");
   
     }      }
     print $fh "</table>";      &log($fh,"</table>");
       print "\n$good good, $bad bad connections\n";
     &errout($fh);      &errout($fh);
 # ------------------------------------------------------------ Delayed messages  }
   
   
     print $fh '<hr><a name="delayed"><h2>Delayed Messages</h2>';  # ------------------------------------------------------------ Delayed messages
   sub check_delayed_msg {
       my ($fh)=@_;
       &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>');
   
     print $fh '<h3>Scanning Permanent Log</h3>';      my $unsend=0;
   
     $unsend=0;      my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
     {      while (my $line=<$dfh>) {
  my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");   my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
  while ($line=<$dfh>) {   if ($sdf eq 'F') { 
     ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);      my $local=localtime($time);
     if ($sdf eq 'F') {       &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br>");
  $local=localtime($time);      $warnings++;
  print $fh "<b>Failed: $time, $dserv, $dcmd</b><br>";  
  $warnings++;  
     }  
     if ($sdf eq 'S') { $unsend--; }  
     if ($sdf eq 'D') { $unsend++; }  
  }   }
    if ($sdf eq 'S') { $unsend--; }
    if ($sdf eq 'D') { $unsend++; }
     }      }
     print $fh "Total unsend messages: <b>$unsend</b><p>\n";  
     $warnings=$warnings+5*$unsend;  
   
     if ($unsend) { $simplestatus{'unsend'}=$unsend; }      &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
     print $fh "<h3>Outgoing Buffer</h3>";      if ($unsend > 0) {
           $warnings=$warnings+5*$unsend;
       }
   
       if ($unsend) { $simplestatus{'unsend'}=$unsend; }
       &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 ($line=<DFH>) {       while (my $line=<DFH>) {
  print $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);
       my %hostname = &Apache::lonnet::all_hostnames();
       my $numhosts = scalar(keys(%hostname));
   # pong to all servers that have delayed messages
   # this will trigger a reverse connection, which should flush the buffers
       foreach my $tryserver (sort(keys(%servers))) {
           if ($hostname{$tryserver} || !$numhosts) {
               my $answer;
               eval {
                   local $SIG{ ALRM } = sub { die "TIMEOUT" };
                   alarm(20);
                   $answer = &Apache::lonnet::reply("pong",$tryserver);
                   alarm(0);
               };
               if ($@ && $@ =~ m/TIMEOUT/) {
                   &log($fh,"Attempted pong to $tryserver timed out<br />");
                   print "time out while contacting: $tryserver for pong\n";
               } else {
                   &log($fh,"Pong to $tryserver: $answer<br />");
               }
           } else {
               &log($fh,"$tryserver has delayed messages, but is not part of the cluster -- skipping 'Pong'.<br />");
           }
       }
   }
   
 # ------------------------------------------------------------------------- End  sub finish_logging {
     print $fh "<a name=errcount>\n";      my ($fh)=@_;
       &log($fh,"<a name='errcount' />\n");
     $totalcount=$notices+4*$warnings+100*$errors;      $totalcount=$notices+4*$warnings+100*$errors;
     &errout($fh);      &errout($fh);
     print $fh "<h1>Total Error Count: $totalcount</h1>";      &log($fh,"<h1>Total Error Count: $totalcount</h1>");
     $now=time;      my $now=time;
     $date=localtime($now);      my $date=localtime($now);
     print $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();
   
       if ($errors) { $simplestatus{'errors'}=$errors; }
       if ($warnings) { $simplestatus{'warnings'}=$warnings; }
       if ($notices) { $simplestatus{'notices'}=$notices; }
       $simplestatus{'time'}=time;
 }  }
 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");  sub log_simplestatus {
 {      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) {
  print $sfh $_.'='.$simplestatus{$_}.'&';   print $sfh $_.'='.$simplestatus{$_}.'&';
Line 569  rename ("$statusdir/newstatus.html","$st Line 692  rename ("$statusdir/newstatus.html","$st
     print $sfh "\n";      print $sfh "\n";
     $sfh->close();      $sfh->close();
 }  }
 if ($totalcount>200) {  
   sub write_loncaparevs {
       print "Retrieving LON-CAPA version information\n";
       if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
           my %hostname = &Apache::lonnet::all_hostnames();
           foreach my $id (sort(keys(%hostname))) {
               if ($id ne '') {
                   my $loncaparev;
                   eval {
                       local $SIG{ ALRM } = sub { die "TIMEOUT" };
                       alarm(10);
                       $loncaparev =
                           &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
                       alarm(0);
                   };
                   if ($@ && $@ =~ m/TIMEOUT/) {
                       print "time out while contacting lonHost: $id for version\n";   
                   }
                   if ($loncaparev =~ /^[\w.\-]+$/) {
                       print $fh $id.':'.$loncaparev."\n";
                   }
               }
           }
           close($fh);
       }
       return;
   }
   
   sub write_serverhomeIDs {
       print "Retrieving LON-CAPA lonHostID information\n";
       if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
           my %name_to_host = &Apache::lonnet::all_names();
           foreach my $name (sort(keys(%name_to_host))) {
               if ($name ne '') {
                   if (ref($name_to_host{$name}) eq 'ARRAY') {
                       my $serverhomeID;
                       eval {
                           local $SIG{ ALRM } = sub { die "TIMEOUT" };
                           alarm(10);
                           $serverhomeID = 
                               &Apache::lonnet::get_server_homeID($name,1,'loncron');
                           alarm(0);
                       };
                       if ($@ && $@ =~ m/TIMEOUT/) {
                           print "Time out while contacting server: $name\n"; 
                       }
                       if ($serverhomeID ne '') {
                           print $fh $name.':'.$serverhomeID."\n";
                       } else {
                           print $fh $name.':'.$name_to_host{$name}->[0]."\n";
                       }
                   }
               }
           }
           close($fh);
       }
       return;
   }
   
   sub write_checksums {
       my $distro = &get_distro($perlvar{'lonDaemons'});
       if ($distro) {
           print "Retrieving file version and checksumming.\n";
           my $numchksums = 0;
           my ($chksumsref,$versionsref) =
               &LONCAPA::Checksumming::get_checksums($distro,$perlvar{'lonDaemons'},
                                                     $perlvar{'lonLib'},
                                                     $perlvar{'lonIncludes'},
                                                     $perlvar{'lonTabDir'});
           if (ref($chksumsref) eq 'HASH') {
               $numchksums = scalar(keys(%{$chksumsref}));
           }
           print "File version retrieved and checksumming completed for $numchksums files.\n";
       } else {
           print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; 
       }
       return;
   }
   
   sub send_mail {
     print "sending mail\n";      print "sending mail\n";
     $emailto="$perlvar{'lonAdmEMail'}";      my $defdom = $perlvar{'lonDefDomain'};
     if ($totalcount>1000) {      my $origmail = $perlvar{'lonAdmEMail'};
       my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                      'lonstatusmail',$defdom,$origmail);
       if ($totalcount>2500) {
  $emailto.=",$perlvar{'lonSysEMail'}";   $emailto.=",$perlvar{'lonSysEMail'}";
     }      }
     $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");
       }
 }  }
 1;  
   
   sub get_distro {
       my ($dir,$fh) = @_;
       my $distro;
       if (open(my $disth,"$dir/distprobe |")) {
           while (my $line=<$disth>) {
               if ($fh) {
                   &log($fh,&encode_entities($line,'<>&"'));
               }
               $distro .= $line;
           }
           close($disth);
       }
       return $distro;
   }
   
   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
   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
       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
       chdir($perlvar{'lonDaemons'});
   # --------------------------------------- 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;
       }
   
   # -------------------------------------------- Force reload of host information
       &Apache::lonnet::load_hosts_tab(1);
       &Apache::lonnet::load_domain_tab(1);
       &Apache::lonnet::get_iphost(1);
   
   # ----------------------------------------- Force firewall update for lond port  
   
       if ((!$justcheckdaemons) && (!$justreload)) {
           my $now = time;
           my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
                         $now.$$.int(rand(10000));
           if (open(my $fh,">$tmpfile")) {
               my %iphosts = &Apache::lonnet::get_iphost();
               foreach my $key (keys(%iphosts)) {
                   print $fh "$key\n";
               }
               close($fh);
               if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {
                   my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
                   system("$execpath $tmpfile");
                   unlink('/tmp/lock_lciptables');  # Remove the lock file. 
               }
               unlink($tmpfile);
           }
       }
   
   # ---------------------------------------------------------------- Start report
   
       $errors=0;
       $warnings=0;
       $notices=0;
   
   
       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);
           &checkon_daemon($fh,'lonr',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();
           &write_loncaparevs();
           &write_serverhomeIDs();
    &write_checksums();
    if ($totalcount>200 && !$noemail) { &send_mail(); }
       }
   }
   
   &main();
   1;
   
Removed from v.1.43  
changed lines
  Added in v.1.97

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.