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

Diff for /loncom/loncron between versions 1.103.2.7 and 1.114

version 1.103.2.7, 2020/05/06 14:40:08 version 1.114, 2018/11/18 22:50:46
Line 41  use IO::File; Line 41  use IO::File;
 use IO::Socket;  use IO::Socket;
 use HTML::Entities;  use HTML::Entities;
 use Getopt::Long;  use Getopt::Long;
 use File::Copy;  use GDBM_File;
 use Sys::Hostname::FQDN();  use Storable qw(thaw);
   use File::ReadBackwards;
 #globals  #globals
 use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);  use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
   
Line 117  sub checkon_daemon { Line 117  sub checkon_daemon {
     if ($fh) {      if ($fh) {
         if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){          if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
     if (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++; }
Line 128  sub checkon_daemon { Line 128  sub checkon_daemon {
         }          }
         &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;
Line 169  sub checkon_daemon { Line 169  sub checkon_daemon {
  &log($fh,unlink($pidfile).' - '.   &log($fh,unlink($pidfile).' - '.
     `killall -9 $kadaemon 2>&1`.      `killall -9 $kadaemon 2>&1`.
     '</font><br />');      '</font><br />');
           if ($kadaemon eq 'loncnew') {
               &clean_lonc_childpids();
           }
  &log($fh,"<h3>$daemon not running, trying to start</h3>");   &log($fh,"<h3>$daemon not running, trying to start</h3>");
   
  if (&start_daemon($fh,$daemon,$pidfile,$args)) {   if (&start_daemon($fh,$daemon,$pidfile,$args)) {
Line 207  sub checkon_daemon { Line 210  sub checkon_daemon {
             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";
Line 490  sub clean_lonIDs { Line 493  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{'balanceDir'}/*.id>) {  
             my ($dev,$ino,$mode,$nlink,  
                 $uid,$gid,$rdev,$size,  
                 $atime,$mtime,$ctime,  
                 $blksize,$blocks)=stat($fname);  
             my $now=time;  
             my $since=$now-$mtime;  
             if ($since>$perlvar{'lonExpire'}) {  
                 $cleaned++;  
                 &log($fh,"Unlinking $fname<br />");  
                 unlink("$fname");  
             } else {  
                 $active++;  
             }  
         }  
     }  
     &log($fh,"<p>Cleaned up ".$cleaned." stale balancer files</p>");  
     &log($fh,"<h3>$active unexpired balancer files</h3>");  
 }  
   
 # ------------------------------------------------ clean out webDAV Session IDs  # ------------------------------------------------ clean out webDAV Session IDs
 sub clean_webDAV_sessionIDs {  sub clean_webDAV_sessionIDs {
     my ($fh)=@_;      my ($fh)=@_;
Line 691  sub test_connections { Line 647  sub test_connections {
   
 # ------------------------------------------------------------ Delayed messages  # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {  sub check_delayed_msg {
     my ($fh)=@_;      my ($fh,$weightsref,$exclusionsref)=@_;
     &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');      &log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
     print "Checking buffers.\n";      print "Checking buffers.\n";
           
     &log($fh,'<h3>Scanning Permanent Log</h3>');      &log($fh,'<h3>Scanning Permanent Log</h3>');
   
     my $unsend=0;      my $unsend=0;
       my $ignored=0;
   
     my %hostname = &Apache::lonnet::all_hostnames();      my %hostname = &Apache::lonnet::all_hostnames();
     my $numhosts = scalar(keys(%hostname));      my $numhosts = scalar(keys(%hostname));
       my $checkbackwards = 0;
     my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");      my $checkfrom = 0;
     while (my $line=<$dfh>) {      my $checkexcluded = 0;
  my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);      my (%bymachine,%weights,%exclusions,%serverhomes);
         if ($numhosts) {      if (ref($weightsref) eq 'HASH') {
             next unless ($hostname{$dserv});          %weights = %{$weightsref};
         }      }
  if ($sdf eq 'F') {       if (ref($exclusionsref) eq 'HASH') {
     my $local=localtime($time);          %exclusions = %{$exclusionsref};
     &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />");          if (keys(%exclusions)) {
     $warnings++;              $checkexcluded = 1;
  }              %serverhomes = &read_serverhomeIDs();
  if ($sdf eq 'S') { $unsend--; }          }
  if ($sdf eq 'D') { $unsend++; }  
     }      }
   
     &log($fh,"<p>Total unsend messages: <b>$unsend</b></p>\n");  #
     if ($unsend > 0) {  # For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any
         $warnings=$warnings+5*$unsend;  # entry logged in lonnet.perm.log for completion of a delayed (critical)
   # transaction lacked the hostID for the remote node to which the command
   # to be completed was sent.
   #
   # Because of this, exclusion of items in lonnet.perm.log for nodes which are
   # no longer part of the cluster from adding to the overall "unsend" count
   # needs additional effort besides the changes made in loncron rev. 1.105.
   #
   # For "S" (completion) events logging in LON-CAPA 1.2.0 through 2.1.3 included
   # "LondTransaction=HASH(hexadecimal)->getClient() :$cmd, where the hexadecimal
   # is a memory location, and $cmd is the command sent to the remote node.
   #
   # Starting with 2.2.0 (released 8/21/2006) logging for "S" (completion) events
   # had sethost:$host_id:$cmd after LondTransaction=HASH(hexadecimal)->getClient()
   #
   # Starting with 2.4.1 (released 6/13/2007) logging for "S" replaced echoing the
   # getClient() call with the result of the Transaction->getClient() call itself
   # undef for completion of delivery of a delayed message.
   #
   # The net effect of these changes is that lonnet.perm.log is now accessed three
   # times: (a) oldest record is checked, if earlier than release date for 2.5.0
   # then (b) file is read backwards, with timestamp recorded for most recent
   # instance of logged "S" event for "update" command without "sethost:$host_id:"
   # then (c) file is read forward with records ignored which predate the timestamp
   # recorded in (b), if one was found.
   #
   # In (c), when calculating the unsend total, i.e., the difference between delayed
   # transactions ("D") and sent transactions ("S"), transactions are ignored if the
   # target node is no longer in the cluster, and also (for "update" commands), if
   # the target node is in the list of nodes excluded from the count, in the domain
   # configuration for this machine's default domain.  The idea here is to remove
   # delayed "update" commands for nodes for which inbound access to port 5663,
   # is blocked, but are still part of the LON-CAPA network, (i.e., they can still
   # replicate content from other nodes).
   #
   
       my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r");
       if (defined($dfh)) {
           while (my $line=<$dfh>) {
               my ($time,$sdf,$rest)=split(/:/,$line,3);
               if ($time < 1541185772) {
                   $checkbackwards = 1;
               }
               last;
           }
           undef $dfh;
       } 
   
       if ($checkbackwards) {
           if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
               while(my $line=<BW>) {
                   if ($line =~ /\QLondTransaction=HASH\E[^:]+:update:/) {
                       ($checkfrom) = split(/:/,$line,2);
                       last;
                   }
               }
               close(BW);
           }
       }
       $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r");
       if (defined($dfh)) {
           while (my $line=<$dfh>) {
               my ($time,$sdf,$rest)=split(/:/,$line,3);
               next unless (($sdf eq 'F') || ($sdf eq 'S') || ($sdf eq 'D'));
               next if (($checkfrom) && ($time <= $checkfrom));
               my ($dserv,$dcmd);
               if ($sdf eq 'S') {
                   my ($serva,$cmda,$servb,$cmdb) = split(/:/,$rest);
                   if ($cmda eq 'sethost') {
                       chomp($cmdb);
                       $dcmd = $cmdb;
                   } else {
                       $dcmd = $cmda;
                   }
                   if (($serva =~ /^LondTransaction/) || ($serva eq '')) {
                       unless (($servb eq '') || ($servb =~ m{^/})) {
                           $dserv = $servb;
                       }
                   } else {
                       $dserv = $serva;
                   }
               } else {
                   ($dserv,$dcmd) = split(/:/,$rest);
               }
               if ($sdf eq 'F') {
                   my $local=localtime($time);
                   &log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />");
                   $warnings++;
               }
               next if ((($dserv eq '') || ($dcmd eq '')) && ($sdf ne 'F'));
               if ($sdf eq 'S') {
                   if ($dcmd eq 'update') {
                       if ($hostname{$dserv}) {
                           if ($exclusions{$serverhomes{$hostname{$dserv}}}) {
                               $ignored --;
                           } else {
                               $unsend --;
                           }
                       }
                       if (exists($bymachine{$dserv})) {
                           $bymachine{$dserv} --;
                       } else {
                           $bymachine{$dserv} = -1;
                       }
                   } else {
                       if ($hostname{$dserv}) {
                           $unsend --;
                       }
                   }
               } elsif ($sdf eq 'D') {
                   if ($dcmd eq 'update') {
                       if ($hostname{$dserv}) {
                           if ($exclusions{$serverhomes{$hostname{$dserv}}}) {
                               $ignored ++;
                           } else {
                               $unsend ++;
                           }
                       }
                       if (exists($bymachine{$dserv})) {
                           $bymachine{$dserv} ++;
                       } else {
                           $bymachine{$dserv} = 1;
                       }
                   } else {
                       if ($hostname{$dserv}) {
                           $unsend ++;
                       }
                   }
               }
           }
           undef $dfh;
           my $nodest = 0;
           my $retired = 0;
           my %active;
           if (keys(%bymachine)) {
               unless ($checkexcluded) {
                   %serverhomes = &read_serverhomeIDs();
               }
               foreach my $key (keys(%bymachine)) {
                   if ($bymachine{$key} > 0) {
                       if ($hostname{$key}) {
                           $active{$serverhomes{$hostname{$key}}} += $bymachine{$key};
                       } else {
                           $retired ++;
                           $nodest += $bymachine{$key};
                       }
                   }
               }
           }
           if (keys(%active)) {
               &log($fh,"<p>Unsend messages by node, active (undegraded) nodes in cluster</p>\n");
               foreach my $key (sort(keys(%active))) {
                   &log($fh,&encode_entities("$key => $active{$key}",'<>&"')."\n");
               }
           }
           &log($fh,"<p>Total unsend messages: <b>$unsend</b> for ".scalar(keys(%active))." active (undegraded) nodes in cluster.</p>\n");
           if (keys(%exclusions) > 0) {
               &log($fh,"<p>Total incomplete updates <b>$ignored</b> for ".scalar(keys(%exclusions))." degraded nodes in cluster.</p>\n");
           }
           if ($retired) {
               &log($fh,"<p>Total unsent <b>$nodest</b> for $retired nodes no longer in cluster.</p>\n");
           }
           if ($unsend > 0) {
               $warnings=$warnings+$weights{'U'}*$unsend;
           }
     }      }
   
     if ($unsend) { $simplestatus{'unsend'}=$unsend; }      if ($unsend) { $simplestatus{'unsend'}=$unsend; }
Line 758  sub check_delayed_msg { Line 878  sub check_delayed_msg {
 }  }
   
 sub finish_logging {  sub finish_logging {
     my ($fh)=@_;      my ($fh,$weightsref)=@_;
       my %weights;
       if (ref($weightsref) eq 'HASH') {
           %weights = %{$weightsref};
       }
     &log($fh,"<a name='errcount' />\n");      &log($fh,"<a name='errcount' />\n");
     $totalcount=$notices+4*$warnings+100*$errors;      $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors);
     &errout($fh);      &errout($fh);
     &log($fh,"<h1>Total Error Count: $totalcount</h1>");      &log($fh,"<h1>Total Error Count: $totalcount</h1>");
     my $now=time;      my $now=time;
Line 874  sub write_checksums { Line 998  sub write_checksums {
     return;      return;
 }  }
   
 sub write_hostips {  sub clean_nosslverify {
     my $lontabdir = $perlvar{'lonTabDir'};      my ($fh) = @_;
     my $defdom = $perlvar{'lonDefDomain'};      my %unlinked; 
     my $lonhost = $perlvar{'lonHostID'};      if (-d "$perlvar{'lonSockDir'}/nosslverify") {
     my $newfile = "$lontabdir/currhostips.tab";          if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) {
     my $oldfile = "$lontabdir/prevhostips.tab";              while (my $fname=readdir($dh)) {
     my (%prevhosts,%currhosts,%ipchange);                  next if ($fname =~ /^\.+$/);
     if ((-e $newfile) && (-s $newfile)) {                  if (unlink("/home/httpd/sockets/nosslverify/$fname")) {
         move($newfile,$oldfile);                      &log($fh,"Unlinking $fname<br />");
         chmod(0644,$oldfile);                      $unlinked{$fname} = 1;
         if (open(my $fh,'<',$oldfile)) {  
             while (my $line=<$fh>) {  
                 chomp($line);  
                 if ($line =~ /^([^:]+):([\d.]+)$/) {  
                     $prevhosts{$1} = $2;  
                 }                  }
             }              }
             close($fh);              closedir($dh);
         }          }
     }      }
     my ($ip_info,$cached) =      &log($fh,"<p>Removed ".scalar(keys(%unlinked))." nosslverify clients</p>");
         &Apache::lonnet::is_cached_new('iphost','iphost');      return %unlinked;
     if (!$cached) {  }
         &Apache::lonnet::get_iphost();  sub clean_lonc_childpids {
         ($ip_info,$cached) =      my $childpiddir = "$perlvar{'lonDocRoot'}/lon-status/loncchld";
         &Apache::lonnet::is_cached_new('iphost','iphost');      if (-d $childpiddir) {
     }          if (opendir(my $dh,$childpiddir)) {
     if (ref($ip_info) eq 'ARRAY') {              while (my $fname=readdir($dh)) {
         %currhosts = %{$ip_info->[1]};                  next if ($fname =~ /^\.+$/);
         if (open(my $fh,'>',$newfile)) {                  unlink("$childpiddir/$fname");
             foreach my $key (keys(%currhosts)) {  
                 print $fh "$key:$currhosts{$key}\n";  
             }              }
             close($fh);              closedir($dh);
             chmod(0644,$newfile);          }
       }
   }
   
   sub write_connection_config {
       my ($domconf,%connectssl,%changes);
       $domconf = &get_domain_config();
       if (ref($domconf) eq 'HASH') {
           if (ref($domconf->{'ssl'}) eq 'HASH') {
               foreach my $connect ('connto','connfrom') {
                   if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') {
                       my ($sslreq,$sslnoreq,$currsetting);
                       my %contypes;
                       foreach my $type ('dom','intdom','other') {
                           $connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type};
                       }
                   }
               }
           }
           if (keys(%connectssl)) {
               my %currconf; 
               if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
                   while (my $line = <$fh>) {
                       chomp($line);
                       my ($name,$value) = split(/=/,$line);
                       if ($value =~ /^(?:no|yes|req)$/) {
                           if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
                               $currconf{$name} = $value;
                           }
                       }
                   }
                   close($fh);
               }
               if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
                   my $count = 0;
                   foreach my $key (sort(keys(%connectssl))) { 
                       print $fh "$key=$connectssl{$key}\n";
                       if (exists($currconf{$key})) {
                           unless ($currconf{$key} eq $connectssl{$key}) {
                               $changes{$key} = 1;
                           }
                       } else {
                           $changes{$key} = 1;
                       }
                       $count ++;
                   }
                   close($fh);
                   print "Completed writing SSL options for lonc/lond for $count items.\n";
               }
           } else {
               print "Writing of SSL options skipped - no connection rules in domain configuration.\n";
         }          }
       } else {
           print "Retrieval of SSL options for lonc/lond skipped - no configuration data available for domain.\n";
     }      }
     if (keys(%prevhosts) && keys(%currhosts)) {      return %changes;
         foreach my $key (keys(%prevhosts)) {  }
             unless ($currhosts{$key} eq $prevhosts{$key}) {  
                 $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};  sub get_domain_config {
       my ($dom,$primlibserv,$isprimary,$url,%confhash);
       $dom = $perlvar{'lonDefDomain'};
       $primlibserv = &Apache::lonnet::domain($dom,'primary');
       if ($primlibserv eq $perlvar{'lonHostID'}) {
           $isprimary = 1;
       } elsif ($primlibserv ne '') {
           my $protocol = $Apache::lonnet::protocol{$primlibserv};
           my $hostname = &Apache::lonnet::hostname($primlibserv);
           unless ($protocol eq 'https') {
               $protocol = 'http';
           }
           $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl';
       }
       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);
             }              }
         }          }
         foreach my $key (keys(%currhosts)) {      } else {
             unless ($currhosts{$key} eq $prevhosts{$key}) {          if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) {
                 $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};              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;
                   }
             }              }
         }          }
     }      }
     if (&Apache::lonnet::domain($defdom,'primary') eq $lonhost) {      return \%confhash;
         if (keys(%ipchange)) {  }
             if (open(my $fh,'>>',$perlvar{'lonDaemons'}.'/logs/hostip.log')) {  
                print $fh "********************\n".localtime(time).' Changes --'."\n".  sub write_hosttypes {
                          "| Hostname | Previous IP | New IP |\n".      my %intdom = &Apache::lonnet::all_host_intdom();
                          " --------------------------------- \n";      my %hostdom = &Apache::lonnet::all_host_domain();
                foreach my $hostname (sort(keys(%ipchange))) {      my $dom = $hostdom{$perlvar{'lonHostID'}};
                     print $fh "| $hostname | $ipchange{$hostname} |\n";      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;
                       }
                 }                  }
                 print $fh "\n*******************\n\n";  
                 close($fh);                  close($fh);
             }              }
             my $emailto = &Apache::loncommon::build_recipient_list(undef,              if (open(my $fh,'>',"$perlvar{'lonTabDir'}/hosttypes.tab")) {
                                    'hostipmail',$defdom);                  my $count = 0;
             if ($emailto) {                  foreach my $lonid (sort(keys(%hostdom))) {
                 my $subject = "LON-CAPA Hostname to IP change ($perlvar{'lonHostID'})";                      my $type = 'other';
                 my $chgmail = "To: $emailto\n".                      if ($hostdom{$lonid} eq $dom) {
                               "Subject: $subject\n".                          $type = 'dom'; 
                               "Content-type: text/plain\; charset=UTF-8\n".                      } elsif ($intdom{$lonid} eq $internetdom) {
                               "MIME-Version: 1.0\n\n".                          $type = 'intdom';
                               "Host/IP changes\n".                      }
                               " \n".                      print $fh "$lonid:$type\n";
                               "| Hostname | Previous IP | New IP |\n".                      if (exists($currhosttypes{$lonid})) {
                               " --------------------------------- \n";                          if ($type ne $currhosttypes{$lonid}) {
                 foreach my $hostname (sort(keys(%ipchange))) {                              $changes{$lonid} = 1;
                     $chgmail .= "| $hostname | $ipchange{$hostname} |\n";                          }
                 }                      } else {
                 $chgmail .= "\n\n";                          $changes{$lonid} = 1;
                 if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {                      }
                     print $mailh $chgmail;                      $count ++;
                     close($mailh);                  }
                     print "Sending mail notification of hostname/IP changes.\n";                  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;
                                                       }
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                       }
                 }                  }
             }              }
         }          }
Line 962  sub write_hostips { Line 1255  sub write_hostips {
     return;      return;
 }  }
   
   sub get_permcount_settings {
       my ($domconf) = @_;
       my ($defaults,$names) = &Apache::loncommon::lon_status_items();
       my (%weights,$threshold,$sysmail,$reportstatus,%exclusions);
       foreach my $type ('E','W','N','U') {
           $weights{$type} = $defaults->{$type};
       }
       $threshold = $defaults->{'threshold'};
       $sysmail = $defaults->{'sysmail'};
       $reportstatus = 1;
       if (ref($domconf) eq 'HASH') {
           if (ref($domconf->{'contacts'}) eq 'HASH') {
               if ($domconf->{'contacts'}{'reportstatus'} == 0) {
                   $reportstatus = 0;
               }
               if (ref($domconf->{'contacts'}{'lonstatus'}) eq 'HASH') {
                   if (ref($domconf->{'contacts'}{'lonstatus'}{weights}) eq 'HASH') {
                       foreach my $type ('E','W','N','U') {
                           if (exists($domconf->{'contacts'}{'lonstatus'}{weights}{$type})) {
                               $weights{$type} = $domconf->{'contacts'}{'lonstatus'}{weights}{$type};
                           }
                       }
                   }
                   if (ref($domconf->{'contacts'}{'lonstatus'}{'excluded'}) eq 'ARRAY') {
                       my @excluded = @{$domconf->{'contacts'}{'lonstatus'}{'excluded'}};
                       if (@excluded) {
                           map { $exclusions{$_} = 1; } @excluded;
                       }
                   }
                   if (exists($domconf->{'contacts'}{'lonstatus'}{'threshold'})) {
                       $threshold = $domconf->{'contacts'}{'lonstatus'}{'threshold'};
                   }
                   if (exists($domconf->{'contacts'}{'lonstatus'}{'sysmail'})) {
                       $sysmail = $domconf->{'contacts'}{'lonstatus'}{'sysmail'};
                   }
               }
           }
       }
       return ($threshold,$sysmail,$reportstatus,\%weights,\%exclusions);
   }
   
   sub read_serverhomeIDs {
       my %server;
       if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
           if (open(my $fh,'<',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
               while (<$fh>) {
                   my($host,$id) = split(/:/);
                   chomp($id);
                   $server{$host} = $id;
               }
               close($fh);
           }
       }
       return %server;
   }
   
 sub send_mail {  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>2500) {      if (($totalcount>$sysmail) && ($reportstatus)) {
  $emailto.=",$perlvar{'lonSysEMail'}";   $emailto.=",$perlvar{'lonSysEMail'}";
     }      }
     my $from;      my $from;
Line 1020  Options: Line 1370  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 1051  sub main () { Line 1397  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");                 " mail -s '$subj' $emailto > /dev/null");
Line 1087  sub main () { Line 1432  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  
   
Line 1122  sub main () { Line 1465  sub main () {
   
   
     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 1145  sub main () { Line 1487  sub main () {
         &checkon_daemon($fh,'lonr',40000);          &checkon_daemon($fh,'lonr',40000);
     }      }
     if ($justreload) {      if ($justreload) {
           &clean_nosslverify($fh);
           &write_connection_config();
           &write_hosttypes();
           &update_revocation_list(); 
  &checkon_daemon($fh,'lond',40000,'USR2');   &checkon_daemon($fh,'lond',40000,'USR2');
  &checkon_daemon($fh,'lonc',40000,'USR2');   &checkon_daemon($fh,'lonc',40000,'USR2');
     }      }
     if ($justcheckconnections) {      if ($justcheckconnections) {
  &test_connections($fh);   &test_connections($fh);
     }      }
     if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {      if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
  &check_delayed_msg($fh);          my $domconf = &get_domain_config();
  &finish_logging($fh);          my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =
  &log_simplestatus();              &get_permcount_settings($domconf);
    &check_delayed_msg($fh,$weightsref,$exclusionsref);
         &write_loncaparevs();          &write_loncaparevs();
         &write_serverhomeIDs();          &write_serverhomeIDs();
  &write_checksums();   &write_checksums();
         &write_hostips();          my %sslrem = &clean_nosslverify($fh);
  if ($totalcount>200 && !$noemail) { &send_mail(); }          my %conchgs = &write_connection_config();
           my %hosttypechgs = &write_hosttypes();
           my $hadcrlchg = &update_revocation_list();
           if ((keys(%conchgs) > 0) || (keys(%hosttypechgs) > 0) ||
               $hadcrlchg || (keys(%sslrem) > 0)) {
               &checkon_daemon($fh,'lond',40000,'USR2');
               &reset_nosslverify_pids($fh,%sslrem);
           }
           &finish_logging($fh,$weightsref);
           &log_simplestatus();
           if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); }
     }      }
 }  }
   
Removed from v.1.103.2.7  
changed lines
  Added in v.1.114

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.