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

Diff for /loncom/loncron between versions 1.96 and 1.128

version 1.96, 2013/02/02 00:22:30 version 1.128, 2021/02/02 21:14:36
Line 34  use lib '/home/httpd/lib/perl/'; Line 34  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::Checksumming;  use LONCAPA::Checksumming;
 use LONCAPA;  use LONCAPA;
   use LONCAPA::LWPReq;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
   
Line 41  use IO::File; Line 42  use IO::File;
 use IO::Socket;  use IO::Socket;
 use HTML::Entities;  use HTML::Entities;
 use Getopt::Long;  use Getopt::Long;
   use GDBM_File qw(GDBM_READER);
   use Storable qw(thaw);
   use File::ReadBackwards;
   use File::Copy;
   use Sys::Hostname::FQDN();
   
 #globals  #globals
 use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);  use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
   
Line 73  sub rotate_logfile { Line 80  sub rotate_logfile {
  rename("$file.2","$file.3");   rename("$file.2","$file.3");
  rename("$file.1","$file.2");   rename("$file.1","$file.2");
  rename("$file","$file.1");   rename("$file","$file.1");
     }       }
 }  }
   
 sub start_daemon {  sub start_daemon {
     my ($fh,$daemon,$pidfile,$args) = @_;      my ($fh,$daemon,$pidfile,$args) = @_;
     my $progname=$daemon;      my $progname=$daemon;
     if ($daemon eq 'lonc') {      if ($daemon eq 'lonc') {
  $progname='loncnew';    $progname='loncnew';
     }      }
     my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";      my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
     &rotate_logfile($error_fname,$fh,'error logs');      &rotate_logfile($error_fname,$fh,'error logs');
Line 111  sub checkon_daemon { Line 118  sub checkon_daemon {
     my $result;      my $result;
     &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');      &log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>');
     printf("%-15s ",$daemon);      printf("%-15s ",$daemon);
     if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){      if ($fh) {
  open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");          if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
  while (my $line=<DFH>) {       if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
     &log($fh,"$line");          while (my $line=<DFH>) {
     if ($line=~/INFO/) { $notices++; }              &log($fh,"$line");
     if ($line=~/WARNING/) { $notices++; }              if ($line=~/INFO/) { $notices++; }
     if ($line=~/CRITICAL/) { $warnings++; }              if ($line=~/WARNING/) { $notices++; }
  };              if ($line=~/CRITICAL/) { $warnings++; }
  close (DFH);          }
           close (DFH);
               }
           }
           &log($fh,"</tt></p>");
     }      }
     &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;      my $daemonpid;
     if (-e $pidfile) {      if (-e $pidfile) {
Line 157  sub checkon_daemon { Line 167  sub checkon_daemon {
  $errors++;   $errors++;
  my $kadaemon=$daemon;   my $kadaemon=$daemon;
  if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }   if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
  &log($fh,'<br><font color="red">Killall '.$daemon.': '.   &log($fh,'<br /><font color="red">Killall '.$daemon.': '.
     `killall $kadaemon 2>&1`.' - ');      `killall $kadaemon 2>&1`.' - ');
  sleep 1;   sleep 1;
  &log($fh,unlink($pidfile).' - '.   &log($fh,unlink($pidfile).' - '.
     `killall -9 $kadaemon 2>&1`.      `killall -9 $kadaemon 2>&1`.
     '</font><br>');      '</font><br />');
           if ($kadaemon eq 'loncnew') {
               &clean_lonc_childpids();
           }
  &log($fh,"<h3>$daemon not running, trying to start</h3>");   &log($fh,"<h3>$daemon not running, trying to start</h3>");
   
  if (&start_daemon($fh,$daemon,$pidfile,$args)) {   if (&start_daemon($fh,$daemon,$pidfile,$args)) {
     &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");      &log($fh,"<h3>$daemon at pid $daemonpid responding</h3>");
     $simplestatus{$daemon}='restarted';      $simplestatus{$daemon}='restarted';
Line 189  sub checkon_daemon { Line 202  sub checkon_daemon {
  &log($fh,"<p>Unable to start $daemon</p>");   &log($fh,"<p>Unable to start $daemon</p>");
     }      }
  }   }
           if ($fh) {
  if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){      if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
     &log($fh,"<p><pre>");          &log($fh,"<p><pre>");
     open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");          if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
     while (my $line=<DFH>) {               while (my $line=<DFH>) { 
  &log($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);
     &log($fh,"</pre></p>");                  }
           &log($fh,"</pre></p>");
               }
  }   }
     }      }
       
     my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";      my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
     &rotate_logfile($fname,$fh,'logs');      &rotate_logfile($fname,$fh,'logs');
   
