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

Diff for /loncom/loncnew between versions 1.101 and 1.107

version 1.101, 2017/02/28 05:42:06 version 1.107, 2018/12/10 17:34:22
Line 74  my %perlvar    = %{$perlvarref}; Line 74  my %perlvar    = %{$perlvarref};
   
 my %ChildPid; # by pid -> host.  my %ChildPid; # by pid -> host.
 my %ChildHost; # by host.  my %ChildHost; # by host.
   my %ChildKeyMode;               # by pid -> keymode
 my %listening_to; # Socket->host table for who the parent  my %listening_to; # Socket->host table for who the parent
                                 # is listening to.                                  # is listening to.
 my %parent_dispatchers;         # host-> listener watcher events.   my %parent_dispatchers;         # host-> listener watcher events. 
Line 93  my $executable      = $0; # Get the full Line 94  my $executable      = $0; # Get the full
 #  #
 #  The variables below are only used by the child processes.  #  The variables below are only used by the child processes.
 #  #
 my $RemoteHost; # Name of host child is talking to.  my $RemoteHost; # Hostname of host child is talking to.
 my $RemoteHostId; # default lonid of host child is talking to.  my $RemoteHostId; # lonid of host child is talking to.
   my $RemoteDefHostId; # default lonhostID of host child is talking to.
 my @all_host_ids;  my @all_host_ids;
 my $UnixSocketDir= $perlvar{'lonSockDir'};  my $UnixSocketDir= $perlvar{'lonSockDir'};
 my $IdleConnections = Stack->new(); # Set of idle connections  my $IdleConnections = Stack->new(); # Set of idle connections
Line 611  sub CompleteTransaction { Line 613  sub CompleteTransaction {
  StartClientReply($Transaction, $data);   StartClientReply($Transaction, $data);
     } else { # Delete deferred transaction file.      } else { # Delete deferred transaction file.
  Log("SUCCESS", "A delayed transaction was completed");   Log("SUCCESS", "A delayed transaction was completed");
  LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest());   LogPerm("S:".$Socket->PeerLoncapaHim().":".$Transaction->getRequest());
  unlink($Transaction->getFile());   unlink($Transaction->getFile());
     }      }
 }  }
Line 741  Parameters: Line 743  Parameters:
     
   The socket to kill off.    The socket to kill off.
   
 =item Restart  =item restart
   
 non-zero if we are allowed to create a new connection.  non-zero if we are allowed to create a new connection.
   
