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

Diff for /loncom/loncron between versions 1.103.2.12 and 1.104

version 1.103.2.12, 2021/02/02 21:27:34 version 1.104, 2017/02/28 05:42:06
Line 37  use LONCAPA; Line 37  use LONCAPA;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
   
 use LWP::UserAgent();  
 use HTTP::Request();  
 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 qw(GDBM_READER);  use GDBM_File;
 use Storable qw(thaw);  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 81  sub rotate_logfile { Line 75  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 119  sub checkon_daemon { Line 113  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 ($fh) {      if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
         if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){   open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
     if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {   while (my $line=<DFH>) { 
         while (my $line=<DFH>) {      &log($fh,"$line");
             &log($fh,"$line");      if ($line=~/INFO/) { $notices++; }
             if ($line=~/INFO/) { $notices++; }      if ($line=~/WARNING/) { $notices++; }
             if ($line=~/WARNING/) { $notices++; }      if ($line=~/CRITICAL/) { $warnings++; }
             if ($line=~/CRITICAL/) { $warnings++; }   };
         }   close (DFH);
         close (DFH);  
             }  
         }  
         &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 175  sub checkon_daemon { Line 166  sub checkon_daemon {
     `killall -9 $kadaemon 2>&1`.      `killall -9 $kadaemon 2>&1`.
     '</font><br />');      '</font><br />');
  &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 200  sub checkon_daemon { Line 191  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"){  
         &log($fh,"<p><pre>");  
         if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {  
             while (my $line=<DFH>) {   
         &log($fh,"$line");  
         if ($line=~/WARNING/) { $notices++; }  
         if ($line=~/CRITICAL/) { $notices++; }  
             }  
             close (DFH);  
                 }  
         &log($fh,"</pre></p>");  
     }  
         }  
     }  
   
    if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
       &log($fh,"<p><pre>");
       open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
       while (my $line=<DFH>) { 
    &log($fh,"$line");
    if ($line=~/WARNING/) { $notices++; }
    if ($line=~/CRITICAL/) { $notices++; }
       };
       close (DFH);
       &log($fh,"</pre></p>");
    }
       }
       
     my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";      my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
     &rotate_logfile($fname,$fh,'logs');      &rotate_logfile($fname,$fh,'logs');
   
Line 228  sub log_machine_info { Line 217  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]>$loadtarget{'error'}) {      if ($parts[1]>4.0) {
  $errors++;   $errors++;
     } elsif ($parts[1]>$loadtarget{'warn'}) {      } elsif ($parts[1]>2.0) {
  $warnings++;   $warnings++;
     } elsif ($parts[1]>$loadtarget{'note'}) {      } elsif ($parts[1]>1.0) {
  $notices++;   $notices++;
     }      }
   
