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

Diff for /loncom/loncron between versions 1.40 and 1.117

version 1.40, 2003/07/29 21:00:21 version 1.117, 2019/03/17 23:23: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  #
   # $Id$
   #
   # 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/
 #  #
 # (TCP networking package  
 # 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)  
 #  
 # 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 LONCAPA::LWPReq;
   use Apache::lonnet;
   use Apache::loncommon;
   
 use IO::File;  use IO::File;
 use IO::Socket;  use IO::Socket;
   use HTML::Entities;
   use Getopt::Long;
   use GDBM_File;
   use Storable qw(thaw);
   use File::ReadBackwards;
   use File::Copy;
   #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
 }  }
   
 # ================================================================ Main Program  sub rotate_logfile {
       my ($file,$fh,$description) = @_;
 # --------------------------------- Read loncapa_apache.conf and loncapa.conf      my $size=(stat($file))[7];
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');      if ($size>40000) {
 %perlvar=%{$perlvarref};   &log($fh,"<p>Rotating $description ...</p>");
 undef $perlvarref;   rename("$file.2","$file.3");
 delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed   rename("$file.1","$file.2");
 delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed   rename("$file","$file.1");
       } 
 # --------------------------------------- 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'}) {  sub start_daemon {
    print("Unconfigured machine.\n");      my ($fh,$daemon,$pidfile,$args) = @_;
    $emailto=$perlvar{'lonSysEMail'};      my $progname=$daemon;
    $hostname=`/bin/hostname`;      if ($daemon eq 'lonc') {
    chop $hostname;   $progname='loncnew'; 
    $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell      }
    $subj="LON: Unconfigured machine $hostname";      my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
    system("echo 'Unconfigured machine $hostname.' |\      &rotate_logfile($error_fname,$fh,'error logs');
  mailto $emailto -s '$subj' > /dev/null");      if ($daemon eq 'lonc') {
     exit 1;   &clean_sockets($fh);
       }
       system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
       sleep 1;
       if (-e $pidfile) {
    &log($fh,"<p>Seems like it started ...</p>");
    my $lfh=IO::File->new("$pidfile");
    my $daemonpid=<$lfh>;
    chomp($daemonpid);
    if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
       return 1;
    } else {
       return 0;
    }
       }
       &log($fh,"<p>Seems like that did not work!</p>");
       $errors++;
       return 0;
 }  }
   
 # ----------------------------- Make sure this process is running from user=www  sub checkon_daemon {
 my $wwwid=getpwnam('www');      my ($fh,$daemon,$maxsize,$send,$args)=@_;
 if ($wwwid!=$<) {  
    print("User ID mismatch.  This program must be run as user 'www'\n");      my $result;
    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";      printf("%-15s ",$daemon);
    system("echo 'User ID mismatch.  loncron must be run as user www.' |\      if ($fh) {
  mailto $emailto -s '$subj' > /dev/null");          if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
    exit 1;      if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
 }          while (my $line=<DFH>) { 
               &log($fh,"$line");
 # ------------------------------------------------------------- Read hosts file              if ($line=~/INFO/) { $notices++; }
 {              if ($line=~/WARNING/) { $notices++; }
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");              if ($line=~/CRITICAL/) { $warnings++; }
           }
     while (my $configline=<$config>) {          close (DFH);
  my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);              }
  if ($id && $domain && $role && $name && $ip) {          }
     $hostname{$id}=$name;          &log($fh,"</tt></p>");
     $hostdom{$id}=$domain;      }
     $hostip{$id}=$ip;      
     $hostrole{$id}=$role;      my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
     if ($domdescr) { $domaindescription{$domain}=$domdescr; }      
     if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {      my $restartflag=1;
  $libserv{$id}=$name;      my $daemonpid;
       if (-e $pidfile) {
    my $lfh=IO::File->new("$pidfile");
    $daemonpid=<$lfh>;
    chomp($daemonpid);
    if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
       &log($fh,"<h3>$daemon at pid $daemonpid responding");
       if ($send) { &log($fh,", sending $send"); }
       &log($fh,"</h3>");
       if ($send eq 'USR1') { kill USR1 => $daemonpid; }
       if ($send eq 'USR2') { kill USR2 => $daemonpid; }
       $restartflag=0;
       if ($send eq 'USR2') {
    $result = 'reloaded';
    print "reloaded\n";
       } else {
    $result = 'running';
    print "running\n";
     }      }
  } else {   } else {
     if ($configline) {      $errors++;
 # &logthis("Skipping hosts.tab line -$configline-");      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
       $restartflag=1;
       &log($fh,"<h3>Decided to clean up stale .pid file and restart $daemon</h3>");
    }
       }
       if ($restartflag==1) {
    $simplestatus{$daemon}='off';
    $errors++;
    my $kadaemon=$daemon;
    if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
    &log($fh,'<br /><font color="red">Killall '.$daemon.': '.
       `killall $kadaemon 2>&1`.' - ');
    sleep 1;
    &log($fh,unlink($pidfile).' - '.
       `killall -9 $kadaemon 2>&1`.
       '</font><br />');
           if ($kadaemon eq 'loncnew') {
               &clean_lonc_childpids();
           }
    &log($fh,"<h3>$daemon not running, trying to start</h3>");
   
    if (&start_daemon($fh,$daemon,$pidfile,$args)) {
       &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
       $simplestatus{$daemon}='restarted';
       $result = 'started';
       print "started\n";
    } else {
       $errors++;
       &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
       &log($fh,"<p>Give it one more try ...</p>");
       print " ";
       if (&start_daemon($fh,$daemon,$pidfile,$args)) {
    &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
    $simplestatus{$daemon}='restarted';
    $result = 'started';
    print "started\n";
       } else {
    $result = 'failed';
    print " failed\n";
    $simplestatus{$daemon}='failed';
    $errors++; $errors++;
    &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
    &log($fh,"<p>Unable to start $daemon</p>");
     }      }
  }   }
           if ($fh) {
       if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
           &log($fh,"<p><pre>");
           if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
               while (my $line=<DFH>) { 
           &log($fh,"$line");
           if ($line=~/WARNING/) { $notices++; }
           if ($line=~/CRITICAL/) { $notices++; }
               }
               close (DFH);
                   }
           &log($fh,"</pre></p>");
               }
    }
     }      }
       
       my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
       &rotate_logfile($fname,$fh,'logs');
   
       &errout($fh);
       return $result;
 }  }
   
 # ------------------------------------------------------ Read spare server file  # --------------------------------------------------------------------- Machine
 {  sub log_machine_info {
     my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");      my ($fh)=@_;
       &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
     while (my $configline=<$config>) {      &log($fh,"<h3>loadavg</h3>");
        chomp($configline);  
        if (($configline) && ($configline ne $perlvar{'lonHostID'})) {      open (LOADAVGH,"/proc/loadavg");
           $spareid{$configline}=1;      my $loadavg=<LOADAVGH>;
        }      close (LOADAVGH);
       
       &log($fh,"<tt>$loadavg</tt>");
       
       my @parts=split(/\s+/,$loadavg);
       if ($parts[1]>4.0) {
    $errors++;
       } elsif ($parts[1]>2.0) {
    $warnings++;
       } elsif ($parts[1]>1.0) {
    $notices++;
     }      }
 }  
   
 # ---------------------------------------------------------------- Start report      &log($fh,"<h3>df</h3>");
       &log($fh,"<pre>");
   
 $statusdir="/home/httpd/html/lon-status";      open (DFH,"df|");
       while (my $line=<DFH>) { 
    &log($fh,&encode_entities($line,'<>&"')); 
    @parts=split(/\s+/,$line);
    my $usage=$parts[4];
    $usage=~s/\W//g;
    if ($usage>90) { 
       $warnings++;
       $notices++; 
    } elsif ($usage>80) {
       $warnings++;
    } elsif ($usage>60) {
       $notices++;
    }
    if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
       }
       close (DFH);
       &log($fh,"</pre>");
   
 $errors=0;  
 $warnings=0;  
 $notices=0;  
   
 $now=time;      &log($fh,"<h3>ps</h3>");
 $date=localtime($now);      &log($fh,"<pre>");
       my $psproc=0;
   
       open (PSH,"ps aux --cols 140 |");
       while (my $line=<PSH>) { 
    &log($fh,&encode_entities($line,'<>&"')); 
    $psproc++;
       }
       close (PSH);
       &log($fh,"</pre>");
   
       if ($psproc>200) { $notices++; }
       if ($psproc>250) { $notices++; }
   
       &log($fh,"<h3>distprobe</h3>");
       &log($fh,"<pre>");
       &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
       &log($fh,"</pre>");
   
       &errout($fh);
   }
   
 {  sub start_logging {
 my $fh=IO::File->new(">$statusdir/newstatus.html");      my $fh=IO::File->new(">$statusdir/newstatus.html");
       my %simplestatus=();
       my $now=time;
       my $date=localtime($now);
       
   
 print $fh (<<ENDHEADERS);      &log($fh,(<<ENDHEADERS));
 <html>  <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
   <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 <head>  <head>
 <title>LON Status Report $perlvar{'lonHostID'}</title>  <title>LON Status Report $perlvar{'lonHostID'}</title>
   <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 </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="#webdav">WebDAV Session Tokens</a></li>
 <li><a href="#lonsql">lonsql</a>  <li><a href="#httpd">httpd</a></li>
 <li><a href="#lond">lond</a>  <li><a href="#lonsql">lonsql</a></li>
 <li><a href="#lonc">lonc</a>  <li><a href="#lond">lond</a></li>
 <li><a href="#lonhttpd">lonhttpd</a>  <li><a href="#lonc">lonc</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       my %hostname = &Apache::lonnet::all_hostnames();
  "<tr><td>$id</td><td>$hostdom{$id}</td><td>$hostrole{$id}</td>";      foreach my $id (sort(keys(%hostname))) {
     print $fh "<td>$hostname{$id}</td><td>$hostip{$id}</td></tr>\n";   my $role = (&Apache::lonnet::is_library($id) ? 'library'
 }                                       : 'access');
 print $fh "</table><h3>Spare Hosts</h3><ol>";   &log($fh,
 foreach $id (sort(keys(%spareid))) {      "<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id).
     print $fh "<li>$id\n";      "</td><td>".$role.
       "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
       }
       &log($fh,"</table><h3>Spare Hosts</h3>");
       if (keys(%Apache::lonnet::spareid) > 0) {
           &log($fh,"<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");
           }
           &log($fh,"</ul>\n");
       } else {
           &log($fh,"No spare hosts specified<br />\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,$old,$removed) = (0,0,0);
 print $fh "<h3>loadavg</h3>";      my %errors = (
                        dir       => [],
 open (LOADAVGH,"/proc/loadavg");                       file      => [],
 $loadavg=<LOADAVGH>;                       failopen  => [],
 close (LOADAVGH);                   );
       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 />');
               }
           }
       }
   }
   
 print $fh "<tt>$loadavg</tt>";  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);
   }
   
 @parts=split(/\s+/,$loadavg);  # ------------------------------------------------------------ clean out lonIDs
 if ($parts[1]>4.0) {  sub clean_lonIDs {
     $errors++;      my ($fh)=@_;
 } elsif ($parts[1]>2.0) {      &log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>');
     $warnings++;      my $cleaned=0;
 } elsif ($parts[1]>1.0) {      my $active=0;
     $notices++;      while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
 }   my ($dev,$ino,$mode,$nlink,
       $uid,$gid,$rdev,$size,
 print $fh "<h3>df</h3>";      $atime,$mtime,$ctime,
 print $fh "<pre>";      $blksize,$blocks)=stat($fname);
    my $now=time;
 open (DFH,"df|");   my $since=$now-$mtime;
 while ($line=<DFH>) {    if ($since>$perlvar{'lonExpire'}) {
    print $fh "$line";       $cleaned++;
    @parts=split(/\s+/,$line);      &log($fh,"Unlinking $fname<br />");
    $usage=$parts[4];      unlink("$fname");
    $usage=~s/\W//g;   } else {
    if ($usage>90) {       $active++;
       $warnings++;   }
       $notices++;       }
    } elsif ($usage>80) {      &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
       $warnings++;      &log($fh,"<h3>$active open session(s)</h3>");
    } elsif ($usage>60) {  
       $notices++;  
    }  
    if ($usage>95) { $warnings++; $warnings++ }  
 }  
 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 balanceIDs
 if ($psproc>250) { $notices++; }  
   
 &errout($fh);  sub clean_balanceIDs {
       my ($fh)=@_;
       &log($fh,'<hr /><a name="balcookies" /><h2>Session Tokens</h2>');
       my $cleaned=0;
       my $active=0;
       if (-d $perlvar{'lonBalanceDir'}) {
           while (my $fname=<$perlvar{'balanceDir'}/*.id>) {
               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 balancer files</p>");
       &log($fh,"<h3>$active unexpired balancer files</h3>");
   }
   
 # --------------------------------------------------------------- clean out tmp  # ------------------------------------------------ clean out webDAV Session IDs
 print $fh '<hr><a name="tmp"><h2>Temporary Files</h2>';  sub clean_webDAV_sessionIDs {
 $cleaned=0;      my ($fh)=@_;
 $old=0;      if ($perlvar{'lonRole'} eq 'library') {
 while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) {          &log($fh,'<hr /><a name="webdav" /><h2>WebDAV Session Tokens</h2>');
                           my ($dev,$ino,$mode,$nlink,          my $cleaned=0;
                               $uid,$gid,$rdev,$size,          my $active=0;
                               $atime,$mtime,$ctime,          my $now = time;
                               $blksize,$blocks)=stat($fname);          if (-d $perlvar{'lonDAVsessDir'}) {
                           $now=time;              while (my $fname=<$perlvar{'lonDAVsessDir'}/*>) {
                           $since=$now-$mtime;                  my @stats = stat($fname);
                           if ($since>$perlvar{'lonExpire'}) {                  my $since=$now-$stats[9];
                               $line='';                  if ($since>$perlvar{'lonExpire'}) {
                               if (open(PROBE,$fname)) {                      $cleaned++;
   $line=<PROBE>;                      &log($fh,"Unlinking $fname<br />");
                                   close(PROBE);                      unlink("$fname");
       }                  } else {
       unless ($line=~/^CHECKOUTTOKEN\&/) {                      $active++;
                                  $cleaned++;                  }
                                  unlink("$fname");              }
       } else {              &log($fh,"<p>Cleaned up ".$cleaned." stale webDAV session token(s).</p>");
   if ($since>365*$perlvar{'lonExpire'}) {              &log($fh,"<h3>$active open webDAV session(s)</h3>");
                                      $cleaned++;          }
                                      unlink("$fname");      }
  } else { $old++; }  
                               }  
                           }  
       
 }  }
 print $fh "Cleaned up ".$cleaned." files (".$old." old checkout tokens).";  
   
 # ------------------------------------------------------------ clean out lonIDs  # ----------------------------------------------------------- clean out sockets
 print $fh '<hr><a name="tokens"><h2>Session Tokens</h2>';  sub clean_sockets {
 $cleaned=0;      my ($fh)=@_;
 $active=0;      my $cleaned=0;
 while ($fname=<$perlvar{'lonIDsDir'}/*>) {      opendir(SOCKETS,$perlvar{'lonSockDir'});
                           my ($dev,$ino,$mode,$nlink,      while (my $fname=readdir(SOCKETS)) {
                               $uid,$gid,$rdev,$size,   next if (-d $fname 
                               $atime,$mtime,$ctime,   || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
                               $blksize,$blocks)=stat($fname);   $cleaned++;
                           $now=time;   &log($fh,"Unlinking $fname<br />");
                           $since=$now-$mtime;   unlink("/home/httpd/sockets/$fname");
                           if ($since>$perlvar{'lonExpire'}) {      }
                               $cleaned++;      &log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>");
                               print $fh "Unlinking $fname<br>";  
                               unlink("$fname");  
                           } else {  
                               $active++;  
                           }  
       
 }  }
 print $fh "<p>Cleaned up ".$cleaned." stale session token(s).";  
 print $fh "<h3>$active open session(s)</h3>";  
   
 # ----------------------------------------------------------------------- httpd  # ----------------------------------------------------------------------- httpd
   sub check_httpd_logs {
       my ($fh)=@_;
       if (open(PIPE,"./lchttpdlogs|")) {
           while (my $line=<PIPE>) {
               &log($fh,$line);
               if ($line=~/\[error\]/) { $notices++; }
           }
           close(PIPE);
       }
       &errout($fh);
   }
   
 print $fh '<hr><a name="httpd"><h2>httpd</h2><h3>Access Log</h3><pre>';  # ---------------------------------------------------------------------- lonnet
   
 open (DFH,"tail -n25 /etc/httpd/logs/access_log|");  sub rotate_lonnet_logs {
 while ($line=<DFH>) { print $fh "$line" };      my ($fh)=@_;
 close (DFH);      &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
       print "Checking logs.\n";
 print $fh "</pre><h3>Error Log</h3><pre>";      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
    open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
 open (DFH,"tail -n25 /etc/httpd/logs/error_log|");   while (my $line=<DFH>) { 
 while ($line=<DFH>) {       &log($fh,&encode_entities($line,'<>&"'));
    print $fh "$line";   }
    if ($line=~/\[error\]/) { $notices++; }   
 };  
 close (DFH);  
 print $fh "</pre>";  
 &errout($fh);  
   
   
 # ---------------------------------------------------------------------- lonsql  
   
 my $restartflag=1;  
     print $fh '<hr><a name="lonsql"><h2>lonsql</h2><h3>Log</h3><pre>';  
     print "lonsql\n";  
     if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){  
  open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|");  
  while ($line=<DFH>) {   
     print $fh "$line";  
     if ($line=~/INFO/) { $notices++; }  
     if ($line=~/WARNING/) { $notices++; }  
     if ($line=~/CRITICAL/) { $warnings++; }  
  };  
  close (DFH);   close (DFH);
     }      }
     print $fh "</pre>";      &log($fh,"</pre><h3>Perm Log</h3><pre>");
           
     my $lonsqlfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
     open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
     $restartflag=1;   while (my $line=<DFH>) { 
          &log($fh,&encode_entities($line,'<>&"'));
     if (-e $lonsqlfile) {  
  my $lfh=IO::File->new("$lonsqlfile");  
  my $lonsqlpid=<$lfh>;  
  chomp($lonsqlpid);  
  if (kill 0 => $lonsqlpid) {  
     print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>";  
     $restartflag=0;  
  } else {  
     $errors++; $errors++;  
     print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>";  
  $restartflag=1;  
  print $fh   
     "<h3>Decided to clean up stale .pid file and restart lonsql</h3>";  
  }   }
    close (DFH);
       } else { &log($fh,"No perm log\n") }
   
       my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
       &rotate_logfile($fname,$fh,'lonnet log');
   
       &log($fh,"</pre>");
       &errout($fh);
   }
   
   sub rotate_other_logs {
       my ($fh) = @_;
       my %logs = (
                     autoenroll          => 'Auto Enroll log',
                     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});
     }      }
     if ($restartflag==1) {  }
  $errors++;  
          print $fh '<br><font color="red">Killall lonsql: '.  # ----------------------------------------------------------------- Connections
                     system('killall lonsql').' - ';  sub test_connections {
                     sleep 2;      my ($fh)=@_;
                     print $fh unlink($lonsqlfile).' - '.      &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
                               system('killall -9 lonsql').      print "Testing connections.\n";
                     '</font><br>';      &log($fh,"<table border='2'>");
  print $fh "<h3>lonsql not running, trying to start</h3>";      my ($good,$bad)=(0,0);
  system(      my %hostname = &Apache::lonnet::all_hostnames();
  "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");      foreach my $tryserver (sort(keys(%hostname))) {
  sleep 2;   print(".");
  if (-e $lonsqlfile) {   my $result;
     print $fh "Seems like it started ...<p>";   my $answer=&Apache::lonnet::reply("ping",$tryserver);
     my $lfh=IO::File->new("$lonsqlfile");   if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
     my $lonsqlpid=<$lfh>;      $result="<b>ok</b>";
     chomp($lonsqlpid);      $good++;
     sleep 2;   } else {
     if (kill 0 => $lonsqlpid) {      $result=$answer;
  print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>";      $warnings++;
       if ($answer eq 'con_lost') {
    $bad++;
    $warnings++;
     } else {      } else {
  $errors++; $errors++;   $good++; #self connection
  print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>";  
  print $fh "Give it one more try ...<p>";  
  system(  
  "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");  
  sleep 2;  
     }      }
  } else {  
     print $fh "Seems like that did not work!<p>";  
     $errors++;  
  }  
  if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){  
     print $fh "<p><pre>";  
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|");  
     while ($line=<DFH>) {   
  print $fh "$line";  
  if ($line=~/WARNING/) { $notices++; }  
  if ($line=~/CRITICAL/) { $notices++; }  
     };  
     close (DFH);  
     print $fh "</pre>";  
  }   }
    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);
   }
   
     $fname="$perlvar{'lonDaemons'}/logs/lonsql.log";  
   
     my ($dev,$ino,$mode,$nlink,  # ------------------------------------------------------------ Delayed messages
  $uid,$gid,$rdev,$size,  sub check_delayed_msg {
  $atime,$mtime,$ctime,      my ($fh,$weightsref,$exclusionsref)=@_;
  $blksize,$blocks)=stat($fname);      &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
       print "Checking buffers.\n";
     if ($size>200000) {      
  print $fh "Rotating logs ...<p>";      &log($fh,'<h3>Scanning Permanent Log</h3>');
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &errout($fh);      my $unsend=0;
 # ------------------------------------------------------------------------ lond      my $ignored=0;
   
 print $fh '<hr><a name="lond"><h2>lond</h2><h3>Log</h3><pre>';      my %hostname = &Apache::lonnet::all_hostnames();
 print "lond\n";      my $numhosts = scalar(keys(%hostname));
       my $checkbackwards = 0;
       my $checkfrom = 0;
       my $checkexcluded = 0;
       my (%bymachine,%weights,%exclusions,%serverhomes);
       if (ref($weightsref) eq 'HASH') {
           %weights = %{$weightsref};
       }
       if (ref($exclusionsref) eq 'HASH') {
           %exclusions = %{$exclusionsref};
           if (keys(%exclusions)) {
               $checkexcluded = 1;
               %serverhomes = &read_serverhomeIDs();
           }
       }
   
 if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){  #
 open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lond.log|");  # For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any
 while ($line=<DFH>) {   # entry logged in lonnet.perm.log for completion of a delayed (critical)
    print $fh "$line";  # transaction lacked the hostID for the remote node to which the command
    if ($line=~/INFO/) { $notices++; }  # to be completed was sent.
    if ($line=~/WARNING/) { $notices++; }  #
    if ($line=~/CRITICAL/) { $warnings++; }  # Because of this, exclusion of items in lonnet.perm.log for nodes which are
 };  # no longer part of the cluster from adding to the overall "unsend" count
 close (DFH);  # needs additional effort besides the changes made in loncron rev. 1.105.
 }  #
 print $fh "</pre>";  # For "S" (completion) events logging in LON-CAPA 1.2.0 through 2.1.3 included
   # "LondTransaction=HASH(hexadecimal)->getClient() :$cmd, where the hexadecimal
 my $londfile="$perlvar{'lonDaemons'}/logs/lond.pid";  # is a memory location, and $cmd is the command sent to the remote node.
   #
 $restartflag=1;  # Starting with 2.2.0 (released 8/21/2006) logging for "S" (completion) events
 if (-e $londfile) {      # had sethost:$host_id:$cmd after LondTransaction=HASH(hexadecimal)->getClient()
    my $lfh=IO::File->new("$londfile");  #
    my $londpid=<$lfh>;  # Starting with 2.4.1 (released 6/13/2007) logging for "S" replaced echoing the
    chomp($londpid);  # getClient() call with the result of the Transaction->getClient() call itself
    if (kill 0 => $londpid) {  # undef for completion of delivery of a delayed message.
       print $fh "<h3>lond at pid $londpid responding, sending USR1</h3>";  #
       kill USR1 => $londpid;  # The net effect of these changes is that lonnet.perm.log is now accessed three
       $restartflag=0;  # times: (a) oldest record is checked, if earlier than release date for 2.5.0
    } else {  # then (b) file is read backwards, with timestamp recorded for most recent
       $errors++;  # instance of logged "S" event for "update" command without "sethost:$host_id:"
       print $fh "<h3>lond at pid $londpid not responding</h3>";  # then (c) file is read forward with records ignored which predate the timestamp
       $restartflag=1;  # recorded in (b), if one was found.
       print $fh   #
   "<h3>Decided to clean up stale .pid file and restart lond</h3>";  # In (c), when calculating the unsend total, i.e., the difference between delayed
    }  # transactions ("D") and sent transactions ("S"), transactions are ignored if the
 }   # target node is no longer in the cluster, and also (for "update" commands), if
 if ($restartflag==1) {  # the target node is in the list of nodes excluded from the count, in the domain
    $errors++;  # configuration for this machine's default domain.  The idea here is to remove
   print $fh '<br><font color="red">Killall lond: '.  # delayed "update" commands for nodes for which inbound access to port 5663,
                     system('killall lond').' - ';  # is blocked, but are still part of the LON-CAPA network, (i.e., they can still
           sleep 2;  # replicate content from other nodes).
           print $fh unlink($londfile).' - '.system('killall -9 lond').  #
                     '</font><br>';  
    print $fh "<h3>lond not running, trying to start</h3>";      my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r");
    system(      if (defined($dfh)) {
      "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors");          while (my $line=<$dfh>) {
    sleep 2;              my ($time,$sdf,$rest)=split(/:/,$line,3);
    if (-e $londfile) {              if ($time < 1541185772) {
        print $fh "Seems like it started ...<p>";                  $checkbackwards = 1;
        my $lfh=IO::File->new("$londfile");              }
        my $londpid=<$lfh>;              last;
        chomp($londpid);          }
        sleep 2;          undef $dfh;
        if (kill 0 => $londpid) {      } 
           print $fh "<h3>lond at pid $londpid responding</h3>";  
        } else {  
           $errors++; $errors++;  
           print $fh "<h3>lond at pid $londpid not responding</h3>";  
           print $fh "Give it one more try ...<p>";  
   system(  
  "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors");  
           sleep 2;  
        }  
    } else {  
        print $fh "Seems like that did not work!<p>";  
        $errors++;  
    }  
    if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){  
     print $fh "<p><pre>";  
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lond.log|");  
     while ($line=<DFH>) {   
       print $fh "$line";  
       if ($line=~/WARNING/) { $notices++; }  
       if ($line=~/CRITICAL/) { $notices++; }  
     };  
     close (DFH);  
     print $fh "</pre>";  
    }  
 }  
   
 $fname="$perlvar{'lonDaemons'}/logs/lond.log";      if ($checkbackwards) {
           if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
               while(my $line=<BW>) {
                   if ($line =~ /\QLondTransaction=HASH\E[^:]+:update:/) {
                       ($checkfrom) = split(/:/,$line,2);
                       last;
                   }
               }
               close(BW);
           }
       }
       $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r");
       if (defined($dfh)) {
           while (my $line=<$dfh>) {
               my ($time,$sdf,$rest)=split(/:/,$line,3);
               next unless (($sdf eq 'F') || ($sdf eq 'S') || ($sdf eq 'D'));
               next if (($checkfrom) && ($time <= $checkfrom));
               my ($dserv,$dcmd);
               if ($sdf eq 'S') {
                   my ($serva,$cmda,$servb,$cmdb) = split(/:/,$rest);
                   if ($cmda eq 'sethost') {
                       chomp($cmdb);
                       $dcmd = $cmdb;
                   } else {
                       $dcmd = $cmda;
                   }
                   if (($serva =~ /^LondTransaction/) || ($serva eq '')) {
                       unless (($servb eq '') || ($servb =~ m{^/})) {
                           $dserv = $servb;
                       }
                   } else {
                       $dserv = $serva;
                   }
               } else {
                   ($dserv,$dcmd) = split(/:/,$rest);
               }
               if ($sdf eq 'F') {
                   my $local=localtime($time);
                   &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />");
                   $warnings++;
               }
               next if ((($dserv eq '') || ($dcmd eq '')) && ($sdf ne 'F'));
               if ($sdf eq 'S') {
                   if ($dcmd eq 'update') {
                       if ($hostname{$dserv}) {
                           if ($exclusions{$serverhomes{$hostname{$dserv}}}) {
                               $ignored --;
                           } else {
                               $unsend --;
                           }
                       }
                       if (exists($bymachine{$dserv})) {
                           $bymachine{$dserv} --;
                       } else {
                           $bymachine{$dserv} = -1;
                       }
                   } else {
                       if ($hostname{$dserv}) {
                           $unsend --;
                       }
                   }
               } elsif ($sdf eq 'D') {
                   if ($dcmd eq 'update') {
                       if ($hostname{$dserv}) {
                           if ($exclusions{$serverhomes{$hostname{$dserv}}}) {
                               $ignored ++;
                           } else {
                               $unsend ++;
                           }
                       }
                       if (exists($bymachine{$dserv})) {
                           $bymachine{$dserv} ++;
                       } else {
                           $bymachine{$dserv} = 1;
                       }
                   } else {
                       if ($hostname{$dserv}) {
                           $unsend ++;
                       }
                   }
               }
           }
           undef $dfh;
           my $nodest = 0;
           my $retired = 0;
           my %active;
           if (keys(%bymachine)) {
               unless ($checkexcluded) {
                   %serverhomes = &read_serverhomeIDs();
               }
               foreach my $key (keys(%bymachine)) {
                   if ($bymachine{$key} > 0) {
                       if ($hostname{$key}) {
                           $active{$serverhomes{$hostname{$key}}} += $bymachine{$key};
                       } else {
                           $retired ++;
                           $nodest += $bymachine{$key};
                       }
                   }
               }
           }
           if (keys(%active)) {
               &log($fh,"<p>Unsend messages by node, active (undegraded) nodes in cluster</p>\n");
               foreach my $key (sort(keys(%active))) {
                   &log($fh,&encode_entities("$key => $active{$key}",'<>&"')."\n");
               }
           }
           &log($fh,"<p>Total unsend messages: <b>$unsend</b> for ".scalar(keys(%active))." active (undegraded) nodes in cluster.</p>\n");
           if (keys(%exclusions) > 0) {
               &log($fh,"<p>Total incomplete updates <b>$ignored</b> for ".scalar(keys(%exclusions))." degraded nodes in cluster.</p>\n");
           }
           if ($retired) {
               &log($fh,"<p>Total unsent <b>$nodest</b> for $retired nodes no longer in cluster.</p>\n");
           }
           if ($unsend > 0) {
               $warnings=$warnings+$weights{'U'}*$unsend;
           }
       }
   
                           my ($dev,$ino,$mode,$nlink,      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
                               $uid,$gid,$rdev,$size,      &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");
                               $atime,$mtime,$ctime,  # list directory with delayed messages and remember offline servers
                               $blksize,$blocks)=stat($fname);      my %servers=();
       open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
 if ($size>40000) {      while (my $line=<DFH>) {
     print $fh "Rotating logs ...<p>";          my ($server)=($line=~/\.(\w+)$/);
     rename("$fname.2","$fname.3");          if ($server) { $servers{$server}=1; }
     rename("$fname.1","$fname.2");   &log($fh,&encode_entities($line,'<>&"'));
     rename("$fname","$fname.1");      }
 }      &log($fh,"</pre>\n");
   
 &errout($fh);  
 # ------------------------------------------------------------------------ lonc  
   
 print $fh '<hr><a name="lonc"><h2>lonc</h2><h3>Log</h3><pre>';  
 print "lonc\n";  
   
 if (-e "$perlvar{'lonDaemons'}/logs/lonc.log"){  
 open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lonc.log|");  
 while ($line=<DFH>) {   
    print $fh "$line";  
    if ($line=~/INFO/) { $notices++; }  
    if ($line=~/WARNING/) { $notices++; }  
    if ($line=~/CRITICAL/) { $warnings++; }  
 };  
 close (DFH);  
 }  
 print $fh "</pre>";  
   
 my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";  
   
 $restartflag=1;  
 if (-e $loncfile) {  
    my $lfh=IO::File->new("$loncfile");  
    my $loncpid=<$lfh>;  
    chomp($loncpid);  
    if (kill 0 => $loncpid) {  
       print $fh "<h3>lonc at pid $loncpid responding, sending USR1</h3>";  
       kill USR1 => $loncpid;  
       $restartflag=0;  
    } else {  
       $errors++;  
       print $fh "<h3>lonc at pid $loncpid not responding</h3>";  
       # Solution: kill parent and children processes, remove .pid and restart  
   $restartflag=1;  
       print $fh   
   "<h3>Decided to clean up stale .pid file and restart lonc</h3>";  
    }  
 }   
 if ($restartflag==1) {  
    $errors++;  
   print $fh '<br><font color="red">Killall lonc: '.  
             system('killall lonc').' - ';  
           sleep 2;  
           print $fh unlink($loncfile).' - '.system('killall -9 lonc').  
                     '</font><br>';  
    print $fh "<h3>lonc not running, trying to start</h3>";  
  system(  
  "$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors");  
    sleep 2;  
    if (-e $loncfile) {  
        print $fh "Seems like it started ...<p>";  
        my $lfh=IO::File->new("$loncfile");  
        my $loncpid=<$lfh>;  
        chomp($loncpid);  
        sleep 2;  
        if (kill 0 => $loncpid) {  
           print $fh "<h3>lonc at pid $loncpid responding</h3>";  
        } else {  
           $errors++; $errors++;  
           print $fh "<h3>lonc at pid $loncpid not responding</h3>";  
           print $fh "Give it one more try ...<p>";  
    system(  
  "$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors");  
           sleep 2;  
        }  
    } else {  
        print $fh "Seems like that did not work!<p>";  
        $errors++;  
    }  
    if (-e "$perlvar{'lonDaemons'}/logs/lonc.log") {  
     print $fh "<p><pre>";  
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonc.log|");  
     while ($line=<DFH>) {   
       print $fh "$line";  
       if ($line=~/WARNING/) { $notices++; }  
       if ($line=~/CRITICAL/) { $notices++; }  
     };  
     close (DFH);      close (DFH);
     print $fh "</pre>";  # 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 />");
           }
       }
 }  }
   
 $fname="$perlvar{'lonDaemons'}/logs/lonc.log";  sub finish_logging {
       my ($fh,$weightsref)=@_;
                           my ($dev,$ino,$mode,$nlink,      my %weights;
                               $uid,$gid,$rdev,$size,      if (ref($weightsref) eq 'HASH') {
                               $atime,$mtime,$ctime,          %weights = %{$weightsref};
                               $blksize,$blocks)=stat($fname);      }
       &log($fh,"<a name='errcount' />\n");
 if ($size>40000) {      $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors);
     print $fh "Rotating logs ...<p>";      &errout($fh);
     rename("$fname.2","$fname.3");      &log($fh,"<h1>Total Error Count: $totalcount</h1>");
     rename("$fname.1","$fname.2");      my $now=time;
     rename("$fname","$fname.1");      my $date=localtime($now);
 }      &log($fh,"<hr />$date ($now)</body></html>\n");
       print "lon-status webpage updated.\n";
          $fh->close();
 &errout($fh);  
 # -------------------------------------------------------------------- lonhttpd      if ($errors) { $simplestatus{'errors'}=$errors; }
       if ($warnings) { $simplestatus{'warnings'}=$warnings; }
 print $fh '<hr><a name="lonhttpd"><h2>lonhttpd</h2><h3>Log</h3><pre>';      if ($notices) { $simplestatus{'notices'}=$notices; }
 print "lonhttpd\n";      $simplestatus{'time'}=time;
   
 if (-e "$perlvar{'lonDaemons'}/logs/lonhttpd.log"){  
 open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lonhttpd.log|");  
 while ($line=<DFH>) {   
    print $fh "$line";  
    if ($line=~/INFO/) { $notices++; }  
    if ($line=~/WARNING/) { $notices++; }  
    if ($line=~/CRITICAL/) { $warnings++; }  
 };  
 close (DFH);  
 }  
 print $fh "</pre>";  
   
 my $lonhttpdfile="$perlvar{'lonDaemons'}/logs/lonhttpd.pid";  
   
 $restartflag=1;  
 if (-e $lonhttpdfile) {  
    my $lfh=IO::File->new("$lonhttpdfile");  
    my $lonhttpdpid=<$lfh>;  
    chomp($lonhttpdpid);  
    if (kill 0 => $lonhttpdpid) {  
       print $fh "<h3>lonhttpd at pid $lonhttpdpid responding</h3>";  
       $restartflag=0;  
    } else {  
       $errors++;  
       print $fh "<h3>lonhttpd at pid $lonhttpdpid not responding</h3>";  
       # Solution: kill parent and children processes, remove .pid and restart  
   $restartflag=1;  
       print $fh   
   "<h3>Decided to clean up stale .pid file and restart lonhttpd</h3>";  
    }  
 }   
 if ($restartflag==1) {  
    $errors++;  
   print $fh '<br><font color="red">Killall lonhttpd: '.  
             system('killall lonhttpd').' - ';  
           sleep 2;  
           print $fh unlink($lonhttpdfile).' - '.system('killall -9 lonhttpd').  
                     '</font><br>';  
    print $fh "<h3>lonhttpd not running, trying to start</h3>";  
  system(  
  "$perlvar{'lonDaemons'}/lonhttpd 2>>$perlvar{'lonDaemons'}/logs/lonhttpd_errors");  
    sleep 2;  
    if (-e $lonhttpdfile) {  
        print $fh "Seems like it started ...<p>";  
        my $lfh=IO::File->new("$lonhttpdfile");  
        my $lonhttpdpid=<$lfh>;  
        chomp($lonhttpdpid);  
        sleep 2;  
        if (kill 0 => $lonhttpdpid) {  
           print $fh "<h3>lonhttpd at pid $lonhttpdpid responding</h3>";  
        } else {  
           $errors++; $errors++;  
           print $fh "<h3>lonhttpd at pid $lonhttpdpid not responding</h3>";  
           print $fh "Give it one more try ...<p>";  
    system(  
  "$perlvar{'lonDaemons'}/lonhttpd 2>>$perlvar{'lonDaemons'}/logs/lonhttpd_errors");  
           sleep 2;  
        }  
    } else {  
        print $fh "Seems like that did not work!<p>";  
        $errors++;  
    }  
    if (-e "$perlvar{'lonDaemons'}/logs/lonhttpd.log") {  
     print $fh "<p><pre>";  
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonhttpd.log|");  
     while ($line=<DFH>) {   
       print $fh "$line";  
       if ($line=~/WARNING/) { $notices++; }  
       if ($line=~/CRITICAL/) { $notices++; }  
     };  
     close (DFH);  
     print $fh "</pre>";  
    }  
 }  }
   
 $fname="$perlvar{'lonDaemons'}/logs/lonhttpd.log";  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();
   }
   
                           my ($dev,$ino,$mode,$nlink,  sub write_loncaparevs {
                               $uid,$gid,$rdev,$size,      print "Retrieving LON-CAPA version information.\n";
                               $atime,$mtime,$ctime,      my %hostname = &Apache::lonnet::all_hostnames();
                               $blksize,$blocks)=stat($fname);      my $output;
       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.\-]+$/) {
                   $output .= $id.':'.$loncaparev."\n";
               }
           }
       }
       if ($output) {
           if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
               print $fh $output;
               close($fh);
               &Apache::lonnet::load_loncaparevs();
           }
       }
       return;
   }
   
 if ($size>40000) {  sub write_serverhomeIDs {
     print $fh "Rotating logs ...<p>";      print "Retrieving LON-CAPA lonHostID information.\n";
     rename("$fname.2","$fname.3");      my %name_to_host = &Apache::lonnet::all_names();
     rename("$fname.1","$fname.2");      my $output;
     rename("$fname","$fname.1");      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 '') {
                       $output .= $name.':'.$serverhomeID."\n";
                   } else {
                       $output .= $name.':'.$name_to_host{$name}->[0]."\n";
                   }
               }
           }
       }
       if ($output) {
           if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
               print $fh $output;
               close($fh);
               &Apache::lonnet::load_serverhomeIDs();
           }
       }
       return;
 }  }
   
      sub write_checksums {
 &errout($fh);      my $distro = &LONCAPA::distro();
 # ---------------------------------------------------------------------- lonnet      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;
   }
   
 print $fh '<hr><a name="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>';  sub write_hostips {
 print "lonnet\n";      my $lontabdir = $perlvar{'lonTabDir'};
 if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){      my $defdom = $perlvar{'lonDefDomain'};
 open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");      my $lonhost = $perlvar{'lonHostID'};
 while ($line=<DFH>) {       my $newfile = "$lontabdir/currhostips.tab";
     print $fh "$line";      my $oldfile = "$lontabdir/prevhostips.tab";
 };      my (%prevhosts,%currhosts,%ipchange);
 close (DFH);      if ((-e $newfile) && (-s $newfile)) {
 }          move($newfile,$oldfile);
 print $fh "</pre><h3>Perm Log</h3><pre>";          chmod(0644,$oldfile);
           if (open(my $fh,'<',$oldfile)) {
 if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {              while (my $line=<$fh>) {
     open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");                  chomp($line);
 while ($line=<DFH>) {                   if ($line =~ /^([^:]+):([\d.]+)$/) {
    print $fh "$line";                      $prevhosts{$1} = $2;
 };                  }
 close (DFH);              }
 } else { print $fh "No perm log\n" }              close($fh);
           }
 $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";      }
       my ($ip_info,$cached) =
                           my ($dev,$ino,$mode,$nlink,          &Apache::lonnet::is_cached_new('iphost','iphost');
                               $uid,$gid,$rdev,$size,      if (!$cached) {
                               $atime,$mtime,$ctime,          &Apache::lonnet::get_iphost();
                               $blksize,$blocks)=stat($fname);          ($ip_info,$cached) =
           &Apache::lonnet::is_cached_new('iphost','iphost');
 if ($size>40000) {      }
     print $fh "Rotating logs ...<p>";      if (ref($ip_info) eq 'ARRAY') {
     rename("$fname.2","$fname.3");          %currhosts = %{$ip_info->[1]};
     rename("$fname.1","$fname.2");          if (open(my $fh,'>',$newfile)) {
     rename("$fname","$fname.1");              foreach my $key (keys(%currhosts)) {
                   print $fh "$key:$currhosts{$key}\n";
               }
               close($fh);
               chmod(0644,$newfile);
           }
       }
       if (keys(%prevhosts) && keys(%currhosts)) {
           foreach my $key (keys(%prevhosts)) {
               unless ($currhosts{$key} eq $prevhosts{$key}) {
                   $ipchange{$key} = $prevhosts{$key}.'|'.$currhosts{$key};
               }
           }
           foreach my $key (keys(%currhosts)) {
               unless ($currhosts{$key} eq $prevhosts{$key}) {
                   $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};
               }
           }
       }
       if (&Apache::lonnet::domain($defdom,'primary') eq $lonhost) {
           if (keys(%ipchange)) {
               if (open(my $fh,'>>',$perlvar{'lonDaemons'}.'/logs/hostip.log')) {
                  print $fh "********************\n".localtime(time).' Changes --'."\n".
                            "Hostname | Previous IP | New IP\n".
                            "--------------------------------\n";
                  foreach my $hostname (sort(keys(%ipchange))) {
                       print $fh "$hostname | $ipchange{$hostname}\n";
                   }
                   print $fh "\n*******************\n\n";
                   close($fh);
               }
               my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                      'hostipmail',$defdom);
               if ($emailto) {
                   my $subject = "LON-CAPA Hostname to IP change ($perlvar{'lonHostID'})";
                   my $chgmail = "To: $emailto\n".
                                 "Subject: $subject\n".
                                 "Content-type: text/plain\; charset=UTF-8\n".
                                 "MIME-Version: 1.0\n\n".
                                 "Host/IP changes\n".
                                 " \n".
                                 "Hostname | Previous IP | New IP\n".
                                 "--------------------------------\n";
                   foreach my $hostname (sort(keys(%ipchange))) {
                       $chgmail .= "$hostname | $ipchange{$hostname}\n";
                   }
                   $chgmail .= "\n\n";
                   if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
                       print $mailh $chgmail;
                       close($mailh);
                       print "Sending mail notification of hostname/IP changes.\n";
                   }
               }
           }
       }
       return;
 }  }
   
 print $fh "</pre>";  sub clean_nosslverify {
 &errout($fh);      my ($fh) = @_;
 # ----------------------------------------------------------------- Connections      my %unlinked; 
       if (-d "$perlvar{'lonSockDir'}/nosslverify") {
           if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) {
               while (my $fname=readdir($dh)) {
                   next if ($fname =~ /^\.+$/);
                   if (unlink("/home/httpd/sockets/nosslverify/$fname")) {
                       &log($fh,"Unlinking $fname<br />");
                       $unlinked{$fname} = 1;
                   }
               }
               closedir($dh);
           }
       }
       &log($fh,"<p>Removed ".scalar(keys(%unlinked))." nosslverify clients</p>");
       return %unlinked;
   }
   sub clean_lonc_childpids {
       my $childpiddir = "$perlvar{'lonDocRoot'}/lon-status/loncchld";
       if (-d $childpiddir) {
           if (opendir(my $dh,$childpiddir)) {
               while (my $fname=readdir($dh)) {
                   next if ($fname =~ /^\.+$/);
                   unlink("$childpiddir/$fname");
               }
               closedir($dh);
           }
       }
   }
   
 print $fh '<hr><a name="connections"><h2>Connections</h2>';  sub write_connection_config {
       my ($domconf,%connectssl,%changes);
       $domconf = &get_domain_config();
       if (ref($domconf) eq 'HASH') {
           if (ref($domconf->{'ssl'}) eq 'HASH') {
               foreach my $connect ('connto','connfrom') {
                   if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') {
                       my ($sslreq,$sslnoreq,$currsetting);
                       my %contypes;
                       foreach my $type ('dom','intdom','other') {
                           $connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type};
                       }
                   }
               }
           }
           if (keys(%connectssl)) {
               my %currconf; 
               if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
                   while (my $line = <$fh>) {
                       chomp($line);
                       my ($name,$value) = split(/=/,$line);
                       if ($value =~ /^(?:no|yes|req)$/) {
                           if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
                               $currconf{$name} = $value;
                           }
                       }
                   }
                   close($fh);
               }
               if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
                   my $count = 0;
                   foreach my $key (sort(keys(%connectssl))) { 
                       print $fh "$key=$connectssl{$key}\n";
                       if (exists($currconf{$key})) {
                           unless ($currconf{$key} eq $connectssl{$key}) {
                               $changes{$key} = 1;
                           }
                       } else {
                           $changes{$key} = 1;
                       }
                       $count ++;
                   }
                   close($fh);
                   print "Completed writing SSL options for lonc/lond for $count items.\n";
               }
           } else {
               print "Writing of SSL options skipped - no connection rules in domain configuration.\n";
           }
       } else {
           print "Retrieval of SSL options for lonc/lond skipped - no configuration data available for domain.\n";
       }
       return %changes;
   }
   
 print $fh "<table border=2>";  sub get_domain_config {
 foreach $tryserver (sort(keys(%hostname))) {      my ($dom,$primlibserv,$isprimary,$url,%confhash);
       $dom = $perlvar{'lonDefDomain'};
       $primlibserv = &Apache::lonnet::domain($dom,'primary');
       if ($primlibserv eq $perlvar{'lonHostID'}) {
           $isprimary = 1;
       } elsif ($primlibserv ne '') {
           my $protocol = $Apache::lonnet::protocol{$primlibserv};
           my $hostname = &Apache::lonnet::hostname($primlibserv);
           unless ($protocol eq 'https') {
               $protocol = 'http';
           }
           $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl?primary='.$primlibserv.'&format=raw';
       }
       if ($isprimary) {
           my $lonusersdir = $perlvar{'lonUsersDir'};
           my $fname = $lonusersdir.'/'.$dom.'/configuration.db';
           if (-e $fname) {
               my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
               if (ref($dbref) eq 'HASH') {
                   foreach my $key (sort(keys(%{$dbref}))) {
                       my $value = $dbref->{$key};
                       if ($value =~ s/^__FROZEN__//) {
                           $value = thaw(&LONCAPA::unescape($value));
                       } else {
                           $value = &LONCAPA::unescape($value);
                       }
                       $confhash{$key} = $value;
                   }
                   &LONCAPA::locking_hash_untie($dbref);
               }
           }
       } else {
           my $request=new HTTP::Request('GET',$url);
           my $response=&LONCAPA::LWPReq::makerequest($primlibserv,$request,'',\%perlvar,5);
           unless ($response->is_error()) {
               my $content = $response->content;
               if ($content) {
                   my @pairs=split(/\&/,$content);
                   foreach my $item (@pairs) {
                       my ($key,$value)=split(/=/,$item,2);
                       my $what = &LONCAPA::unescape($key);
                       if ($value =~ s/^__FROZEN__//) {
                           $value = thaw(&LONCAPA::unescape($value));
                       } else {
                           $value = &LONCAPA::unescape($value);
                       }
                       $confhash{$what}=$value;
                   }
               }
           }
       }
       return \%confhash;
   }
   
     $answer=reply("pong",$tryserver);  sub write_hosttypes {
     if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {      my %intdom = &Apache::lonnet::all_host_intdom();
  $result="<b>ok</b>";      my %hostdom = &Apache::lonnet::all_host_domain();
       my $dom = $hostdom{$perlvar{'lonHostID'}};
       my $internetdom = $intdom{$perlvar{'lonHostID'}};
       my %changes;
       if (($dom ne '') && ($internetdom ne '')) {
           if (keys(%hostdom)) {
               my %currhosttypes;
               if (open(my $fh,'<',"$perlvar{'lonTabDir'}/hosttypes.tab")) {
                   while (my $line = <$fh>) {
                       chomp($line);
                       my ($name,$value) = split(/:/,$line);
                       if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) {
                           $currhosttypes{$name} = $value;
                       }
                   }
                   close($fh);
               }
               if (open(my $fh,'>',"$perlvar{'lonTabDir'}/hosttypes.tab")) {
                   my $count = 0;
                   foreach my $lonid (sort(keys(%hostdom))) {
                       my $type = 'other';
                       if ($hostdom{$lonid} eq $dom) {
                           $type = 'dom'; 
                       } elsif ($intdom{$lonid} eq $internetdom) {
                           $type = 'intdom';
                       }
                       print $fh "$lonid:$type\n";
                       if (exists($currhosttypes{$lonid})) {
                           if ($type ne $currhosttypes{$lonid}) {
                               $changes{$lonid} = 1;
                           }
                       } else {
                           $changes{$lonid} = 1;
                       }
                       $count ++;
                   }
                   close($fh);
                   print "Completed writing host type data for $count hosts.\n";
               }
           } else {
               print "Writing of host types skipped - no hosts found.\n";
           }
     } else {      } else {
         $result=$answer;          print "Writing of host types skipped - could not determine this host's LON-CAPA domain or 'internet' domain.\n";
         $warnings++;  
         if ($answer eq 'con_lost') { $warnings++; }  
     }      }
     print $fh "<tr><td>$tryserver</td><td>$result</td></tr>\n";      return %changes;
   }
   
   sub update_revocation_list {
       my ($result,$changed) = &Apache::lonnet::fetch_crl_pemfile();
       if ($result eq 'ok') {
           print "Certificate Revocation List (from CA) updated.\n";
       } else {
           print "Certificate Revocation List from (CA) not updated.\n";
       }
       return $changed;
 }  }
 print $fh "</table>";  
   
 &errout($fh);  sub reset_nosslverify_pids {
 # ------------------------------------------------------------ Delayed messages      my ($fh,%sslrem) = @_;
       &checkon_daemon($fh,'lond',40000,'USR2');
       my $loncpidfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
       my $loncppid;
       if ((-e $loncpidfile) && (open(my $pfh,'<',$loncpidfile))) {
           $loncppid=<$pfh>;
           chomp($loncppid);
           close($pfh);
           if ($loncppid =~ /^\d+$/) {
               my %pids_by_host;
               my $docdir = $perlvar{'lonDocRoot'};
               if (-d "$docdir/lon-status/loncchld") {
                   if (opendir(my $dh,"$docdir/lon-status/loncchld")) {
                       while (my $file = readdir($dh)) {
                           next if ($file =~ /^\./);
                           if (open(my $fh,'<',"$docdir/lon-status/loncchld/$file")) {
                               my $record = <$fh>;
                               chomp($record);
                               close($fh);
                               my ($remotehost,$authmode) = split(/:/,$record);
                               $pids_by_host{$remotehost}{$authmode}{$file} = 1;
                           }
                       }
                       closedir($dh);
                       if (keys(%pids_by_host)) {
                           foreach my $host (keys(%pids_by_host)) {
                               if ($sslrem{$host}) {
                                   if (ref($pids_by_host{$host}) eq 'HASH') {
                                       if (ref($pids_by_host{$host}{'insecure'}) eq 'HASH') {
                                           if (keys(%{$pids_by_host{$host}{'insecure'}})) {
                                               foreach my $pid (keys(%{$pids_by_host{$host}{'insecure'}})) {
                                                   if (open(PIPE,"ps -o ppid= -p $pid |")) {
                                                       my $ppid = <PIPE>;
                                                       chomp($ppid);
                                                       close(PIPE);
                                                       $ppid =~ s/(^\s+|\s+$)//g;
                                                       if (($ppid == $loncppid) && (kill 0 => $pid)) {
                                                           kill QUIT => $pid;
                                                       }
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return;
   }
   
 print $fh '<hr><a name="delayed"><h2>Delayed Messages</h2>';  sub get_permcount_settings {
 print "buffers\n";      my ($domconf) = @_;
       my ($defaults,$names) = &Apache::loncommon::lon_status_items();
       my (%weights,$threshold,$sysmail,$reportstatus,%exclusions);
       foreach my $type ('E','W','N','U') {
           $weights{$type} = $defaults->{$type};
       }
       $threshold = $defaults->{'threshold'};
       $sysmail = $defaults->{'sysmail'};
       $reportstatus = 1;
       if (ref($domconf) eq 'HASH') {
           if (ref($domconf->{'contacts'}) eq 'HASH') {
               if ($domconf->{'contacts'}{'reportstatus'} == 0) {
                   $reportstatus = 0;
               }
               if (ref($domconf->{'contacts'}{'lonstatus'}) eq 'HASH') {
                   if (ref($domconf->{'contacts'}{'lonstatus'}{weights}) eq 'HASH') {
                       foreach my $type ('E','W','N','U') {
                           if (exists($domconf->{'contacts'}{'lonstatus'}{weights}{$type})) {
                               $weights{$type} = $domconf->{'contacts'}{'lonstatus'}{weights}{$type};
                           }
                       }
                   }
                   if (ref($domconf->{'contacts'}{'lonstatus'}{'excluded'}) eq 'ARRAY') {
                       my @excluded = @{$domconf->{'contacts'}{'lonstatus'}{'excluded'}};
                       if (@excluded) {
                           map { $exclusions{$_} = 1; } @excluded;
                       }
                   }
                   if (exists($domconf->{'contacts'}{'lonstatus'}{'threshold'})) {
                       $threshold = $domconf->{'contacts'}{'lonstatus'}{'threshold'};
                   }
                   if (exists($domconf->{'contacts'}{'lonstatus'}{'sysmail'})) {
                       $sysmail = $domconf->{'contacts'}{'lonstatus'}{'sysmail'};
                   }
               }
           }
       }
       return ($threshold,$sysmail,$reportstatus,\%weights,\%exclusions);
   }
   
 print $fh '<h3>Scanning Permanent Log</h3>';  sub read_serverhomeIDs {
       my %server;
       if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
           if (open(my $fh,'<',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
               while (<$fh>) {
                   my($host,$id) = split(/:/);
                   chomp($id);
                   $server{$host} = $id;
               }
               close($fh);
           }
       }
       return %server;
   }
   
 $unsend=0;  sub send_mail {
 {      my ($sysmail,$reportstatus) = @_;
     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");      my $defdom = $perlvar{'lonDefDomain'};
     while ($line=<$dfh>) {      my $origmail = $perlvar{'lonAdmEMail'};
  ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);      my $emailto = &Apache::loncommon::build_recipient_list(undef,
         if ($sdf eq 'F') {                                      'lonstatusmail',$defdom,$origmail);
     $local=localtime($time);      if (($totalcount>$sysmail) && ($reportstatus)) {
             print "<b>Failed: $time, $dserv, $dcmd</b><br>";   $emailto.=",$perlvar{'lonSysEMail'}";
             $warnings++;      }
         }      my $from;
         if ($sdf eq 'S') { $unsend--; }      my $hostname=`/bin/hostname`;
         if ($sdf eq 'D') { $unsend++; }      chop($hostname);
     }      $hostname=~s/[^\w\.]//g;
 }      if ($hostname) {
 print $fh "Total unsend messages: <b>$unsend</b><p>\n";          $from = 'www@'.$hostname;
 $warnings=$warnings+5*$unsend;      }
       my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";
 print $fh "<h3>Outgoing Buffer</h3>";      my $loncronmail = "To: $emailto\n".
                         "From: $from\n".
 open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");                        "Subject: ".$subj."\n".
 while ($line=<DFH>) {                         "Content-type: text/html\; charset=UTF-8\n".
     print $fh "$line<br>";                        "MIME-Version: 1.0\n\n";
 };      if (open(my $fh,"<$statusdir/index.html")) {
 close (DFH);          while (<$fh>) {
               $loncronmail .= $_;
 # ------------------------------------------------------------------------- End          }
 print $fh "<a name=errcount>\n";          close($fh);
 $totalcount=$notices+4*$warnings+100*$errors;      } else {
 &errout($fh);          $loncronmail .= "Failed to read from http://$hostname/lon-status/index.html\n";
 print $fh "<h1>Total Error Count: $totalcount</h1>";      }
 $now=time;      $loncronmail .= "\n\n";
 $date=localtime($now);      if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
 print $fh "<hr>$date ($now)</body></html>\n";          print $mailh $loncronmail;
 print "writing done\n";          close($mailh);
 }          print "Sending mail.\n";
       } else {
 rename ("$statusdir/newstatus.html","$statusdir/index.html");          print "Sending mail failed.\n";
       }
 if ($totalcount>200) {  
    print "mailing\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");  
 }  }
 1;  
   
   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.' |".
                  " mail -s '$subj' $emailto > /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.' |".
                  " mail -s '$subj' $emailto > /dev/null");
    exit 1;
       }
   
   # -------------------------------------------- Force reload of host information
       my $nomemcache;
       if ($justcheckdaemons) {
           $nomemcache=1;
           my $memcachepidfile="$perlvar{'lonDaemons'}/logs/memcached.pid";
           my $memcachepid;
           if (-e $memcachepidfile) {
               my $memfh=IO::File->new($memcachepidfile);
               $memcachepid=<$memfh>;
               chomp($memcachepid);
               if ($memcachepid =~ /^\d+$/ && kill 0 => $memcachepid) {
                   undef($nomemcache);
               }
           }
       }
       &Apache::lonnet::load_hosts_tab(1,$nomemcache);
       &Apache::lonnet::load_domain_tab(1,$nomemcache);
       &Apache::lonnet::get_iphost(1,$nomemcache);
   
   # ----------------------------------------- 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);
           &clean_balanceIDs($fh);
           &clean_webDAV_sessionIDs($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) {
           &clean_nosslverify($fh);
           &write_connection_config();
           &write_hosttypes();
           &update_revocation_list(); 
    &checkon_daemon($fh,'lond',40000,'USR2');
    &checkon_daemon($fh,'lonc',40000,'USR2');
       }
       if ($justcheckconnections) {
    &test_connections($fh);
       }
       if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
           my $domconf = &get_domain_config();
           my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =
               &get_permcount_settings($domconf);
    &check_delayed_msg($fh,$weightsref,$exclusionsref);
           &write_loncaparevs();
           &write_serverhomeIDs();
    &write_checksums();
           &write_hostips();
           my %sslrem = &clean_nosslverify($fh);
           my %conchgs = &write_connection_config();
           my %hosttypechgs = &write_hosttypes();
           my $hadcrlchg = &update_revocation_list();
           if ((keys(%conchgs) > 0) || (keys(%hosttypechgs) > 0) ||
               $hadcrlchg || (keys(%sslrem) > 0)) {
               &checkon_daemon($fh,'lond',40000,'USR2');
               &reset_nosslverify_pids($fh,%sslrem);
           }
           &finish_logging($fh,$weightsref);
           &log_simplestatus();
           if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); }
       }
   }
   
   &main();
   1;
   
Removed from v.1.40  
changed lines
  Added in v.1.117

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.