Line 749  non-zero if we are allowed to create a n Line 751  non-zero if we are allowed to create a n
   
 sub KillSocket {  sub KillSocket {
     my $Socket = shift;      my $Socket = shift;
       my $restart = shift;
   
     Log("WARNING", "Shutting down a socket");      Log("WARNING", "Shutting down a socket");
     $Socket->Shutdown();      $Socket->Shutdown();
Line 765  sub KillSocket { Line 768  sub KillSocket {
     if(exists($ActiveConnections{$Socket})) {      if(exists($ActiveConnections{$Socket})) {
  $ActiveConnections{$Socket}->cancel;   $ActiveConnections{$Socket}->cancel;
  delete($ActiveConnections{$Socket});   delete($ActiveConnections{$Socket});
  $ConnectionCount--;          # Decrement ConnectionCount unless we will immediately
           # re-connect (i.e., $restart is true), because this was
           # a connection where the SSL channel for exchange of the
           # shared key failed, and we may use an insecure channel.
           unless ($restart) {
       $ConnectionCount--;
           }
  if ($ConnectionCount < 0) { $ConnectionCount = 0; }   if ($ConnectionCount < 0) { $ConnectionCount = 0; }
     }      }
     #  If the connection count has gone to zero and there is work in the      #  If the connection count has gone to zero and there is work in the
     #  work queue, the work all gets failed with con_lost.      #  work queue, the work all gets failed with con_lost.
     #      #
     
     if($ConnectionCount == 0) {      if($ConnectionCount == 0) {
  $LondConnecting = 0; # No connections so also not connecting.   $LondConnecting = 0; # No connections so also not connecting.
  EmptyQueue();   EmptyQueue();
  CloseAllLondConnections; # Should all already be closed but...   CloseAllLondConnections(); # Should all already be closed but...
           &clear_childpid($$);
     }      }
     UpdateStatus();      UpdateStatus();
 }  }
Line 871  sub LondReadable { Line 882  sub LondReadable {
   
  Log("WARNING",   Log("WARNING",
     "Lond connection lost.");      "Lond connection lost.");
           my $state_on_exit = $Socket->GetState();
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
  } else {   } else {
     #  Socket is connecting and failed... need to mark      #  Socket is connecting and failed... need to mark
     #  no longer connecting.      #  no longer connecting.
      
     $LondConnecting = 0;      $LondConnecting = 0;
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket);          if ($state_on_exit eq 'ReInitNoSSL') {
  $ConnectionRetriesLeft--;       # Counts as connection failure              # SSL certificate verification failed, and insecure connection
               # allowed. Send restart arg to KillSocket(), so EmptyQueue() 
               # is not called, as we still hope to process queued request.
   
               KillSocket($Socket,1);
   
               # Re-initiate creation of Lond Connection for use with queued
               # request.
   
               ShowStatus("Connected to ".$RemoteHost);
               Log("WARNING","No SSL channel (verification failed), will try with insecure channel");
               &MakeLondConnection(1);
   
           } else {
       KillSocket($Socket);
       $ConnectionRetriesLeft--;       # Counts as connection failure         
           }
  return;   return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 892  sub LondReadable { Line 919  sub LondReadable {
     if($State eq "Initialized") {      if($State eq "Initialized") {
   
   
       } elsif ($State eq "ReInitNoSSL") {
   
     } elsif ($State eq "ChallengeReceived") {      } elsif ($State eq "ChallengeReceived") {
  #  The challenge must be echoed back;  The state machine   #  The challenge must be echoed back;  The state machine
  # in the connection takes care of setting that up.  Just   # in the connection takes care of setting that up.  Just
Line 928  sub LondReadable { Line 957  sub LondReadable {
     } elsif ($State eq "ReceivingKey") {      } elsif ($State eq "ReceivingKey") {
   
     } elsif ($State eq "Idle") {      } elsif ($State eq "Idle") {
      
           if ($ConnectionCount == 1) { 
               # Write child Pid file to keep track of ssl and insecure
               # connections
   
               &record_childpid($Socket);
           }
   
  # This is as good a spot as any to get the peer version   # This is as good a spot as any to get the peer version
  # string:   # string:
         
Line 1093  sub LondWritable { Line 1129  sub LondWritable {
   
  $Watcher->cb(\&LondReadable);   $Watcher->cb(\&LondReadable);
  $Watcher->poll("r");   $Watcher->poll("r");
   
       } elsif ($State eq "ReInitNoSSL") {
   
     } elsif ($State eq "ChallengeReceived") {      } elsif ($State eq "ChallengeReceived") {
  # We received the challenge, now we    # We received the challenge, now we 
  # are echoing it back. This is a no-op,   # are echoing it back. This is a no-op,
Line 1204  start off on it. Line 1242  start off on it.
   
 =cut  =cut
   
 sub MakeLondConnection {       sub MakeLondConnection {
       my ($restart) = @_;
     Debug(4,"MakeLondConnection to ".GetServerHost()." on port "      Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
   .GetServerPort());    .GetServerPort());
   
     my $Connection = LondConnection->new(&GetServerHost(),      my $Connection = LondConnection->new(&GetServerHost(),
  &GetServerPort(),   &GetServerPort(),
  &GetHostId());   &GetHostId(),
    &GetDefHostId());
   
     if($Connection eq undef) {      if($Connection eq undef) {
  Log("CRITICAL","Failed to make a connection with lond.");   Log("CRITICAL","Failed to make a connection with lond.");
  $ConnectionRetriesLeft--;   $ConnectionRetriesLeft--;
  return 0; # Failure.   return 0; # Failure.
     }  else {      }  else {
   
  $LondConnecting = 1; # Connection in progress.   $LondConnecting = 1; # Connection in progress.
  # The connection needs to have writability    # The connection needs to have writability 
  # monitored in order to send the init sequence   # monitored in order to send the init sequence
Line 1242  sub MakeLondConnection { Line 1281  sub MakeLondConnection {
  if ($ConnectionCount == 0) {   if ($ConnectionCount == 0) {
     &SetupTimer; # Need to handle timeouts with connections...      &SetupTimer; # Need to handle timeouts with connections...
  }   }
  $ConnectionCount++;          unless ($restart) {
       $ConnectionCount++;
           }
  $Connection->SetClientData($ConnectionCount);   $Connection->SetClientData($ConnectionCount);
  Debug(4, "Connection count = ".$ConnectionCount);   Debug(4, "Connection count = ".$ConnectionCount);
  if($ConnectionCount == 1) { # First Connection:   if($ConnectionCount == 1) { # First Connection:
Line 1510  sub GetServerHost { Line 1551  sub GetServerHost {
   
 =pod  =pod
   
 =head2 GetServerId  =head2 GetHostId
   
 Returns the hostid whose lond we talk with.  Returns the hostid whose lond we talk with.
   
Line 1522  sub GetHostId { Line 1563  sub GetHostId {
   
 =pod  =pod
   
   =head2 GetDefHostId
   
   Returns the default hostid for the node whose lond we talk with.
   
   =cut
   
   sub GetDefHostId {                      # Setup by the fork.
       return $RemoteDefHostId;
   }
   
   =pod
   
 =head2 GetServerPort  =head2 GetServerPort
   
 Returns the lond port number.  Returns the lond port number.
Line 1652  sub SignalledToDeath { Line 1705  sub SignalledToDeath {
  ."died through "."\"$signal\"");   ."died through "."\"$signal\"");
     #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "      #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
 #    ."\"$signal\"");  #    ."\"$signal\"");
       &clear_childpid($$);
     exit 0;      exit 0;
   
 }  }
Line 1782  sub ChildProcess { Line 1836  sub ChildProcess {
 #  Create a new child for host passed in:  #  Create a new child for host passed in:
   
 sub CreateChild {  sub CreateChild {
     my ($host, $hostid) = @_;      my ($host, $hostid, $defhostid) = @_;
   
     my $sigset = POSIX::SigSet->new(SIGINT);      my $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset);      sigprocmask(SIG_BLOCK, $sigset);
Line 1797  sub CreateChild { Line 1851  sub CreateChild {
  undef(@all_host_ids);   undef(@all_host_ids);
     } else { # child.      } else { # child.
  $RemoteHostId = $hostid;   $RemoteHostId = $hostid;
    $RemoteDefHostId = $defhostid;
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  $SIG{INT} = 'DEFAULT';   $SIG{INT} = 'DEFAULT';
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
Line 1864  sub get_remote_hostname { Line 1919  sub get_remote_hostname {
     (my $hostname,my $lonid,@all_host_ids) = split(':',$data);      (my $hostname,my $lonid,@all_host_ids) = split(':',$data);
     $ChildHost{$hostname}++;      $ChildHost{$hostname}++;
     if ($ChildHost{$hostname} == 1) {      if ($ChildHost{$hostname} == 1) {
  &CreateChild($hostname,$lonid);   &CreateChild($hostname,$lonid,$all_host_ids[-1]);
     } else {      } else {
  &Log('WARNING',"Request for a second child on $hostname");   &Log('WARNING',"Request for a second child on $hostname");
     }      }
Line 1972  sub server_died { Line 2027  sub server_died {
  my $host = $ChildPid{$pid};   my $host = $ChildPid{$pid};
  if($host) { # It's for real...   if($host) { # It's for real...
     &Debug(9, "Caught sigchild for $host");      &Debug(9, "Caught sigchild for $host");
               &clear_childpid($pid);
     delete($ChildPid{$pid});      delete($ChildPid{$pid});
     delete($ChildHost{$host});      delete($ChildHost{$host});
     &parent_clean_up($host);      &parent_clean_up($host);
Line 2143  sub UpdateKids { Line 2199  sub UpdateKids {
   
     &KillThemAll();      &KillThemAll();
     LondConnection->ResetReadConfig();      LondConnection->ResetReadConfig();
       ShowStatus('Parent keeping the flock');
 }  }
   
   
Line 2187  sub KillThemAll { Line 2244  sub KillThemAll {
  ShowStatus("Nicely Killing lonc for $serving pid = $pid");   ShowStatus("Nicely Killing lonc for $serving pid = $pid");
  Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");   Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
  kill 'QUIT' => $pid;   kill 'QUIT' => $pid;
           &clear_childpid($pid);
     }      }
     ShowStatus("Finished killing child processes off.");      ShowStatus("Finished killing child processes off.");
 }  }
Line 2206  sub really_kill_them_all_dammit Line 2264  sub really_kill_them_all_dammit
  Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");   Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
  kill 'KILL' => $pid;   kill 'KILL' => $pid;
  delete($ChildPid{$pid});   delete($ChildPid{$pid});
           delete($ChildKeyMode{$pid});
  my $execdir = $perlvar{'lonDaemons'};   my $execdir = $perlvar{'lonDaemons'};
  unlink("$execdir/logs/lonc.pid");   unlink("$execdir/logs/lonc.pid");
     }      }
Line 2234  sub Terminate { Line 2293  sub Terminate {
   
 }  }
   
   =pod
   
   =cut
   
 sub my_hostname {  sub my_hostname {
     use Sys::Hostname;      use Sys::Hostname::FQDN();
     my $name = &hostname();      my $name = Sys::Hostname::FQDN::fqdn();
     &Debug(9,"Name is $name");      &Debug(9,"Name is $name");
     return $name;      return $name;
 }  }
   
   sub record_childpid {
       my ($Socket) = @_;
       my $docdir = $perlvar{'lonDocRoot'};
       my $authmode = $Socket->GetKeyMode();
       my $peer = $Socket->PeerLoncapaHim();
       if (($authmode eq 'ssl') || ($authmode eq 'insecure')) {
           my $childpid = $$;
           if ($childpid) {
               unless (exists($ChildKeyMode{$childpid})) {
                   $ChildKeyMode{$childpid} = $authmode;
               }
               if (-d "$docdir/lon-status/loncchld") {
                   unless (-e "$docdir/lon-status/loncchld/$childpid") {
                       if (open (my $pidfh,'>',"$docdir/lon-status/loncchld/$childpid")) {
                           print $pidfh "$peer:$authmode\n";
                           close($pidfh);
                       }
                   }
               }
           }
       }
       return;
   }
   
   sub clear_childpid {
       my ($childpid) = @_; 
       my $docdir = $perlvar{'lonDocRoot'};
       if (-d "$docdir/lon-status/loncchld") {
           if ($childpid =~ /^\d+$/) {
               if (($ChildKeyMode{$childpid} eq 'insecure') ||
                   ($ChildKeyMode{$childpid} eq 'ssl')) {
                   if (-e "$docdir/lon-status/loncchld/$childpid") {
                       unlink("$docdir/lon-status/loncchld/$childpid");
                   }
               }
           }
       }
       if (exists($ChildKeyMode{$childpid})) {
           delete($ChildKeyMode{$childpid});
       }
       return;
   }
   
 =pod  =pod
   
 =head1 Theory  =head1 Theory
Line 2345  connection or died.  This should be foll Line 2451  connection or died.  This should be foll
   
  "WARNING Failing transaction..." msgs for each in-flight or queued transaction.   "WARNING Failing transaction..." msgs for each in-flight or queued transaction.
   
   =item WARNING No SSL channel (verification failed), will try with insecure channel.
   
   Called when promotion of a socket to SSL failed because SSL certificate verification failed.
   Domain configuration must also permit insecure channel use for key exchange. Connection
   negotiation will start again from the beginning, but with Authentication Mode not set to ssl.
   
 =item INFO Connected to lond version:  <version>   =item INFO Connected to lond version:  <version> 
   
 When connection negotiation is complete, the lond version is requested and logged here.  When connection negotiation is complete, the lond version is requested and logged here.
Removed from v.1.101  
changed lines
  Added in v.1.107

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>