Line 263  sub log_machine_info { Line 237  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 287  sub log_machine_info { Line 261  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 310  sub start_logging { Line 284  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));
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">  <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
Line 426  sub recursive_clean_tmp { Line 400  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 484  sub recursive_clean_tmp { Line 458  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 510  sub clean_lonIDs { Line 484  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 $now=time;   my ($dev,$ino,$mode,$nlink,
         if (-l $fname) {      $uid,$gid,$rdev,$size,
             my $linkfname = readlink($fname);      $atime,$mtime,$ctime,
             if (-f $linkfname) {      $blksize,$blocks)=stat($fname);
                 if ($linkfname =~ m{^$perlvar{'lonIDsDir'}/[^/]+\.id$}) {   my $now=time;
                     my @data = stat($linkfname);   my $since=$now-$mtime;
                     my $mtime = $data[9];   if ($since>$perlvar{'lonExpire'}) {
                     my $since=$now-$mtime;      $cleaned++;
                     if ($since>$perlvar{'lonExpire'}) {      &log($fh,"Unlinking $fname<br />");
                         if (unlink($linkfname)) {      unlink("$fname");
                             $cleaned++;   } else {
                             &log($fh,"Unlinking $linkfname<br />");      $active++;
                             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  # ------------------------------------------------ clean out webDAV Session IDs
 sub clean_webDAV_sessionIDs {  sub clean_webDAV_sessionIDs {
     my ($fh)=@_;      my ($fh)=@_;
Line 638  sub rotate_lonnet_logs { Line 565  sub rotate_lonnet_logs {
     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 711  sub test_connections { Line 638  sub test_connections {
   
 # ------------------------------------------------------------ Delayed messages  # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {  sub check_delayed_msg {
     my ($fh,$weightsref,$exclusionsref)=@_;      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 $ignored=0;  
   
     my %hostname = &Apache::lonnet::all_hostnames();      my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
     my $numhosts = scalar(keys(%hostname));      while (my $line=<$dfh>) {
     my $checkbackwards = 0;   my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
     my $checkfrom = 0;   if ($sdf eq 'F') { 
     my $checkexcluded = 0;      my $local=localtime($time);
     my (%bymachine,%weights,%exclusions,%serverhomes);      &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />");
     if (ref($weightsref) eq 'HASH') {      $warnings++;
         %weights = %{$weightsref};   }
     }   if ($sdf eq 'S') { $unsend--; }
     if (ref($exclusionsref) eq 'HASH') {   if ($sdf eq 'D') { $unsend++; }
         %exclusions = %{$exclusionsref};  
         if (keys(%exclusions)) {  
             $checkexcluded = 1;  
             %serverhomes = &read_serverhomeIDs();  
         }  
     }  
   
 #  
 # For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any  
 # 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) {      &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");
         if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {      if ($unsend > 0) {
             while(my $line=<BW>) {          $warnings=$warnings+5*$unsend;
                 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 918  sub check_delayed_msg { Line 675  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 942  sub check_delayed_msg { Line 701  sub check_delayed_msg {
 }  }
   
 sub finish_logging {  sub finish_logging {
     my ($fh,$weightsref)=@_;      my ($fh)=@_;
     my %weights;  
     if (ref($weightsref) eq 'HASH') {  
         %weights = %{$weightsref};  
     }  
     &log($fh,"<a name='errcount' />\n");      &log($fh,"<a name='errcount' />\n");
     $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors);      $totalcount=$notices+4*$warnings+100*$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;
Line 1017  sub write_serverhomeIDs { Line 772  sub write_serverhomeIDs {
                 eval {                  eval {
                     local $SIG{ ALRM } = sub { die "TIMEOUT" };                      local $SIG{ ALRM } = sub { die "TIMEOUT" };
                     alarm(10);                      alarm(10);
                     $serverhomeID =                      $serverhomeID = 
                         &Apache::lonnet::get_server_homeID($name,1,'loncron');                          &Apache::lonnet::get_server_homeID($name,1,'loncron');
                     alarm(0);                      alarm(0);
                 };                  };
Line 1062  sub write_checksums { Line 817  sub write_checksums {
     return;      return;
 }  }
   
 sub write_hostips {  sub write_connection_config {
     my $lontabdir = $perlvar{'lonTabDir'};      my ($isprimary,$domconf,$url,%connectssl);
     my $defdom = $perlvar{'lonDefDomain'};      my $primaryLibServer = &Apache::lonnet::domain($perlvar{'lonDefDomain'},'primary');
     my $lonhost = $perlvar{'lonHostID'};      if ($primaryLibServer eq $perlvar{'lonHostID'}) {
     my $newfile = "$lontabdir/currhostips.tab";          $isprimary = 1;
     my $oldfile = "$lontabdir/prevhostips.tab";      } elsif ($primaryLibServer ne '') {
     my (%prevhosts,%currhosts,%ipchange);          my $protocol = $Apache::lonnet::protocol{$primaryLibServer};
     if ((-e $newfile) && (-s $newfile)) {          my $hostname = &Apache::lonnet::hostname($primaryLibServer);
         move($newfile,$oldfile);          unless ($protocol eq 'https') {
         chmod(0644,$oldfile);              $protocol = 'http';
         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);  
         }          }
           $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl';
     }      }
     if (keys(%prevhosts) && keys(%currhosts)) {      my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary,
         foreach my $key (keys(%prevhosts)) {                                       $url);
             unless ($currhosts{$key} eq $prevhosts{$key}) {      if (ref($domconf) eq 'HASH') {
                 $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};          if (ref($domconf->{'ssl'}) eq 'HASH') {
             }              foreach my $connect ('connto','connfrom') {
         }                  if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') {
         foreach my $key (keys(%currhosts)) {                      my ($sslreq,$sslnoreq,$currsetting);
             unless ($currhosts{$key} eq $prevhosts{$key}) {                      my %contypes;
                 $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};                      foreach my $type ('dom','intdom','other') {
                           $connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type};
                       }
                   }
             }              }
         }          }
     }          if (keys(%connectssl)) {
     if (&Apache::lonnet::domain($defdom,'primary') eq $lonhost) {              if (open(my $fh,">$perlvar{'lonTabDir'}/connectionrules.tab")) {
         if (keys(%ipchange)) {                  my $count = 0;
             if (open(my $fh,'>>',$perlvar{'lonDaemons'}.'/logs/hostip.log')) {                  foreach my $key (sort(keys(%connectssl))) { 
                print $fh "********************\n".localtime(time).' Changes --'."\n".                      print $fh "$key=$connectssl{$key}\n";
                          "| Hostname | Previous IP | New IP |\n".                      $count ++;
                          " --------------------------------- \n";  
                foreach my $hostname (sort(keys(%ipchange))) {  
                     print $fh "| $hostname | $ipchange{$hostname} |\n";  
                 }                  }
                 print $fh "\n*******************\n\n";  
                 close($fh);                  close($fh);
                   print "Completed writing SSL options for lonc/lond for $count items.\n";
             }              }
             my $emailto = &Apache::loncommon::build_recipient_list(undef,          } else {
                                    'hostipmail',$defdom);              print "Writing of SSL options skipped - no connection rules in domain configuration.\n";
             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";  
                 }  
             }  
         }          }
       } else {
           print "Retrieval of SSL options for lonc/lond skipped - no configuration data available for domain.\n";
     }      }
     return;  
 }  }
   
 sub get_domain_config {  sub get_domain_config {
     my ($dom,$primlibserv,$isprimary,$url,%confhash);      my ($dom,$primlibserv,$isprimary,$url) = @_;
     $dom = $perlvar{'lonDefDomain'};      my %confhash;
     $primlibserv = &Apache::lonnet::domain($dom,'primary');  
     if ($primlibserv eq $perlvar{'lonHostID'}) {  
         $isprimary = 1;  
     } elsif ($primlibserv ne '') {  
         my $protocol = $Apache::lonnet::protocol{$primlibserv};  
         my $hostname = &Apache::lonnet::hostname($primlibserv);  
         unless ($protocol eq 'https') {  
             $protocol = 'http';  
         }  
         $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl?primary='.$primlibserv.'&format=raw';  
     }  
     if ($isprimary) {      if ($isprimary) {
         my $lonusersdir = $perlvar{'lonUsersDir'};          my $lonusersdir = $perlvar{'lonUsersDir'};
         my $fname = $lonusersdir.'/'.$dom.'/configuration.db';          my $fname = $lonusersdir.'/'.$dom.'/configuration.db';
Line 1183  sub get_domain_config { Line 884  sub get_domain_config {
             }              }
         }          }
     } else {      } else {
         my $ua=new LWP::UserAgent;          if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) {
         $ua->timeout(5);              my $config = '';
         my $request=new HTTP::Request('GET',$url);              while (<PIPE>) {
         my $response=$ua->request($request);                  $config .= $_;
         unless ($response->is_error()) {              }
             my $content = $response->content;              close(PIPE);
             if ($content) {              if ($config) {
                 my @pairs=split(/\&/,$content);                  my @pairs=split(/\&/,$config);
                 foreach my $item (@pairs) {                  foreach my $item (@pairs) {
                     my ($key,$value)=split(/=/,$item,2);                      my ($key,$value)=split(/=/,$item,2);
                     my $what = &LONCAPA::unescape($key);                      my $what = &LONCAPA::unescape($key);
Line 1207  sub get_domain_config { Line 908  sub get_domain_config {
     return \%confhash;      return \%confhash;
 }  }
   
 sub get_permcount_settings {  sub write_hosttypes {
     my ($domconf) = @_;      my %intdom = &Apache::lonnet::all_host_intdom();
     my ($defaults,$names) = &Apache::loncommon::lon_status_items();      my %hostdom = &Apache::lonnet::all_host_domain();
     my (%weights,$threshold,$sysmail,$reportstatus,%exclusions);      my $dom = $hostdom{$perlvar{'lonHostID'}};
     foreach my $type ('E','W','N','U') {      my $internetdom = $intdom{$perlvar{'lonHostID'}};
         $weights{$type} = $defaults->{$type};      if (($dom ne '') && ($internetdom ne '')) {
     }          if (keys(%hostdom)) {
     $threshold = $defaults->{'threshold'};              if (open(my $fh,">$perlvar{'lonTabDir'}/hosttypes.tab")) {
     $sysmail = $defaults->{'sysmail'};                  my $count = 0;
     $reportstatus = 1;                  foreach my $lonid (sort(keys(%hostdom))) {
     if (ref($domconf) eq 'HASH') {                      my $type = 'other';
         if (ref($domconf->{'contacts'}) eq 'HASH') {                      if ($hostdom{$lonid} eq $dom) {
             if ($domconf->{'contacts'}{'reportstatus'} == 0) {                          $type = 'dom'; 
                 $reportstatus = 0;                      } elsif ($intdom{$lonid} eq $internetdom) {
             }                          $type = 'intdom';
             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};  
                         }  
                     }                      }
                       print $fh "$lonid:$type\n";
                       $count ++;
                 }                  }
                 if (ref($domconf->{'contacts'}{'lonstatus'}{'excluded'}) eq 'ARRAY') {                  close($fh);
                     my @excluded = @{$domconf->{'contacts'}{'lonstatus'}{'excluded'}};                  print "Completed writing host type data for $count hosts.\n";
                     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);          } 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 %server;  
 }  }
   
 sub send_mail {  sub send_mail {
     my ($sysmail,$reportstatus) = @_;  
     my $defdom = $perlvar{'lonDefDomain'};      my $defdom = $perlvar{'lonDefDomain'};
     my $origmail = $perlvar{'lonAdmEMail'};      my $origmail = $perlvar{'lonAdmEMail'};
     my $emailto = &Apache::loncommon::build_recipient_list(undef,      my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                    'lonstatusmail',$defdom,$origmail);                                     'lonstatusmail',$defdom,$origmail);
     if (($totalcount>$sysmail) && ($reportstatus)) {      if ($totalcount>2500) {
  $emailto.=",$perlvar{'lonSysEMail'}";   $emailto.=",$perlvar{'lonSysEMail'}";
     }      }
     my $from;      my $from;
Line 1322  Options: Line 996  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,$justiptables);   $justreload);
     &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 1353  sub main () { Line 1023  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 = Sys::Hostname::FQDN::fqdn();   my $hostname=`/bin/hostname`;
  $hostname=~s/\.+/./g;   chop $hostname;
  $hostname=~s/\-+/-/g;   $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
  $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.' |\
                " mail -s '$subj' $emailto > /dev/null");   mailto $emailto -s '$subj' > /dev/null");
  exit 1;   exit 1;
     }      }
   
Line 1369  sub main () { Line 1038  sub main () {
  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.' |\
                " mail -s '$subj' $emailto > /dev/null");   mailto $emailto -s '$subj' > /dev/null");
  exit 1;   exit 1;
     }      }
   
Line 1389  sub main () { Line 1058  sub main () {
             }              }
         }          }
     }      }
     if (!$justiptables) {      &Apache::lonnet::load_hosts_tab(1,$nomemcache);
         &Apache::lonnet::load_hosts_tab(1,$nomemcache);      &Apache::lonnet::load_domain_tab(1,$nomemcache);
         &Apache::lonnet::load_domain_tab(1,$nomemcache);      &Apache::lonnet::get_iphost(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 1410  sub main () { Line 1077  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 1422  sub main () { Line 1089  sub main () {
     $warnings=0;      $warnings=0;
     $notices=0;      $notices=0;
   
   
     my $fh;      my $fh;
     if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  $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_webDAV_sessionIDs($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 && !$justiptables) {      if (!$justcheckconnections && !$justreload) {
  &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 1447  sub main () { Line 1113  sub main () {
         &checkon_daemon($fh,'lonr',40000);          &checkon_daemon($fh,'lonr',40000);
     }      }
     if ($justreload) {      if ($justreload) {
           &write_connection_config();
           &write_hosttypes();
  &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 && !$justiptables) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
         my $domconf = &get_domain_config();   &check_delayed_msg($fh);
         my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =   &finish_logging($fh);
             &get_permcount_settings($domconf);  
  &check_delayed_msg($fh,$weightsref,$exclusionsref);  
  &finish_logging($fh,$weightsref);  
  &log_simplestatus();   &log_simplestatus();
         &write_loncaparevs();          &write_loncaparevs();
         &write_serverhomeIDs();          &write_serverhomeIDs();
  &write_checksums();   &write_checksums();
         &write_hostips();          &write_connection_config();
         if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); }          &write_hosttypes();
    if ($totalcount>200 && !$noemail) { &send_mail(); }
     }      }
 }  }
   
Removed from v.1.103.2.12  
changed lines
  Added in v.1.104

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.