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

Diff for /loncom/loncnew between versions 1.98 and 1.110

version 1.98, 2011/06/17 10:26:26 version 1.110, 2024/06/14 18:49:41
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 $RemoteLoncapaRev;           # LON-CAPA version of host child is talking to, 
                                   # if 2.12.0 or newer, format: X.Y.Z
 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 669  Parameters: Line 673  Parameters:
 =item client    =item client  
     
    The LondTransaction we are failing.     The LondTransaction we are failing.
    
   
 =cut  =cut
   
Line 741  Parameters: Line 744  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 752  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 769  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 788  is readable.  The action is state depend Line 800  is readable.  The action is state depend
   
 =head3 State=Initialized  =head3 State=Initialized
   
 We're waiting for the challenge, this is a no-op until the  We are waiting for the challenge, this is a no-op until the
 state changes.  state changes.
   
 =head3 State=Challenged   =head3 State=Challenged 
Line 825  The the key has been requested, now we a Line 837  The the key has been requested, now we a
   
 The encryption key has been negotiated or we have finished   The encryption key has been negotiated or we have finished 
 reading data from the a transaction.   If the callback data have  reading data from the a transaction.   If the callback data have
 a client as well as the socket nformation, then we are   a client as well as the socket information, then we are 
 doing a transaction and the data received are relayed to the client  doing a transaction and the data received are relayed to the client
 before the socket is put on the idle list.  before the socket is put on the idle list.
   
Line 871  sub LondReadable { Line 883  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 920  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 958  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 986  event.  The action taken is very state d Line 1023  event.  The action taken is very state d
 =head3 State = Connected   =head3 State = Connected 
   
 The connection is in the process of sending the 'init' hailing to the  The connection is in the process of sending the 'init' hailing to the
 lond on the remote end.  The connection object's Writable member is  lond on the remote end.  The Writable member of the connection object
 called.  On error, ConnectionError is called to destroy the connection  is called.  On error, call ConnectionError to destroy the connection
 and remove it from the ActiveConnections hash  and remove it from the ActiveConnections hash.
   
 =head3 Initialized  =head3 Initialized
   
Line 1093  sub LondWritable { Line 1130  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 1243  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(),
    &GetLoncapaRev());
   
     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 1283  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 1553  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 1565  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 GetLoncapaRev
   
   Returns the LON-CAPA version for the node whose lond we talk with.
   
   =cut
   
   sub GetLoncapaRev {
       return $RemoteLoncapaRev;           # Setup by the fork.
   }
   
   =pod
   
 =head2 GetServerPort  =head2 GetServerPort
   
 Returns the lond port number.  Returns the lond port number.
Line 1539  sub GetServerPort { Line 1606  sub GetServerPort {
 Setup a lonc listener event.  The event is called when the socket  Setup a lonc listener event.  The event is called when the socket
 becomes readable.. that corresponds to the receipt of a new  becomes readable.. that corresponds to the receipt of a new
 connection.  The event handler established will accept the connection  connection.  The event handler established will accept the connection
 (creating a communcations channel), that in turn will establish  (creating a communications channel), that in turn will establish
 another event handler to subess requests.  another event handler to subess requests.
   
 =head2  Parameters:  =head2  Parameters:
Line 1652  sub SignalledToDeath { Line 1719  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 1850  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, $loncaparev) = @_;
   
     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 1865  sub CreateChild {
  undef(@all_host_ids);   undef(@all_host_ids);
     } else { # child.      } else { # child.
  $RemoteHostId = $hostid;   $RemoteHostId = $hostid;
    $RemoteDefHostId = $defhostid;
           $RemoteLoncapaRev = $loncaparev;
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  $SIG{INT} = 'DEFAULT';   $SIG{INT} = 'DEFAULT';
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
Line 1862  sub get_remote_hostname { Line 1932  sub get_remote_hostname {
   
     &Debug(5,"Creating child for $data (parent_client_connection)");      &Debug(5,"Creating child for $data (parent_client_connection)");
     (my $hostname,my $lonid,@all_host_ids) = split(':',$data);      (my $hostname,my $lonid,@all_host_ids) = split(':',$data);
       my $remotelcrev;
       if ((scalar(@all_host_ids) > 1) && ($all_host_ids[0] =~ /^\d+\.\d+\.[\w.]+$/)) {
           $remotelcrev = shift(@all_host_ids);
       }
     $ChildHost{$hostname}++;      $ChildHost{$hostname}++;
     if ($ChildHost{$hostname} == 1) {      if ($ChildHost{$hostname} == 1) {
  &CreateChild($hostname,$lonid);   &CreateChild($hostname,$lonid,$all_host_ids[-1],$remotelcrev);
     } 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 2046  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 2142  sub UpdateKids { Line 2217  sub UpdateKids {
     # (lost unless they are critical).      # (lost unless they are critical).
   
     &KillThemAll();      &KillThemAll();
       LondConnection->ResetReadConfig();
       ShowStatus('Parent keeping the flock');
 }  }
   
   
Line 2157  the config file. Line 2234  the config file.
   
 sub Restart {  sub Restart {
     &KillThemAll; # First kill all the children.      &KillThemAll; # First kill all the children.
       LondConnection->ResetReadConfig();
     Log("CRITICAL", "Restarting");      Log("CRITICAL", "Restarting");
     my $execdir = $perlvar{'lonDaemons'};      my $execdir = $perlvar{'lonDaemons'};
     unlink("$execdir/logs/lonc.pid");      unlink("$execdir/logs/lonc.pid");
Line 2185  sub KillThemAll { Line 2263  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 2204  sub really_kill_them_all_dammit Line 2283  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 2232  sub Terminate { Line 2312  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 2343  connection or died.  This should be foll Line 2470  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.98  
changed lines
  Added in v.1.110

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