Diff for /loncom/loncron between versions 1.55 and 1.110

version 1.55, 2005/01/20 16:27:40 version 1.110, 2018/10/25 03:27:22
Line 32  use strict; Line 32  use strict;
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::Checksumming;
   use LONCAPA;
   use Apache::lonnet;
   use Apache::loncommon;
   
 use IO::File;  use IO::File;
 use IO::Socket;  use IO::Socket;
 use HTML::Entities;  use HTML::Entities;
 use Getopt::Long;  use Getopt::Long;
   use GDBM_File;
   use Storable qw(thaw);
 #globals  #globals
 use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);  use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
   
 my $statusdir="/home/httpd/html/lon-status";  my $statusdir="/home/httpd/html/lon-status";
   
   
 # -------------------------------------------------- Non-critical communication  
 sub reply {  
     my ($cmd,$server)=@_;  
     my $peerfile="$perlvar{'lonSockDir'}/$server";  
     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",  
                                      Type    => SOCK_STREAM,  
                                      Timeout => 10)  
        or return "con_lost";  
     print $client "$cmd\n";  
     my $answer=<$client>;  
     chomp($answer);  
     if (!$answer) { $answer="con_lost"; }  
     return $answer;  
 }  
   
 # --------------------------------------------------------- Output error status  # --------------------------------------------------------- Output error status
   
 sub log {  sub log {
Line 76  sub errout { Line 67  sub errout {
 ENDERROUT  ENDERROUT
 }  }
   
   sub rotate_logfile {
       my ($file,$fh,$description) = @_;
       my $size=(stat($file))[7];
       if ($size>40000) {
    &log($fh,"<p>Rotating $description ...</p>");
    rename("$file.2","$file.3");
    rename("$file.1","$file.2");
    rename("$file","$file.1");
       } 
   }
   
 sub start_daemon {  sub start_daemon {
     my ($fh,$daemon,$pidfile,$args) = @_;      my ($fh,$daemon,$pidfile,$args) = @_;
     my $progname=$daemon;      my $progname=$daemon;
     if ($daemon eq 'lonc' && $args eq 'new') {      if ($daemon eq 'lonc') {
  $progname='loncnew';    $progname='loncnew'; 
  print "new ";  
     }      }
     my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";      my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
     my $size=(stat($error_fname))[7];      &rotate_logfile($error_fname,$fh,'error logs');
     if ($size>40000) {      if ($daemon eq 'lonc') {
  &log($fh,"<p>Rotating error logs ...</p>");   &clean_sockets($fh);
  rename("$error_fname.2","$error_fname.3");  
  rename("$error_fname.1","$error_fname.2");  
  rename("$error_fname","$error_fname.1");  
     }      }
     system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");      system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors");
     sleep 2;      sleep 1;
     if (-e $pidfile) {      if (-e $pidfile) {
  &log($fh,"<p>Seems like it started ...</p>");   &log($fh,"<p>Seems like it started ...</p>");
  my $lfh=IO::File->new("$pidfile");   my $lfh=IO::File->new("$pidfile");
  my $daemonpid=<$lfh>;   my $daemonpid=<$lfh>;
  chomp($daemonpid);   chomp($daemonpid);
  sleep 2;   if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
  if (kill 0 => $daemonpid) {  
     return 1;      return 1;
  } else {   } else {
     return 0;      return 0;
Line 111  sub start_daemon { Line 108  sub start_daemon {
 }  }
   
 sub checkon_daemon {  sub checkon_daemon {
     my ($fh,$daemon,$maxsize,$sendusr1,$args)=@_;      my ($fh,$daemon,$maxsize,$send,$args)=@_;
   
       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("%-10s ",$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";
           
Line 135  sub checkon_daemon { Line 136  sub checkon_daemon {
  my $lfh=IO::File->new("$pidfile");   my $lfh=IO::File->new("$pidfile");
  $daemonpid=<$lfh>;   $daemonpid=<$lfh>;
  chomp($daemonpid);   chomp($daemonpid);
  if (kill 0 => $daemonpid) {   if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
     &log($fh,"<h3>$daemon at pid $daemonpid responding");      &log($fh,"<h3>$daemon at pid $daemonpid responding");
     if ($sendusr1) { &log($fh,", sending USR1"); }      if ($send) { &log($fh,", sending $send"); }
     &log($fh,"</h3>");      &log($fh,"</h3>");
     if ($sendusr1) { kill USR1 => $daemonpid; }      if ($send eq 'USR1') { kill USR1 => $daemonpid; }
       if ($send eq 'USR2') { kill USR2 => $daemonpid; }
     $restartflag=0;      $restartflag=0;
     print "running\n";      if ($send eq 'USR2') {
    $result = 'reloaded';
    print "reloaded\n";
       } else {
    $result = 'running';
    print "running\n";
       }
  } else {   } else {
     $errors++;      $errors++;
     &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");      &log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>");
Line 152  sub checkon_daemon { Line 160  sub checkon_daemon {
     if ($restartflag==1) {      if ($restartflag==1) {
  $simplestatus{$daemon}='off';   $simplestatus{$daemon}='off';
  $errors++;   $errors++;
  &log($fh,'<br><font color="red">Killall '.$daemon.': '.   my $kadaemon=$daemon;
     `killall $daemon 2>&1`.' - ');   if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
  sleep 2;   &log($fh,'<br /><font color="red">Killall '.$daemon.': '.
       `killall $kadaemon 2>&1`.' - ');
    sleep 1;
  &log($fh,unlink($pidfile).' - '.   &log($fh,unlink($pidfile).' - '.
     `killall -9 $daemon 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';
       $result = 'started';
     print "started\n";      print "started\n";
  } else {   } else {
     $errors++;      $errors++;
Line 172  sub checkon_daemon { Line 186  sub checkon_daemon {
     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';
    $result = 'started';
  print "started\n";   print "started\n";
     } else {      } else {
    $result = 'failed';
  print " failed\n";   print " failed\n";
  $simplestatus{$daemon}='failed';   $simplestatus{$daemon}='failed';
  $errors++; $errors++;   $errors++; $errors++;
Line 181  sub checkon_daemon { Line 197  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');
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
       
     if ($size>$maxsize) {  
  &log($fh,"<p>Rotating logs ...</p>");  
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &errout($fh);      &errout($fh);
       return $result;
 }  }
   
 # --------------------------------------------------------------------- Machine  # --------------------------------------------------------------------- Machine
Line 271  sub log_machine_info { Line 279  sub log_machine_info {
     if ($psproc>200) { $notices++; }      if ($psproc>200) { $notices++; }
     if ($psproc>250) { $notices++; }      if ($psproc>250) { $notices++; }
   
       &log($fh,"<h3>distprobe</h3>");
       &log($fh,"<pre>");
       &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
       &log($fh,"</pre>");
   
     &errout($fh);      &errout($fh);
 }  }
   
 sub start_logging {  sub start_logging {
     my ($hostdom,$hostrole,$hostname,$spareid)=@_;  
     my $fh=IO::File->new(">$statusdir/newstatus.html");      my $fh=IO::File->new(">$statusdir/newstatus.html");
     my %simplestatus=();      my %simplestatus=();
     my $now=time;      my $now=time;
Line 283  sub start_logging { Line 295  sub start_logging {
           
   
     &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 296  sub start_logging { Line 310  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>
 <li><a href="#lonc">lonc</a></li>  <li><a href="#lonc">lonc</a></li>
 <li><a href="#lonhttpd">lonhttpd</a></li>  
 <li><a href="#lonnet">lonnet</a></li>  <li><a href="#lonnet">lonnet</a></li>
 <li><a href="#connections">Connections</a></li>  <li><a href="#connections">Connections</a></li>
 <li><a href="#delayed">Delayed Messages</a></li>  <li><a href="#delayed">Delayed Messages</a></li>
Line 318  ENDHEADERS Line 332  ENDHEADERS
      &encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n");       &encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n");
     }      }
     &log($fh,"</table><h3>Hosts</h3><table border='2'>");      &log($fh,"</table><h3>Hosts</h3><table border='2'>");
     foreach my $id (sort(keys(%{$hostname}))) {      my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $id (sort(keys(%hostname))) {
    my $role = (&Apache::lonnet::is_library($id) ? 'library'
                                        : 'access');
  &log($fh,   &log($fh,
     "<tr><td>$id</td><td>".$hostdom->{$id}.      "<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id).
     "</td><td>".$hostrole->{$id}.      "</td><td>".$role.
     "</td><td>".$hostname->{$id}."</td></tr>\n");      "</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n");
     }      }
     &log($fh,"</table><h3>Spare Hosts</h3><ol>");      &log($fh,"</table><h3>Spare Hosts</h3>");
     foreach my $id (sort(keys(%{$spareid}))) {      if (keys(%Apache::lonnet::spareid) > 0) {
  &log($fh,"<li>$id\n</li>");          &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");
     }      }
     &log($fh,"</ol>\n");  
     return $fh;      return $fh;
 }  }
   
Line 336  ENDHEADERS Line 362  ENDHEADERS
 sub clean_tmp {  sub clean_tmp {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');      &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
     my $cleaned=0;      my ($cleaned,$old,$removed) = (0,0,0);
     my $old=0;      my %errors = (
     while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {                       dir       => [],
  my ($dev,$ino,$mode,$nlink,                       file      => [],
     $uid,$gid,$rdev,$size,                       failopen  => [],
     $atime,$mtime,$ctime,                   );
     $blksize,$blocks)=stat($fname);      my %error_titles = (
  my $now=time;                           dir       => 'failed to remove empty directory:',
  my $since=$now-$mtime;                           file      => 'failed to unlike stale file',
  if ($since>$perlvar{'lonExpire'}) {                           failopen  => 'failed to open file or directory'
     my $line='';                         );
     if (open(PROBE,$fname)) {      ($cleaned,$old,$removed) = &recursive_clean_tmp('',$cleaned,$old,$removed,\%errors);
  $line=<PROBE>;      &log($fh,"Cleaned up: ".$cleaned." files; removed: $removed empty directories; (found: $old old checkout tokens)");
  close(PROBE);      foreach my $key (sort(keys(%errors))) {
     }          if (ref($errors{$key}) eq 'ARRAY') {
     unless ($line=~/^CHECKOUTTOKEN\&/) {              if (@{$errors{$key}} > 0) {
  $cleaned++;                  &log($fh,"Error during cleanup ($error_titles{$key}):<ul><li>".
  unlink("$fname");                       join('</li><li><tt>',@{$errors{$key}}).'</tt></li></ul><br />');
     } else {              }
  if ($since>365*$perlvar{'lonExpire'}) {          }
     $cleaned++;      }
     unlink("$fname");  }
  } else { $old++; }  
     }  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);
     }      }
     &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens).");      return ($cleaned,$old,$removed);
 }  }
   
 # ------------------------------------------------------------ clean out lonIDs  # ------------------------------------------------------------ clean out lonIDs
Line 380  sub clean_lonIDs { Line 500  sub clean_lonIDs {
  my $since=$now-$mtime;   my $since=$now-$mtime;
  if ($since>$perlvar{'lonExpire'}) {   if ($since>$perlvar{'lonExpire'}) {
     $cleaned++;      $cleaned++;
     &log($fh,"Unlinking $fname<br>");      &log($fh,"Unlinking $fname<br />");
     unlink("$fname");      unlink("$fname");
  } else {   } else {
     $active++;      $active++;
Line 390  sub clean_lonIDs { Line 510  sub clean_lonIDs {
     &log($fh,"<h3>$active open session(s)</h3>");      &log($fh,"<h3>$active open session(s)</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 sockets
   sub clean_sockets {
       my ($fh)=@_;
       my $cleaned=0;
       opendir(SOCKETS,$perlvar{'lonSockDir'});
       while (my $fname=readdir(SOCKETS)) {
    next if (-d $fname 
    || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
    $cleaned++;
    &log($fh,"Unlinking $fname<br />");
    unlink("/home/httpd/sockets/$fname");
       }
       &log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>");
   }
   
   
 # ----------------------------------------------------------------------- httpd  # ----------------------------------------------------------------------- httpd
 sub check_httpd_logs {  sub check_httpd_logs {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="httpd" /><h2>httpd</h2><h3>Access Log</h3><pre>');      if (open(PIPE,"./lchttpdlogs|")) {
               while (my $line=<PIPE>) {
     open (DFH,"tail -n25 /etc/httpd/logs/access_log|");              &log($fh,$line);
     while (my $line=<DFH>) { &log($fh,&encode_entities($line,'<>&"')) };              if ($line=~/\[error\]/) { $notices++; }
     close (DFH);          }
           close(PIPE);
     &log($fh,"</pre><h3>Error Log</h3><pre>");  
   
     open (DFH,"tail -n25 /etc/httpd/logs/error_log|");  
     while (my $line=<DFH>) {   
  &log($fh,"$line");  
  if ($line=~/\[error\]/) { $notices++; }   
     }      }
     close (DFH);  
     &log($fh,"</pre>");  
     &errout($fh);      &errout($fh);
 }  }
   
Line 417  sub check_httpd_logs { Line 570  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>) { 
Line 436  sub rotate_lonnet_logs { Line 589  sub rotate_lonnet_logs {
     } else { &log($fh,"No perm log\n") }      } else { &log($fh,"No perm log\n") }
   
     my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";      my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
       &rotate_logfile($fname,$fh,'lonnet log');
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
   
     if ($size>40000) {  
  &log($fh,"<p>Rotating logs ...</p>");  
  rename("$fname.2","$fname.3");  
  rename("$fname.1","$fname.2");  
  rename("$fname","$fname.1");  
     }  
   
     &log($fh,"</pre>");      &log($fh,"</pre>");
     &errout($fh);      &errout($fh);
 }  }
   
   sub rotate_other_logs {
       my ($fh) = @_;
       my %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});
       }
   }
   
 # ----------------------------------------------------------------- Connections  # ----------------------------------------------------------------- Connections
 sub test_connections {  sub test_connections {
     my ($fh,$hostname)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');      &log($fh,'<hr /><a name="connections" /><h2>Connections</h2>');
     print "testing connections\n";      print "Testing connections.\n";
     &log($fh,"<table border='2'>");      &log($fh,"<table border='2'>");
     my ($good,$bad)=(0,0);      my ($good,$bad)=(0,0);
     foreach my $tryserver (sort(keys(%{$hostname}))) {      my %hostname = &Apache::lonnet::all_hostnames();
       foreach my $tryserver (sort(keys(%hostname))) {
  print(".");   print(".");
  my $result;   my $result;
  my $answer=reply("ping",$tryserver);   my $answer=&Apache::lonnet::reply("ping",$tryserver);
  if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {   if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
     $result="<b>ok</b>";      $result="<b>ok</b>";
     $good++;      $good++;
Line 490  sub test_connections { Line 648  sub test_connections {
 sub check_delayed_msg {  sub check_delayed_msg {
     my ($fh)=@_;      my ($fh)=@_;
     &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');      &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
     print "checking buffers\n";      print "Checking buffers.\n";
           
     &log($fh,'<h3>Scanning Permanent Log</h3>');      &log($fh,'<h3>Scanning Permanent Log</h3>');
   
     my $unsend=0;      my $unsend=0;
   
       my %hostname = &Apache::lonnet::all_hostnames();
       my $numhosts = scalar(keys(%hostname));
   
     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");      my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
     while (my $line=<$dfh>) {      while (my $line=<$dfh>) {
  my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);   my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
           if ($numhosts) {
               next unless ($hostname{$dserv});
           }
  if ($sdf eq 'F') {    if ($sdf eq 'F') { 
     my $local=localtime($time);      my $local=localtime($time);
     &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br>");      &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />");
     $warnings++;      $warnings++;
  }   }
  if ($sdf eq 'S') { $unsend--; }   if ($sdf eq 'S') { $unsend--; }
Line 509  sub check_delayed_msg { Line 673  sub check_delayed_msg {
     }      }
   
     &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");      &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
     $warnings=$warnings+5*$unsend;      if ($unsend > 0) {
           $warnings=$warnings+5*$unsend;
       }
   
     if ($unsend) { $simplestatus{'unsend'}=$unsend; }      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
     &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");      &log($fh,"<h3>Outgoing Buffer</h3>\n<pre>");
   # list directory with delayed messages and remember offline servers
       my %servers=();
     open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");      open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
     while (my $line=<DFH>) {       while (my $line=<DFH>) {
           my ($server)=($line=~/\.(\w+)$/);
           if ($server) { $servers{$server}=1; }
  &log($fh,&encode_entities($line,'<>&"'));   &log($fh,&encode_entities($line,'<>&"'));
     }      }
     &log($fh,"</pre>\n");      &log($fh,"</pre>\n");
     close (DFH);      close (DFH);
   # pong to all servers that have delayed messages
   # this will trigger a reverse connection, which should flush the buffers
       foreach my $tryserver (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 />");
           }
       }
 }  }
   
 sub finish_logging {  sub finish_logging {
Line 531  sub finish_logging { Line 721  sub finish_logging {
     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 541  sub finish_logging { Line 731  sub finish_logging {
 }  }
   
 sub log_simplestatus {  sub log_simplestatus {
     rename ("$statusdir/newstatus.html","$statusdir/index.html");      rename("$statusdir/newstatus.html","$statusdir/index.html");
           
     my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");      my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
     foreach (keys %simplestatus) {      foreach (keys %simplestatus) {
Line 551  sub log_simplestatus { Line 741  sub log_simplestatus {
     $sfh->close();      $sfh->close();
 }  }
   
   sub write_loncaparevs {
       print "Retrieving LON-CAPA version information.\n";
       my %hostname = &Apache::lonnet::all_hostnames();
       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;
   }
   
   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 {
                       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 {
       my $distro = &LONCAPA::distro();
       if ($distro) {
           print "Retrieving file version and checksumming.\n";
           my $numchksums = 0;
           my ($chksumsref,$versionsref) =
               &LONCAPA::Checksumming::get_checksums($distro,$perlvar{'lonDaemons'},
                                                     $perlvar{'lonLib'},
                                                     $perlvar{'lonIncludes'},
                                                     $perlvar{'lonTabDir'});
           if (ref($chksumsref) eq 'HASH') {
               $numchksums = scalar(keys(%{$chksumsref}));
           }
           print "File version retrieved and checksumming completed for $numchksums files.\n";
       } else {
           print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; 
       }
       return;
   }
   
   sub 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);
           }
       }
   }
   
   sub write_connection_config {
       my ($isprimary,$domconf,$url,%connectssl,%changes);
       my $primaryLibServer = &Apache::lonnet::domain($perlvar{'lonDefDomain'},'primary');
       if ($primaryLibServer eq $perlvar{'lonHostID'}) {
           $isprimary = 1;
       } elsif ($primaryLibServer ne '') {
           my $protocol = $Apache::lonnet::protocol{$primaryLibServer};
           my $hostname = &Apache::lonnet::hostname($primaryLibServer);
           unless ($protocol eq 'https') {
               $protocol = 'http';
           }
           $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl';
       }
       my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary,
                                        $url);
       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_domain_config {
       my ($dom,$primlibserv,$isprimary,$url) = @_;
       my %confhash;
       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 {
           if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) {
               my $config = '';
               while (<PIPE>) {
                   $config .= $_;
               }
               close(PIPE);
               if ($config) {
                   my @pairs=split(/\&/,$config);
                   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;
   }
   
   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 send_mail {  sub send_mail {
     print "sending mail\n";      my $defdom = $perlvar{'lonDefDomain'};
     my $emailto="$perlvar{'lonAdmEMail'}";      my $origmail = $perlvar{'lonAdmEMail'};
       my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                      'lonstatusmail',$defdom,$origmail);
     if ($totalcount>2500) {      if ($totalcount>2500) {
  $emailto.=",$perlvar{'lonSysEMail'}";   $emailto.=",$perlvar{'lonSysEMail'}";
     }      }
     my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";       my $from;
       my $hostname=`/bin/hostname`;
     my $result=system("metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html >& /dev/null");      chop($hostname);
     if ($result != 0) {      $hostname=~s/[^\w\.]//g;
  $result=system("mail -s '$subj' $emailto < $statusdir/index.html");      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     --help     Display 
    --oldlonc  When starting the lonc daemon use 'lonc' not 'loncnew'  
    --noemail  Do not send the status email     --noemail  Do not send the status email
    --justcheckconnections  Only check the current status of the lonc/d     --justcheckconnections  Only check the current status of the lonc/d
                                 connections, do not send emails do not                                  connections, do not send emails do not
Line 581  Options: Line 1141  Options:
                                 running, do not send emails do not                                  running, do not send emails do not
                                 check the lonc/d connections, do not                                  check the lonc/d connections, do not
                                 generate lon-status                                  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  USAGE
 }  }
   
 # ================================================================ Main Program  # ================================================================ Main Program
 sub main () {  sub main () {
     my ($oldlonc,$help,$justcheckdaemons,$noemail,$justcheckconnections);      my ($help,$justcheckdaemons,$noemail,$justcheckconnections,
    $justreload);
     &GetOptions("help"                 => \$help,      &GetOptions("help"                 => \$help,
  "oldlonc"              => \$oldlonc,  
  "justcheckdaemons"     => \$justcheckdaemons,   "justcheckdaemons"     => \$justcheckdaemons,
  "noemail"              => \$noemail,   "noemail"              => \$noemail,
  "justcheckconnections" => \$justcheckconnections   "justcheckconnections" => \$justcheckconnections,
    "justreload"           => \$justreload
  );   );
     if ($help) { &usage(); return; }      if ($help) { &usage(); return; }
 # --------------------------------- Read loncapa_apache.conf and loncapa.conf  # --------------------------------- Read loncapa_apache.conf and loncapa.conf
Line 601  sub main () { Line 1166  sub main () {
     undef $perlvarref;      undef $perlvarref;
     delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed      delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
     delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed      delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
       chdir($perlvar{'lonDaemons'});
 # --------------------------------------- Make sure that LON-CAPA is configured  # --------------------------------------- Make sure that LON-CAPA is configured
 # I only test for one thing here (lonHostID).  This is just a safeguard.  # I only test for one thing here (lonHostID).  This is just a safeguard.
     if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {      if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
Line 619  sub main () { Line 1184  sub main () {
 # ----------------------------- 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");   mailto $emailto -s '$subj' > /dev/null");
  exit 1;   exit 1;
     }      }
   
 # ------------------------------------------------------------- Read hosts file  # -------------------------------------------- Force reload of host information
     my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");      my $nomemcache;
           if ($justcheckdaemons) {
     my (%hostname,%hostdom,%hostrole,%spareid);          $nomemcache=1;
     while (my $configline=<$config>) {          my $memcachepidfile="$perlvar{'lonDaemons'}/logs/memcached.pid";
  next if ($configline =~ /^(\#|\s*\$)/);          my $memcachepid;
  my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);          if (-e $memcachepidfile) {
  if ($id && $domain && $role && $name && $ip) {              my $memfh=IO::File->new($memcachepidfile);
     $hostname{$id}=$name;              $memcachepid=<$memfh>;
     $hostdom{$id}=$domain;              chomp($memcachepid);
     $hostrole{$id}=$role;              if ($memcachepid =~ /^\d+$/ && kill 0 => $memcachepid) {
  }                  undef($nomemcache);
     }              }
     undef $config;          }
       }
 # ------------------------------------------------------ Read spare server file      &Apache::lonnet::load_hosts_tab(1,$nomemcache);
     $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");      &Apache::lonnet::load_domain_tab(1,$nomemcache);
           &Apache::lonnet::get_iphost(1,$nomemcache);
     while (my $configline=<$config>) {  
  chomp($configline);  # ----------------------------------------- Force firewall update for lond port  
  if (($configline) && ($configline ne $perlvar{'lonHostID'})) {  
     $spareid{$configline}=1;      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);
           }
     }      }
     undef $config;  
   
 # ---------------------------------------------------------------- Start report  # ---------------------------------------------------------------- Start report
   
Line 661  sub main () { Line 1240  sub main () {
   
   
     my $fh;      my $fh;
     if (!$justcheckdaemons && !$justcheckconnections) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  $fh=&start_logging(\%hostdom,\%hostrole,\%hostname,\%spareid);   $fh=&start_logging();
   
  &log_machine_info($fh);   &log_machine_info($fh);
  &clean_tmp($fh);   &clean_tmp($fh);
  &clean_lonIDs($fh);   &clean_lonIDs($fh);
           &clean_webDAV_sessionIDs($fh);
  &check_httpd_logs($fh);   &check_httpd_logs($fh);
  &rotate_lonnet_logs($fh);   &rotate_lonnet_logs($fh);
    &rotate_other_logs($fh);
     }      }
     if (!$justcheckconnections) {      if (!$justcheckconnections && !$justreload) {
    &checkon_daemon($fh,'lonmemcached',40000);
  &checkon_daemon($fh,'lonsql',200000);   &checkon_daemon($fh,'lonsql',200000);
  &checkon_daemon($fh,'lond',40000,1);   if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
  my $args='new';      &checkon_daemon($fh,'lond',40000,'USR2');
  if ($oldlonc) { $args = ''; }   }
  &checkon_daemon($fh,'lonc',40000,1,$args);   &checkon_daemon($fh,'lonc',40000,'USR1');
  &checkon_daemon($fh,'lonhttpd',40000);          &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 (!$justcheckdaemons) {      if ($justcheckconnections) {
  &test_connections($fh,\%hostname);   &test_connections($fh);
     }      }
     if (!$justcheckdaemons && !$justcheckconnections) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  &check_delayed_msg($fh);   &check_delayed_msg($fh);
  &finish_logging($fh);  
  &log_simplestatus();   &log_simplestatus();
           &write_loncaparevs();
           &write_serverhomeIDs();
    &write_checksums();
           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);
  if ($totalcount>200 && !$noemail) { &send_mail(); }   if ($totalcount>200 && !$noemail) { &send_mail(); }
     }      }
 }  }
Line 693  sub main () { Line 1295  sub main () {
 &main();  &main();
 1;  1;
   
   
   
   
   
   
   
   

Removed from v.1.55  
changed lines
  Added in v.1.110


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.