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

Diff for /loncom/loncnew between versions 1.3 and 1.5

version 1.3, 2003/04/18 03:10:36 version 1.5, 2003/04/29 03:24:51
Line 100  my %ActiveClients;  # Serial numbers of Line 100  my %ActiveClients;  # Serial numbers of
 my $WorkQueue       = Queue->new(); # Queue of pending transactions.  my $WorkQueue       = Queue->new(); # Queue of pending transactions.
 my $ClientQueue     = Queue->new(); # Queue of clients causing xactinos.  my $ClientQueue     = Queue->new(); # Queue of clients causing xactinos.
 my $ConnectionCount = 0;  my $ConnectionCount = 0;
   my $IdleSeconds     = 0; # Number of seconds idle.
   
 #  #
   
Line 155  sub SocketDump { Line 155  sub SocketDump {
   
 =pod  =pod
   
   =head2 ShowStatus
   
    Place some text as our pid status.
   
   =cut
   sub ShowStatus {
       my $status = shift;
       $0 =  "lonc: ".$status;
   }
   
   =pod
   
 =head2 Tick  =head2 Tick
   
 Invoked  each timer tick.  Invoked  each timer tick.
   
 =cut  =cut
   
   
 sub Tick {  sub Tick {
     my $client;      my $client;
       ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
     Debug(6, "Tick");      Debug(6, "Tick");
     Debug(6, "    Current connection count: ".$ConnectionCount);      Debug(6, "    Current connection count: ".$ConnectionCount);
     foreach $client (keys %ActiveClients) {      foreach $client (keys %ActiveClients) {
  Debug(7, "    Have client:  with id: ".$ActiveClients{$client});   Debug(7, "    Have client:  with id: ".$ActiveClients{$client});
     }      }
       # Is it time to prune connection count:
   
   
       if($IdleConnections->Count()  && 
          ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
    $IdleSeconds++;
    if($IdleSeconds > $IdleTimeout) { # Prune a connection...
       $Socket = $IdleConnections->pop();
       KillSocket($Socket, 0);
    }
       } else {
    $IdleSeconds = 0; # Reset idle count if not idle.
       }
   
       # Do we have work in the queue, but no connections to service them?
       # If so, try to make some new connections to get things going again.
       #
       
       my $Requests = $WorkQueue->Count();
       if (($ConnectionCount == 0)  && ($Requests > 0)) {
    my $Connections = ($Requests <= $MaxConnectionCount) ?
                              $Requests : $MaxConnectionCount;
    Debug(1,"Work but no connections, starting ".$Connections." of them");
    for ($i =0; $i < $Connections; $i++) {
       MakeLondConnection();
    }
          
       }
 }  }
   
 =pod  =pod
Line 348  sub CompleteTransaction { Line 390  sub CompleteTransaction {
       cb       => \&ClientWritable,        cb       => \&ClientWritable,
       data     => $data);        data     => $data);
 }  }
   =pod
   =head2 FailTransaction
   
     Finishes a transaction with failure because the associated lond socket
     disconnected.  It is up to our client to retry if desired.  
   
   Parameters:
   
   =item client  
    
      The UNIX domain socket open on our client.
   
   =cut
   
   sub FailTransaction {
       my $client = shift;
   
       &Debug(8, "Failing transaction due to disconnect");
       my $Serial = $ActiveClients{$client};
       my $desc   = sprintf("Connection to lonc client %d", $Serial);
       my $data   = "error: Connection to lond lost\n";
   
       Event->io(fd     => $client,
         poll   => "w",
         desc   => $desc,
         cb     => \&ClientWritable,
         data   => $data);
   
   }
   
   =pod
   
   =head2 KillSocket
    
   Destroys a socket.  This function can be called either when a socket
   has died of 'natural' causes or because a socket needs to be pruned due to
   idleness.  If the socket has died naturally, if there are no longer any 
   live connections a new connection is created (in case there are transactions
   in the queue).  If the socket has been pruned, it is never re-created.
   
   Parameters:
   
   =item Socket
    
     The socket to kill off.
   
   =item Restart
   
   nonzero if we are allowed to create a new connection.
   
   
   =cut
   sub KillSocket {
       my $Socket = shift;
       my $Restart= shift;
   
       #  If the socket came from the active connection set, delete it.
       # otherwise it came from the idle set and has already been destroyed:
       
       if(exists($ActiveTransactions{$Socket})) {
    delete ($ActiveTransactions{$Socket});
       }
       if(exists($ActiveConnections{$Socket})) {
    delete($ActiveConnections{$Socket});
       }
       $ConnectionCount--;
       if( ($ConnectionCount = 0) && ($Restart)) {
    MakeLondConnection();
       }
   
   }
   
 =pod  =pod
   