Line 215  sub log_machine_info { Line 230  sub log_machine_info {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');      &log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
     &log($fh,"<h3>loadavg</h3>");      &log($fh,"<h3>loadavg</h3>");
   
       my $cpucount;
       if (open(PIPE,"lscpu |grep '^CPU(s)' 2>&1 |")) {
           my $info = <PIPE>;
           chomp($info);
           ($cpucount) = ($info =~ /^\QCPU(s):\E\s+(\d+)$/);
           close(PIPE);
       }
       if (!$cpucount) {
           $cpucount = 1;
       }
       my %loadtarget = (
                           error => 4.0*$cpucount,
                           warn  => 2.0*$cpucount,
                           note  => 1.0*$cpucount,
                        );
     open (LOADAVGH,"/proc/loadavg");      open (LOADAVGH,"/proc/loadavg");
     my $loadavg=<LOADAVGH>;      my $loadavg=<LOADAVGH>;
     close (LOADAVGH);      close (LOADAVGH);
        
     &log($fh,"<tt>$loadavg</tt>");      &log($fh,"<tt>$loadavg</tt>");
       
     my @parts=split(/\s+/,$loadavg);      my @parts=split(/\s+/,$loadavg);
     if ($parts[1]>4.0) {      if ($parts[1]>$loadtarget{'error'}) {
  $errors++;   $errors++;
     } elsif ($parts[1]>2.0) {      } elsif ($parts[1]>$loadtarget{'warn'}) {
  $warnings++;   $warnings++;
     } elsif ($parts[1]>1.0) {      } elsif ($parts[1]>$loadtarget{'note'}) {
  $notices++;   $notices++;
     }      }
   
Line 235  sub log_machine_info { Line 265  sub log_machine_info {
     &log($fh,"<pre>");      &log($fh,"<pre>");
   
     open (DFH,"df|");      open (DFH,"df|");
     while (my $line=<DFH>) {       while (my $line=<DFH>) {
  &log($fh,&encode_entities($line,'<>&"'));    &log($fh,&encode_entities($line,'<>&"'));
  @parts=split(/\s+/,$line);   @parts=split(/\s+/,$line);
  my $usage=$parts[4];   my $usage=$parts[4];
  $usage=~s/\W//g;   $usage=~s/\W//g;
  if ($usage>90) {    if ($usage>90) {
     $warnings++;      $warnings++;
     $notices++;       $notices++;
  } elsif ($usage>80) {   } elsif ($usage>80) {
     $warnings++;      $warnings++;
  } elsif ($usage>60) {   } elsif ($usage>60) {
Line 259  sub log_machine_info { Line 289  sub log_machine_info {
     my $psproc=0;      my $psproc=0;
   
     open (PSH,"ps aux --cols 140 |");      open (PSH,"ps aux --cols 140 |");
     while (my $line=<PSH>) {       while (my $line=<PSH>) {
  &log($fh,&encode_entities($line,'<>&"'));    &log($fh,&encode_entities($line,'<>&"'));
  $psproc++;   $psproc++;
     }      }
     close (PSH);      close (PSH);
Line 271  sub log_machine_info { Line 301  sub log_machine_info {
   
     &log($fh,"<h3>distprobe</h3>");      &log($fh,"<h3>distprobe</h3>");
     &log($fh,"<pre>");      &log($fh,"<pre>");
     &get_distro($perlvar{'lonDaemons'},$fh);      &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
     &log($fh,"</pre>");      &log($fh,"</pre>");
   
     &errout($fh);      &errout($fh);
Line 282  sub start_logging { Line 312  sub start_logging {
     my %simplestatus=();      my %simplestatus=();
     my $now=time;      my $now=time;
     my $date=localtime($now);      my $date=localtime($now);
        
   
     &log($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" />
Line 298  sub start_logging { Line 330  sub start_logging {
 <li><a href="#machine">Machine Information</a></li>  <li><a href="#machine">Machine Information</a></li>
 <li><a href="#tmp">Temporary Files</a></li>  <li><a href="#tmp">Temporary Files</a></li>
 <li><a href="#tokens">Session Tokens</a></li>  <li><a href="#tokens">Session Tokens</a></li>
   <li><a href="#webdav">WebDAV Session Tokens</a></li>
 <li><a href="#httpd">httpd</a></li>  <li><a href="#httpd">httpd</a></li>
 <li><a href="#lonsql">lonsql</a></li>  <li><a href="#lonsql">lonsql</a></li>
 <li><a href="#lond">lond</a></li>  <li><a href="#lond">lond</a></li>
Line 328  ENDHEADERS Line 361  ENDHEADERS
     "</td><td>".$role.      "</td><td>".$role.
     "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");      "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
     }      }
     &log($fh,"</table><h3>Spare Hosts</h3><ul>");      &log($fh,"</table><h3>Spare Hosts</h3>");
     foreach my $type (sort(keys(%Apache::lonnet::spareid))) {      if (keys(%Apache::lonnet::spareid) > 0) {
  &log($fh,"<li>$type\n<ol>");          &log($fh,"<ul>");
  foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {          foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
     &log($fh,"<li>$id</li>\n");      &log($fh,"<li>$type\n<ol>");
  }      foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {
  &log($fh,"</ol>\n</li>\n");          &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");
     }      }
     &log($fh,"</ul>\n");  
     return $fh;      return $fh;
 }  }
   
Line 390  sub recursive_clean_tmp { Line 428  sub recursive_clean_tmp {
                 ($cleaned,$old,$removed) =                   ($cleaned,$old,$removed) = 
                      &recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);                       &recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
                 my @doms = &Apache::lonnet::current_machine_domains();                  my @doms = &Apache::lonnet::current_machine_domains();
                   
                 if (open(my $dirhandle,$fname)) {                  if (open(my $dirhandle,$fname)) {
                     unless (($innerdir eq 'helprequests') ||                      unless (($innerdir eq 'helprequests') ||
                             (($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {                              (($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {
                         my @contents = grep {!/^\.\.?$/} readdir($dirhandle);                          my @contents = grep {!/^\.\.?$/} readdir($dirhandle);
                                       join('&&',@contents)."\n";                                            join('&&',@contents)."\n";
                         if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {                          if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
                             closedir($dirhandle);                              closedir($dirhandle);
                             if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {                              if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
Line 448  sub recursive_clean_tmp { Line 486  sub recursive_clean_tmp {
                                 }                                  }
                             }                              }
                         } elsif (ref($errors->{failopen}) eq 'ARRAY') {                          } elsif (ref($errors->{failopen}) eq 'ARRAY') {
                             push(@{$errors->{failopen}},$fname);                               push(@{$errors->{failopen}},$fname);
                         }                          }
                     } else {                      } else {
                         if (unlink($fname)) {                          if (unlink($fname)) {
Line 474  sub clean_lonIDs { Line 512  sub clean_lonIDs {
     my $cleaned=0;      my $cleaned=0;
     my $active=0;      my $active=0;
     while (my $fname=<$perlvar{'lonIDsDir'}/*>) {      while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
  my ($dev,$ino,$mode,$nlink,          my $now=time;
     $uid,$gid,$rdev,$size,          if (-l $fname) {
     $atime,$mtime,$ctime,              my $linkfname = readlink($fname);
     $blksize,$blocks)=stat($fname);              if (-f $linkfname) {
  my $now=time;                  if ($linkfname =~ m{^$perlvar{'lonIDsDir'}/[^/]+\.id$}) {
  my $since=$now-$mtime;                      my @data = stat($linkfname);
  if ($since>$perlvar{'lonExpire'}) {                      my $mtime = $data[9];
     $cleaned++;                      my $since=$now-$mtime;
     &log($fh,"Unlinking $fname<br>");                      if ($since>$perlvar{'lonExpire'}) {
     unlink("$fname");                          if (unlink($linkfname)) {
  } else {                              $cleaned++;
     $active++;                              &log($fh,"Unlinking $linkfname<br />");
  }                              unlink($fname);
                           }
                       }
                   }
               } else {
                  unlink($fname);
               }
           } elsif (-f $fname) {
               my @data = stat($fname);
               my $mtime = $data[9];
               my $since=$now-$mtime;
               if ($since>$perlvar{'lonExpire'}) {
                   if (unlink($fname)) {
                       $cleaned++;
                       &log($fh,"Unlinking $fname<br />");
                   }
               } else {
                   $active++;
               }
           }
     }      }
     &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");      &log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
     &log($fh,"<h3>$active open session(s)</h3>");      &log($fh,"<h3>$active open session(s)</h3>");
 }  }
   
   # -------------------------------------------------------- clean out balanceIDs
   
   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{'lonBalanceDir'}/*.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 webDAV Session IDs
   sub clean_webDAV_sessionIDs {
       my ($fh)=@_;
       if ($perlvar{'lonRole'} eq 'library') {
           &log($fh,'<hr /><a name="webdav" /><h2>WebDAV Session Tokens</h2>');
           my $cleaned=0;
           my $active=0;
           my $now = time;
           if (-d $perlvar{'lonDAVsessDir'}) {
               while (my $fname=<$perlvar{'lonDAVsessDir'}/*>) {
                   my @stats = stat($fname);
                   my $since=$now-$stats[9];
                   if ($since>$perlvar{'lonExpire'}) {
                       $cleaned++;
                       &log($fh,"Unlinking $fname<br />");
                       unlink("$fname");
                   } else {
                       $active++;
                   }
               }
               &log($fh,"<p>Cleaned up ".$cleaned." stale webDAV session token(s).</p>");
               &log($fh,"<h3>$active open webDAV session(s)</h3>");
           }
       }
   }
   
   # ------------------------------------------------------------ clean out ltiIDs
   
   sub clean_ltiIDs {
       my ($fh)=@_;
       &log($fh,'<hr /><a name="ltisessions" /><h2>LTI Session Pointers</h2>');
       my $cleaned=0;
       my $active=0;
       if (-d $perlvar{'ltiIDsDir'}) {
           while (my $fname=<$perlvar{'ltiIDsDir'}/*>) {
               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." old LTI session pointers.</p>");
       &log($fh,"<h3>$active unexpired LTI session pointers</h3>");
   }
   
 # ----------------------------------------------------------- clean out sockets  # ----------------------------------------------------------- clean out sockets
 sub clean_sockets {  sub clean_sockets {
     my ($fh)=@_;      my ($fh)=@_;
Line 526  sub check_httpd_logs { Line 665  sub check_httpd_logs {
 sub rotate_lonnet_logs {  sub rotate_lonnet_logs {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');      &log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>');
     print "checking logs\n";      print "Checking logs.\n";
     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){      if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
  open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");   open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
  while (my $line=<DFH>) {    while (my $line=<DFH>) {
     &log($fh,&encode_entities($line,'<>&"'));      &log($fh,&encode_entities($line,'<>&"'));
  }   }
  close (DFH);   close (DFH);
     }      }
     &log($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 (my $line=<DFH>) {    while (my $line=<DFH>) {
     &log($fh,&encode_entities($line,'<>&"'));      &log($fh,&encode_entities($line,'<>&"'));
  }   }
  close (DFH);   close (DFH);
Line 570  sub rotate_other_logs { Line 709  sub rotate_other_logs {
 sub test_connections {  sub test_connections {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');      &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
     print "testing connections\n";      print "Testing connections.\n";
     &log($fh,"<table border='2'>");      &log($fh,"<table border='2'>");
     my ($good,$bad)=(0,0);      my ($good,$bad)=(0,0);
     my %hostname = &Apache::lonnet::all_hostnames();      my %hostname = &Apache::lonnet::all_hostnames();
Line 602  sub test_connections { Line 741  sub test_connections {
   
 # ------------------------------------------------------------ Delayed messages  # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {  sub check_delayed_msg {
     my ($fh)=@_;      my ($fh,$weightsref,$exclusionsref)=@_;
     &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');      &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
     print "checking buffers\n";      print "Checking buffers.\n";
           
     &log($fh,'<h3>Scanning Permanent Log</h3>');      &log($fh,'<h3>Scanning Permanent Log</h3>');
   
     my $unsend=0;      my $unsend=0;
       my $ignored=0;
   
     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");      my %hostname = &Apache::lonnet::all_hostnames();
     while (my $line=<$dfh>) {      my $numhosts = scalar(keys(%hostname));
  my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);      my $checkbackwards = 0;
  if ($sdf eq 'F') {       my $checkfrom = 0;
     my $local=localtime($time);      my $checkexcluded = 0;
     &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br>");      my (%bymachine,%weights,%exclusions,%serverhomes);
     $warnings++;      if (ref($weightsref) eq 'HASH') {
  }          %weights = %{$weightsref};
  if ($sdf eq 'S') { $unsend--; }      }
  if ($sdf eq 'D') { $unsend++; }      if (ref($exclusionsref) eq 'HASH') {
           %exclusions = %{$exclusionsref};
           if (keys(%exclusions)) {
               $checkexcluded = 1;
               %serverhomes = &read_serverhomeIDs();
           }
     }      }
   
     &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");  #
     if ($unsend > 0) {  # For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any
         $warnings=$warnings+5*$unsend;  # entry logged in lonnet.perm.log for completion of a delayed (critical)
   # transaction lacked the hostID for the remote node to which the command
   # to be completed was sent.
   #
   # 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
   # needs additional effort besides the changes made in loncron rev. 1.105.
   #
   # For "S" (completion) events logging in LON-CAPA 1.2.0 through 2.1.3 included
   # "LondTransaction=HASH(hexadecimal)->getClient() :$cmd, where the hexadecimal
   # is a memory location, and $cmd is the command sent to the remote node.
   #
   # Starting with 2.2.0 (released 8/21/2006) logging for "S" (completion) events
   # had sethost:$host_id:$cmd after LondTransaction=HASH(hexadecimal)->getClient()
   #
   # Starting with 2.4.1 (released 6/13/2007) logging for "S" replaced echoing the
   # getClient() call with the result of the Transaction->getClient() call itself
   # undef for completion of delivery of a delayed message.
   #
   # The net effect of these changes is that lonnet.perm.log is now accessed three
   # times: (a) oldest record is checked, if earlier than release date for 2.5.0
   # then (b) file is read backwards, with timestamp recorded for most recent
   # instance of logged "S" event for "update" command without "sethost:$host_id:"
   # then (c) file is read forward with records ignored which predate the timestamp
   # recorded in (b), if one was found.
   #
   # 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
   # the target node is in the list of nodes excluded from the count, in the domain
   # configuration for this machine's default domain.  The idea here is to remove
   # delayed "update" commands for nodes for which inbound access to port 5663,
   # is blocked, but are still part of the LON-CAPA network, (i.e., they can still
   # replicate content from other nodes).
   #
   
       my $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);
               if ($time < 1541185772) {
                   $checkbackwards = 1;
               }
               last;
           }
           undef $dfh;
       } 
   
       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;
           }
     }      }
   
     if ($unsend) { $simplestatus{'unsend'}=$unsend; }      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
Line 639  sub check_delayed_msg { Line 948  sub check_delayed_msg {
     }      }
     &log($fh,"</pre>\n");      &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  # pong to all servers that have delayed messages
 # this will trigger a reverse connection, which should flush the buffers  # this will trigger a reverse connection, which should flush the buffers
     foreach my $tryserver (sort(keys(%servers))) {      foreach my $tryserver (sort(keys(%servers))) {
Line 654  sub check_delayed_msg { Line 961  sub check_delayed_msg {
             };              };
             if ($@ && $@ =~ m/TIMEOUT/) {              if ($@ && $@ =~ m/TIMEOUT/) {
                 &log($fh,"Attempted pong to $tryserver timed out<br />");                  &log($fh,"Attempted pong to $tryserver timed out<br />");
                 print "time out while contacting: $tryserver for pong\n";                  print "Time out while contacting: $tryserver for pong.\n";
             } else {              } else {
                 &log($fh,"Pong to $tryserver: $answer<br />");                  &log($fh,"Pong to $tryserver: $answer<br />");
             }              }
Line 665  sub check_delayed_msg { Line 972  sub check_delayed_msg {
 }  }
   
 sub finish_logging {  sub finish_logging {
     my ($fh)=@_;      my ($fh,$weightsref)=@_;
       my %weights;
       if (ref($weightsref) eq 'HASH') {
           %weights = %{$weightsref};
       }
     &log($fh,"<a name='errcount' />\n");      &log($fh,"<a name='errcount' />\n");
     $totalcount=$notices+4*$warnings+100*$errors;      $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors);
     &errout($fh);      &errout($fh);
     &log($fh,"<h1>Total Error Count: $totalcount</h1>");      &log($fh,"<h1>Total Error Count: $totalcount</h1>");
     my $now=time;      my $now=time;
     my $date=localtime($now);      my $date=localtime($now);
     &log($fh,"<hr />$date ($now)</body></html>\n");      &log($fh,"<hr />$date ($now)</body></html>\n");
     print "lon-status webpage updated\n";      print "lon-status webpage updated.\n";
     $fh->close();      $fh->close();
   
     if ($errors) { $simplestatus{'errors'}=$errors; }      if ($errors) { $simplestatus{'errors'}=$errors; }
Line 694  sub log_simplestatus { Line 1005  sub log_simplestatus {
 }  }
   
 sub write_loncaparevs {  sub write_loncaparevs {
     print "Retrieving LON-CAPA version information\n";      print "Retrieving LON-CAPA version information.\n";
     if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {      my %hostname = &Apache::lonnet::all_hostnames();
         my %hostname = &Apache::lonnet::all_hostnames();      my $output;
         foreach my $id (sort(keys(%hostname))) {      foreach my $id (sort(keys(%hostname))) {
             if ($id ne '') {          if ($id ne '') {
                 my $loncaparev;              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;
   }
   
   sub write_serverhomeIDs {
       print "Retrieving LON-CAPA lonHostID information.\n";
       my %name_to_host = &Apache::lonnet::all_names();
       my $output;
       foreach my $name (sort(keys(%name_to_host))) {
           if ($name ne '') {
               if (ref($name_to_host{$name}) eq 'ARRAY') {
                   my $serverhomeID;
                 eval {                  eval {
                     local $SIG{ ALRM } = sub { die "TIMEOUT" };                      local $SIG{ ALRM } = sub { die "TIMEOUT" };
                     alarm(10);                      alarm(10);
                     $loncaparev =                      $serverhomeID =
                         &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');                          &Apache::lonnet::get_server_homeID($name,1,'loncron');
                     alarm(0);                      alarm(0);
                 };                  };
                 if ($@ && $@ =~ m/TIMEOUT/) {                  if ($@ && $@ =~ m/TIMEOUT/) {
                     print "time out while contacting lonHost: $id for version\n";                         print "Time out while contacting server: $name\n"; 
                 }                  }
                 if ($loncaparev =~ /^[\w.\-]+$/) {                  if ($serverhomeID ne '') {
                     print $fh $id.':'.$loncaparev."\n";                      $output .= $name.':'.$serverhomeID."\n";
                   } else {
                       $output .= $name.':'.$name_to_host{$name}->[0]."\n";
                 }                  }
             }              }
         }          }
         close($fh);  
     }      }
     return;      if ($output) {
 }          if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
               print $fh $output;
 sub write_serverhomeIDs {              close($fh);
     print "Retrieving LON-CAPA lonHostID information\n";              &Apache::lonnet::load_serverhomeIDs();
     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;      return;
 }  }
   
 sub write_checksums {  sub write_checksums {
     my ($perlvar) = @_;      my $distro = &LONCAPA::distro();
     return unless (ref($perlvar) eq 'HASH');  
     my $distro = &get_distro($perlvar->{'lonDaemons'});  
     if ($distro) {      if ($distro) {
         print "Retrieving file version and checksumming.\n";          print "Retrieving file version and checksumming.\n";
           my $numchksums = 0;
         my ($chksumsref,$versionsref) =          my ($chksumsref,$versionsref) =
             &LONCAPA::Checksumming::get_checksums($distro,$perlvar->{'lonDaemons'},              &LONCAPA::Checksumming::get_checksums($distro,$perlvar{'lonDaemons'},
                                                   $perlvar->{'lonLib'},                                                    $perlvar{'lonLib'},
                                                   $perlvar->{'lonIncludes'},                                                    $perlvar{'lonIncludes'},
                                                   $perlvar->{'lonTabDir'});                                                    $perlvar{'lonTabDir'});
         if (ref($chksumsref) eq 'HASH') {          if (ref($chksumsref) eq 'HASH') {
             $numchksums = scalar(keys(%{$chksumsref}));              $numchksums = scalar(keys(%{$chksumsref}));
         }          }
Line 769  sub write_checksums { Line 1089  sub write_checksums {
     } else {      } else {
         print "File version retrieval and checksumming skipped - could not determine Linux distro.\n";           print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; 
     }      }
     return'      return;
 }  }
   
 sub send_mail {  sub write_hostips {
     print "sending mail\n";      my $lontabdir = $perlvar{'lonTabDir'};
     my $defdom = $perlvar{'lonDefDomain'};      my $defdom = $perlvar{'lonDefDomain'};
     my $origmail = $perlvar{'lonAdmEMail'};      my $lonhost = $perlvar{'lonHostID'};
     my $emailto = &Apache::loncommon::build_recipient_list(undef,      my $newfile = "$lontabdir/currhostips.tab";
                                    'lonstatusmail',$defdom,$origmail);      my $oldfile = "$lontabdir/prevhostips.tab";
     if ($totalcount>2500) {      my (%prevhosts,%currhosts,%ipchange);
  $emailto.=",$perlvar{'lonSysEMail'}";      if ((-e $newfile) && (-s $newfile)) {
           move($newfile,$oldfile);
           chmod(0644,$oldfile);
           if (open(my $fh,'<',$oldfile)) {
               while (my $line=<$fh>) {
                   chomp($line);
                   if ($line =~ /^([^:]+):([\d.]+)$/) {
                       $prevhosts{$1} = $2;
                   }
               }
               close($fh);
           }
       }
       my ($ip_info,$cached) =
           &Apache::lonnet::is_cached_new('iphost','iphost');
       if (!$cached) {
           &Apache::lonnet::get_iphost();
           ($ip_info,$cached) =
           &Apache::lonnet::is_cached_new('iphost','iphost');
       }
       if (ref($ip_info) eq 'ARRAY') {
           %currhosts = %{$ip_info->[1]};
           if (open(my $fh,'>',$newfile)) {
               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;
   }
   
   sub clean_nosslverify {
       my ($fh) = @_;
       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);
           }
     }      }
     my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";   }
   
     my $result=system("metasend -b -S 4000000 -t $emailto -s '$subj' -f $statusdir/index.html -m text/html >& /dev/null");  sub write_connection_config {
     if ($result != 0) {      my ($domconf,%connectssl,%changes);
  $result=system("mail -s '$subj' $emailto < $statusdir/index.html");      $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;
 }  }
   
 sub get_distro {  sub get_domain_config {
     my ($dir,$fh) = @_;      my ($dom,$primlibserv,$isprimary,$url,%confhash);
     my $distro;      $dom = $perlvar{'lonDefDomain'};
     if (open(my $disth,"$dir/distprobe |")) {      $primlibserv = &Apache::lonnet::domain($dom,'primary');
         while (my $line=<$disth>) {      if ($primlibserv eq $perlvar{'lonHostID'}) {
             if ($fh) {          $isprimary = 1;
                 &log($fh,&encode_entities($line,'<>&"'));      } 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;
                   }
             }              }
             $distro .= $line;  
         }          }
         close($disth);  
     }      }
     return $distro;      return \%confhash;
   }
   
   sub write_hosttypes {
       my %intdom = &Apache::lonnet::all_host_intdom();
       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 {
           print "Writing of host types skipped - could not determine this host's LON-CAPA domain or 'internet' domain.\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;
   }
   
   sub reset_nosslverify_pids {
       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;
   }
   
   sub get_permcount_settings {
       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);
   }
   
   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;
   }
   
   sub send_mail {
       my ($sysmail,$reportstatus) = @_;
       my $defdom = $perlvar{'lonDefDomain'};
       my $origmail = $perlvar{'lonAdmEMail'};
       my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                      'lonstatusmail',$defdom,$origmail);
       if (($totalcount>$sysmail) && ($reportstatus)) {
    $emailto.=",$perlvar{'lonSysEMail'}";
       }
       my $from;
       my $hostname=`/bin/hostname`;
       chop($hostname);
       $hostname=~s/[^\w\.]//g;
       if ($hostname) {
           $from = 'www@'.$hostname;
       }
       my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";
       my $loncronmail = "To: $emailto\n".
                         "From: $from\n".
                         "Subject: ".$subj."\n".
                         "Content-type: text/html\; charset=UTF-8\n".
                         "MIME-Version: 1.0\n\n";
       if (open(my $fh,"<$statusdir/index.html")) {
           while (<$fh>) {
               $loncronmail .= $_;
           }
           close($fh);
       } else {
           $loncronmail .= "Failed to read from http://$hostname/lon-status/index.html\n";
       }
       $loncronmail .= "\n\n";
       if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
           print $mailh $loncronmail;
           close($mailh);
           print "Sending mail.\n";
       } else {
           print "Sending mail failed.\n";
       }
 }  }
   
 sub usage {  sub usage {
     print(<<USAGE);      print(<<USAGE);
 loncron - housekeeping program that checks up on various parts of Lon-CAPA  loncron - housekeeping program that checks up on various parts of LON-CAPA
   
 Options:  Options:
    --help     Display      --help     Display 
Line 823  Options: Line 1550  Options:
  do not send emails do not   do not send emails do not
                                 check if the daemons are running, do not                                  check if the daemons are running, do not
                                 generate lon-status                                  generate lon-status
                                 --justiptables          Only update the dynamic iptables rules for the
                                   lond port; do not send emails, do not
                                   check if the daemons are running, do not
                                   generate lon-status
 USAGE  USAGE
 }  }
   
 # ================================================================ Main Program  # ================================================================ Main Program
 sub main () {  sub main () {
     my ($help,$justcheckdaemons,$noemail,$justcheckconnections,      my ($help,$justcheckdaemons,$noemail,$justcheckconnections,
  $justreload);   $justreload,$justiptables);
     &GetOptions("help"                 => \$help,      &GetOptions("help"                 => \$help,
  "justcheckdaemons"     => \$justcheckdaemons,   "justcheckdaemons"     => \$justcheckdaemons,
  "noemail"              => \$noemail,   "noemail"              => \$noemail,
  "justcheckconnections" => \$justcheckconnections,   "justcheckconnections" => \$justcheckconnections,
  "justreload"           => \$justreload   "justreload"           => \$justreload,
                   "justiptables"         => \$justiptables
  );   );
     if ($help) { &usage(); return; }      if ($help) { &usage(); return; }
 # --------------------------------- Read loncapa_apache.conf and loncapa.conf  # --------------------------------- Read loncapa_apache.conf and loncapa.conf
Line 850  sub main () { Line 1581  sub main () {
     if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {      if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
  print("Unconfigured machine.\n");   print("Unconfigured machine.\n");
  my $emailto=$perlvar{'lonSysEMail'};   my $emailto=$perlvar{'lonSysEMail'};
  my $hostname=`/bin/hostname`;   my $hostname = Sys::Hostname::FQDN::fqdn();
  chop $hostname;   $hostname=~s/\.+/./g;
  $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell   $hostname=~s/\-+/-/g;
    $hostname=~s/[^\w\.-]//g; # make sure is safe to pass through shell
  my $subj="LON: Unconfigured machine $hostname";   my $subj="LON: Unconfigured machine $hostname";
  system("echo 'Unconfigured machine $hostname.' |\   system("echo 'Unconfigured machine $hostname.' |".
  mailto $emailto -s '$subj' > /dev/null");                 " mail -s '$subj' $emailto > /dev/null");
  exit 1;   exit 1;
     }      }
   
 # ----------------------------- Make sure this process is running from user=www  # ----------------------------- Make sure this process is running from user=www
     my $wwwid=getpwnam('www');      my $wwwid=getpwnam('www');
     if ($wwwid!=$<) {      if ($wwwid!=$<) {
  print("User ID mismatch.  This program must be run as user 'www'\n");   print("User ID mismatch. This program must be run as user 'www'.\n");
  my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";   my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";   my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
  system("echo 'User ID mismatch.  loncron must be run as user www.' |\   system("echo 'User ID mismatch. loncron must be run as user www.' |".
  mailto $emailto -s '$subj' > /dev/null");                 " mail -s '$subj' $emailto > /dev/null");
  exit 1;   exit 1;
     }      }
   
 # -------------------------------------------- Force reload of host information  # -------------------------------------------- Force reload of host information
     &Apache::lonnet::load_hosts_tab(1);      my $nomemcache;
     &Apache::lonnet::load_domain_tab(1);      if ($justcheckdaemons) {
     &Apache::lonnet::get_iphost(1);          $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);
               }
           }
       }
       if (!$justiptables) {
           &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    # ----------------------------------------- Force firewall update for lond port
   
     if ((!$justcheckdaemons) && (!$justreload)) {      if ((!$justcheckdaemons) && (!$justreload)) {
         my $now = time;          my $now = time;
Line 890  sub main () { Line 1638  sub main () {
             if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {              if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {
                 my $execpath = $perlvar{'lonDaemons'}.'/lciptables';                  my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
                 system("$execpath $tmpfile");                  system("$execpath $tmpfile");
                 unlink('/tmp/lock_lciptables');  # Remove the lock file.                   unlink('/tmp/lock_lciptables');  # Remove the lock file.
             }              }
             unlink($tmpfile);              unlink($tmpfile);
         }          }
Line 902  sub main () { Line 1650  sub main () {
     $warnings=0;      $warnings=0;
     $notices=0;      $notices=0;
   
   
     my $fh;      my $fh;
     if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
  $fh=&start_logging();   $fh=&start_logging();
   
  &log_machine_info($fh);   &log_machine_info($fh);
  &clean_tmp($fh);   &clean_tmp($fh);
  &clean_lonIDs($fh);   &clean_lonIDs($fh);
           &clean_balanceIDs($fh);
           &clean_webDAV_sessionIDs($fh);
           &clean_ltiIDs($fh);
  &check_httpd_logs($fh);   &check_httpd_logs($fh);
  &rotate_lonnet_logs($fh);   &rotate_lonnet_logs($fh);
  &rotate_other_logs($fh);   &rotate_other_logs($fh);
     }      }
     if (!$justcheckconnections && !$justreload) {      if (!$justcheckconnections && !$justreload && !$justiptables) {
  &checkon_daemon($fh,'lonmemcached',40000);   &checkon_daemon($fh,'lonmemcached',40000);
  &checkon_daemon($fh,'lonsql',200000);   &checkon_daemon($fh,'lonsql',200000);
  if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {   if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
Line 925  sub main () { Line 1676  sub main () {
         &checkon_daemon($fh,'lonr',40000);          &checkon_daemon($fh,'lonr',40000);
     }      }
     if ($justreload) {      if ($justreload) {
           &clean_nosslverify($fh);
           &write_connection_config();
           &write_hosttypes();
           &update_revocation_list(); 
  &checkon_daemon($fh,'lond',40000,'USR2');   &checkon_daemon($fh,'lond',40000,'USR2');
  &checkon_daemon($fh,'lonc',40000,'USR2');   &checkon_daemon($fh,'lonc',40000,'USR2');
     }      }
     if ($justcheckconnections) {      if ($justcheckconnections) {
  &test_connections($fh);   &test_connections($fh);
     }      }
     if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
  &check_delayed_msg($fh);          my $domconf = &get_domain_config();
  &finish_logging($fh);          my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =
  &log_simplestatus();              &get_permcount_settings($domconf);
    &check_delayed_msg($fh,$weightsref,$exclusionsref);
         &write_loncaparevs();          &write_loncaparevs();
         &write_serverhomeIDs();          &write_serverhomeIDs();
  &write_checksums(\%perlvar);   &write_checksums();
  if ($totalcount>200 && !$noemail) { &send_mail(); }          &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); }
     }      }
 }  }
   
Removed from v.1.96  
changed lines
  Added in v.1.128

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.