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

Diff for /loncom/loncron between versions 1.76 and 1.95.10.1

version 1.76, 2007/06/22 00:20:27 version 1.95.10.1, 2012/02/17 22:47:39
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;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon;
   
 use IO::File;  use IO::File;
 use IO::Socket;  use IO::Socket;
Line 304  sub start_logging { Line 306  sub start_logging {
 <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 347  ENDHEADERS Line 348  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 408  sub clean_sockets { Line 503  sub clean_sockets {
     opendir(SOCKETS,$perlvar{'lonSockDir'});      opendir(SOCKETS,$perlvar{'lonSockDir'});
     while (my $fname=readdir(SOCKETS)) {      while (my $fname=readdir(SOCKETS)) {
  next if (-d $fname    next if (-d $fname 
  || $fname=~/(mysqlsock|maximasock|\Q$perlvar{'lonSockDir'}\E)/);   || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
  $cleaned++;   $cleaned++;
  &log($fh,"Unlinking $fname<br />");   &log($fh,"Unlinking $fname<br />");
  unlink("/home/httpd/sockets/$fname");   unlink("/home/httpd/sockets/$fname");
Line 420  sub clean_sockets { Line 515  sub clean_sockets {
 # ----------------------------------------------------------------------- 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 470  sub rotate_lonnet_logs { Line 557  sub rotate_lonnet_logs {
   
 sub rotate_other_logs {  sub rotate_other_logs {
     my ($fh) = @_;      my ($fh) = @_;
     my $fname="$perlvar{'lonDaemons'}/logs/autoenroll.log";      my %logs = (
     &rotate_logfile($fname,$fh,'Auto Enroll log');                    autoenroll          => 'Auto Enroll log',
     $fname="$perlvar{'lonDaemons'}/logs/autocreate.log";                    autocreate          => 'Create Course log',
     &rotate_logfile($fname,$fh,'Create Course log');                    searchcat           => 'Search Cataloguing log',
     $fname="$perlvar{'lonDaemons'}/logs/searchcat.log";                    autoupdate          => 'Auto Update log',
     &rotate_logfile($fname,$fh,'Search Cataloguing 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
Line 535  sub check_delayed_msg { Line 627  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>");
Line 549  sub check_delayed_msg { Line 643  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 (keys %servers) {      foreach my $tryserver (sort(keys(%servers))) {
  my $answer=&Apache::lonnet::reply("pong",$tryserver);          if ($hostname{$tryserver} || !$numhosts) {
  &log($fh,"Pong to $tryserver: $answer<br />");              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 />");
           }
     }      }
 }  }
   
Line 586  sub log_simplestatus { Line 697  sub log_simplestatus {
     $sfh->close();      $sfh->close();
 }  }
   
   sub write_loncaparevs {
       print "Retrieving LON-CAPA version information\n";
       if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
           my %hostname = &Apache::lonnet::all_hostnames();
           foreach my $id (sort(keys(%hostname))) {
               if ($id ne '') {
                   my $loncaparev;
                   eval {
                       local $SIG{ ALRM } = sub { die "TIMEOUT" };
                       alarm(10);
                       $loncaparev =
                           &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
                       alarm(0);
                   };
                   if ($@ && $@ =~ m/TIMEOUT/) {
                       print "time out while contacting lonHost: $id for version\n";   
                   }
                   if ($loncaparev =~ /^[\w.\-]+$/) {
                       print $fh $id.':'.$loncaparev."\n";
                   }
               }
           }
           close($fh);
       }
       return;
   }
   
   sub write_serverhomeIDs {
       print "Retrieving LON-CAPA lonHostID information\n";
       if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
           my %name_to_host = &Apache::lonnet::all_names();
           foreach my $name (sort(keys(%name_to_host))) {
               if ($name ne '') {
                   if (ref($name_to_host{$name}) eq 'ARRAY') {
                       my $serverhomeID;
                       eval {
                           local $SIG{ ALRM } = sub { die "TIMEOUT" };
                           alarm(10);
                           $serverhomeID = 
                               &Apache::lonnet::get_server_homeID($name,1,'loncron');
                           alarm(0);
                       };
                       if ($@ && $@ =~ m/TIMEOUT/) {
                           print "Time out while contacting server: $name\n"; 
                       }
                       if ($serverhomeID ne '') {
                           print $fh $name.':'.$serverhomeID."\n";
                       } else {
                           print $fh $name.':'.$name_to_host{$name}->[0]."\n";
                       }
                   }
               }
           }
           close($fh);
       }
       return;
   }
   
 sub send_mail {  sub send_mail {
     print "sending mail\n";      print "sending mail\n";
     my $emailto="$perlvar{'lonAdmEMail'}";      my $defdom = $perlvar{'lonDefDomain'};
       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'}";
     }      }
Line 640  sub main () { Line 812  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
       delete $perlvar{'reCAPTCHA_PRIVATE'}; # remove since sensitive and not needed 
       delete $perlvar{'reCAPTCHA_PUBLIC'}; # remove since sensitive and not needed
     chdir($perlvar{'lonDaemons'});      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.
Line 671  sub main () { Line 845  sub main () {
     &Apache::lonnet::load_domain_tab(1);      &Apache::lonnet::load_domain_tab(1);
     &Apache::lonnet::get_iphost(1);      &Apache::lonnet::get_iphost(1);
   
   # ----------------------------------------- Force firewall update for lond port  
   
       if ((!$justcheckdaemons) && (!$justreload)) {
           my $now = time;
           my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
                         $now.$$.int(rand(10000));
           if (open(my $fh,">$tmpfile")) {
               my %iphosts = &Apache::lonnet::get_iphost();
               foreach my $key (keys(%iphosts)) {
                   print $fh "$key\n";
               }
               close($fh);
               if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {
                   my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
                   system("$execpath $tmpfile");
                   unlink('/tmp/lock_lciptables');  # Remove the lock file. 
               }
               unlink($tmpfile);
           }
       }
   
 # ---------------------------------------------------------------- Start report  # ---------------------------------------------------------------- Start report
   
     $errors=0;      $errors=0;
Line 696  sub main () { Line 891  sub main () {
     &checkon_daemon($fh,'lond',40000,'USR2');      &checkon_daemon($fh,'lond',40000,'USR2');
  }   }
  &checkon_daemon($fh,'lonc',40000,'USR1');   &checkon_daemon($fh,'lonc',40000,'USR1');
  &checkon_daemon($fh,'lonhttpd',40000);  
         &checkon_daemon($fh,'lonmaxima',40000);          &checkon_daemon($fh,'lonmaxima',40000);
           &checkon_daemon($fh,'lonr',40000);
     }      }
     if ($justreload) {      if ($justreload) {
  &checkon_daemon($fh,'lond',40000,'USR2');   &checkon_daemon($fh,'lond',40000,'USR2');
Line 710  sub main () { Line 905  sub main () {
  &check_delayed_msg($fh);   &check_delayed_msg($fh);
  &finish_logging($fh);   &finish_logging($fh);
  &log_simplestatus();   &log_simplestatus();
           &write_loncaparevs();
           &write_serverhomeIDs();
   
  if ($totalcount>200 && !$noemail) { &send_mail(); }   if ($totalcount>200 && !$noemail) { &send_mail(); }
     }      }
Removed from v.1.76  
changed lines
  Added in v.1.95.10.1

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.