Line 421  sub LondReadable { Line 533  sub LondReadable {
     SocketDump(6, $Socket);      SocketDump(6, $Socket);
   
     if($Socket->Readable() != 0) {      if($Socket->Readable() != 0) {
  # bad return from socket read.   # bad return from socket read. Currently this means that
    # The socket has become disconnected. We fail the transaction.
   
    if(exists($ActiveTransactions{$Socket})) {
       Debug(3,"Lond connection lost failing transaction");
       FailTransaction($ActiveTransactions{$Socket});
    }
    $Watcher->cancel();
    KillSocket($Socket, 1);
    return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
   
Line 557  sub LondWritable { Line 678  sub LondWritable {
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
   
     if      ($State eq "Connected")         {      if      ($State eq "Connected")         {
  #  "init" is being sent...  
   
  if ($Socket->Writable() != 0) {   if ($Socket->Writable() != 0) {
     #  The write resulted in an error.      #  The write resulted in an error.
       # We'll treat this as if the socket got disconnected:
   
       $Watcher->cancel();
       KillSocket($Socket, 1);
       return;
  }   }
    #  "init" is being sent...
   
   
     } elsif ($State eq "Initialized")       {      } elsif ($State eq "Initialized")       {
   
Line 577  sub LondWritable { Line 704  sub LondWritable {
  # we're waiting for the state to change   # we're waiting for the state to change
   
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
     # Write of the next chunk resulted in an error.  
       $Watcher->cancel();
       KillSocket($Socket, 1);
       return;
  }   }
   
     } elsif ($State eq "ChallengeReplied")  {      } elsif ($State eq "ChallengeReplied")  {
Line 595  sub LondWritable { Line 725  sub LondWritable {
   
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
     # Write resulted in an error.      # Write resulted in an error.
  }  
   
       $Watcher->cancel();
       KillSocket($Socket, 1);
       return;
   
    }
     } elsif ($State eq "ReceivingKey")      {      } elsif ($State eq "ReceivingKey")      {
  # Now we need to wait for the key   # Now we need to wait for the key
  # to come back from the peer:   # to come back from the peer:
Line 609  sub LondWritable { Line 743  sub LondWritable {
  # peer... write the next chunk:   # peer... write the next chunk:
   
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
     # Write resulted in an error.  
   
       if(exists($ActiveTransactions{$Socket})) {
    Debug(3, "Lond connection lost, failing transactions");
    FailTransaction($ActiveTransactions{$Socket});
       }
       $Watcher->cancel();
       KillSocket($Socket, 1);
       return;
       
  }   }
   
     } elsif ($State eq "ReceivingReply")    {      } elsif ($State eq "ReceivingReply")    {
Line 651  sub MakeLondConnection { Line 792  sub MakeLondConnection {
  &GetServerPort());   &GetServerPort());
   
     if($Connection == undef) { # Needs to be more robust later.      if($Connection == undef) { # Needs to be more robust later.
  die "Failed to make a connection!!".$!."\n";   Debug(0,"Failed to make a connection with lond.");
       }  else {
    # The connection needs to have writability 
    # monitored in order to send the init sequence
    # that starts the whole authentication/key
    # exchange underway.
    #
    my $Socket = $Connection->GetSocket();
    if($Socket == undef) {
       die "did not get a socket from the connection";
    } else {
       &Debug(9,"MakeLondConnection got socket: ".$Socket);
    }
   
     }   
     # The connection needs to have writability    $event = Event->io(fd       => $Socket,
     # monitored in order to send the init sequence     poll     => 'w',
     # that starts the whole authentication/key     cb       => \&LondWritable,
     # exchange underway.     data     => ($Connection, undef),
     #     desc => 'Connection to lond server');
     my $Socket = $Connection->GetSocket();   $ActiveConnections{$Connection} = $event;
     if($Socket == undef) {  
  die "did not get a socket from the connection";   $ConnectionCount++;
     } else {  
  &Debug(9,"MakeLondConnection got socket: ".$Socket);  
     }      }
   
       
     $event = Event->io(fd       => $Socket,  
        poll     => 'w',  
        cb       => \&LondWritable,  
        data     => ($Connection, undef),  
        desc => 'Connection to lond server');  
     $ActiveConnections{$Lond} = $event;  
   
     $ConnectionCount++;  
      
           
 }  }
   
Line 941  sub ChildProcess { Line 1081  sub ChildProcess {
 # Setup the initial server connection:  # Setup the initial server connection:
           
     &MakeLondConnection();      &MakeLondConnection();
       
       if($ConnectionCount == 0) {
    Debug(1,"Could not make initial connection..\n");
    Debug(1,"Will retry when there's work to do\n");
       }
     Debug(9,"Entering event loop");      Debug(9,"Entering event loop");
     my $ret = Event::loop(); #  Start the main event loop.      my $ret = Event::loop(); #  Start the main event loop.
           
Line 960  sub CreateChild { Line 1104  sub CreateChild {
     if($pid) { # Parent      if($pid) { # Parent
  $ChildHash{$pid} = $RemoteHost;   $ChildHash{$pid} = $RemoteHost;
     } else { # child.      } else { # child.
    ShowStatus("Connected to ".$RemoteHost);
  ChildProcess;   ChildProcess;
     }      }
   
Line 974  sub CreateChild { Line 1119  sub CreateChild {
 #  Each exit gets logged and the child gets restarted.  #  Each exit gets logged and the child gets restarted.
 #  #
   
   #
   #   Fork and start in new session so hang-up isn't going to 
   #   happen without intent.
   #
   
   
   ShowStatus("Parent writing pid file:");
   $execdir = $perlvar{'lonDaemons'};
   open (PIDSAVE, ">$execdir/logs/lonc.pid");
   print PIDSAVE "$$\n";
   close(PIDSAVE);
   
   ShowStatus("Forking node servers");
   
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
 while (! $HostIterator->end()) {  while (! $HostIterator->end()) {
   
Line 984  while (! $HostIterator->end()) { Line 1143  while (! $HostIterator->end()) {
   
 # Maintain the population:  # Maintain the population:
   
   ShowStatus("Parent keeping the flock");
   
 while(1) {  while(1) {
     $deadchild = wait();      $deadchild = wait();
     if(exists $ChildHash{$deadchild}) { # need to restart.      if(exists $ChildHash{$deadchild}) { # need to restart.
Removed from v.1.3  
changed lines
  Added in v.1.5

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