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

Diff for /loncom/loncnew between versions 1.3 and 1.6

version 1.3, 2003/04/18 03:10:36 version 1.6, 2003/05/05 23:40:27
Line 49  use POSIX qw(:signal_h); Line 49  use POSIX qw(:signal_h);
 use IO::Socket;  use IO::Socket;
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Socket::UNIX;  use IO::Socket::UNIX;
   use IO::Handle;
 use Socket;  use Socket;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LONCAPA::Queue;  use LONCAPA::Queue;
Line 100  my %ActiveClients;  # Serial numbers of Line 101  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.
   
   #
   #   This disconnected socket makes posible a bit more regular
   #   code when processing delayed requests:
   #
   my $NullSocket = IO::Socket->new();
   
 #  #
   
Line 155  sub SocketDump { Line 162  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);
    }
       } 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 260  sub ClientWritable { Line 309  sub ClientWritable {
     &Debug(6, "ClientWritable writing".$Data);      &Debug(6, "ClientWritable writing".$Data);
     &Debug(9, "Socket is: ".$Socket);      &Debug(9, "Socket is: ".$Socket);
   
     my $result = $Socket->send($Data, 0);      if($Socket->connected) {
    my $result = $Socket->send($Data, 0);
     # $result undefined: the write failed.  
     # otherwise $result is the number of bytes written.   # $result undefined: the write failed.
     # Remove that preceding string from the data.   # otherwise $result is the number of bytes written.
     # If the resulting data is empty, destroy the watcher   # Remove that preceding string from the data.
     # and set up a read event handler to accept the next   # If the resulting data is empty, destroy the watcher
     # request.   # and set up a read event handler to accept the next
    # request.
     &Debug(9,"Send result is ".$result." Defined: ".defined($result));  
     if(defined($result)) {   &Debug(9,"Send result is ".$result." Defined: ".defined($result));
  &Debug(9, "send result was defined");   if(defined($result)) {
  if($result == length($Data)) { # Entire string sent.      &Debug(9, "send result was defined");
     &Debug(9, "ClientWritable data all written");      if($result == length($Data)) { # Entire string sent.
     $Watcher->cancel();   &Debug(9, "ClientWritable data all written");
     #   $Watcher->cancel();
     #  Set up to read next request from socket:   #
    #  Set up to read next request from socket:
   
    my $descr     = sprintf("Connection to lonc client %d",
    $ActiveClients{$Socket});
    Event->io(cb    => \&ClientRequest,
     poll  => 'r',
     desc  => $descr,
     data  => "",
     fd    => $Socket);
   
       } else { # Partial string sent.
    $Watcher->data(substr($Data, $result));
       }
       
    } else { # Error of some sort...
       
       # Some errnos are possible:
       my $errno = $!;
       if($errno == POSIX::EWOULDBLOCK   ||
          $errno == POSIX::EAGAIN        ||
          $errno == POSIX::EINTR) {
    # No action taken?
       } else { # Unanticipated errno.
    &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
    $Watcher->cancel; # Stop the watcher.
    $Socket->shutdown(2); # Kill connection
    $Socket->close(); # Close the socket.
       }
           
     my $descr     = sprintf("Connection to lonc client %d",  
     $ActiveClients{$Socket});  
     Event->io(cb    => \&ClientRequest,  
       poll  => 'r',  
       desc  => $descr,  
       data  => "",  
       fd    => $Socket);  
   
  } else { # Partial string sent.  
     $Watcher->data(substr($Data, $result));  
  }  
   
     } else { # Error of some sort...  
   
  # Some errnos are possible:  
  my $errno = $!;  
  if($errno == POSIX::EWOULDBLOCK   ||  
    $errno == POSIX::EAGAIN        ||  
    $errno == POSIX::EINTR) {  
     # No action taken?  
  } else { # Unanticipated errno.  
     &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);  
     $Watcher->cancel; # Stop the watcher.  
     $Socket->shutdown(2); # Kill connection  
     $Socket->close(); # Close the socket.  
  }   }
       } else {
    $Watcher->cancel(); # A delayed request...just cancel.
     }      }
 }  }
   
Line 337  sub CompleteTransaction { Line 390  sub CompleteTransaction {
     my $Client = shift;      my $Client = shift;
   
     my $data   = $Socket->GetReply(); # Data to send.      my $data   = $Socket->GetReply(); # Data to send.
       StartClientReply($Client, $data);
   }
   =pod
   =head1 StartClientReply
   
      Initiates a reply to a client where the reply data is a parameter.
   
   =cut
   sub StartClientReply {
       my $Client   = shift;
       my $data     = shift;
   
     &Debug(8," Reply was: ".$data);      &Debug(8," Reply was: ".$data);
     my $Serial         = $ActiveClients{$Client};      my $Serial         = $ActiveClients{$Client};
     my $desc           = sprintf("Connection to lonc client %d",      my $desc           = sprintf("Connection to lonc client %d",
   
  $Serial);   $Serial);
     Event->io(fd       => $Client,      Event->io(fd       => $Client,
       poll     => "w",        poll     => "w",
Line 348  sub CompleteTransaction { Line 413  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;
   
       StartClientReply($client, "con_lost");
   
   }
   
   =pod
   =head1  EmptyQueue
     Fails all items in the work queue with con_lost.
   =cut
   sub EmptyQueue {
       while($WorkQueue->Count()) {
    my $request = $WorkQUeue->dequeue(); # Just to help it become empty.
    my $client  = $ClientQueue->dequeue(); #  Need to con_lost this guy.
    FailTransaction($client);
       }
   }
   
   =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;
   
       #  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 the connection count has gone to zero and there is work in the
       #  work queue, the work all gets failed with con_lost.
       #
       if($ConnectionCount == 0) {
    EmptyQueue;
       }
   }
   
 =pod  =pod
   
Line 421  sub LondReadable { Line 561  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);
    return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
   
Line 461  sub LondReadable { Line 610  sub LondReadable {
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  ServerToIdle($Socket); # Next work unit or idle.   ServerToIdle($Socket); # Next work unit or idle.
   
     } elsif ($State eq "SendingRequest") {      } elsif ($State eq "SendingRequest") {
  #  We need to be writable for this and probably don't belong   #  We need to be writable for this and probably don't belong
  #  here inthe first place.   #  here inthe first place.
Line 557  sub LondWritable { Line 706  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);
       return;
  }   }
    #  "init" is being sent...
   
   
     } elsif ($State eq "Initialized")       {      } elsif ($State eq "Initialized")       {
   
Line 577  sub LondWritable { Line 732  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);
       return;
  }   }
   
     } elsif ($State eq "ChallengeReplied")  {      } elsif ($State eq "ChallengeReplied")  {
Line 595  sub LondWritable { Line 753  sub LondWritable {
   
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
     # Write resulted in an error.      # Write resulted in an error.
  }  
   
       $Watcher->cancel();
       KillSocket($Socket);
       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 771  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);
       return;
       
  }   }
   
     } elsif ($State eq "ReceivingReply")    {      } elsif ($State eq "ReceivingReply")    {
Line 630  sub LondWritable { Line 799  sub LondWritable {
     }      }
           
 }  }
   =pod
       
   =cut
   sub QueueDelayed {
       my $path = "$perlvar{'lonSockDir'}/delayed";
       opendir(DIRHANDLE, $path);
       @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
       closedir(DIRHANDLE);
       my $dfname;
       my $reqfile
       foreach $reqfile (sort @alldelayed) {
    $reqfile = $path/$reqfile;
    my $Handle = IO::File->new($reqfile);
    my $cmd    = <$Handle>;
    chomp($cmd);
    QueueTransaction($NullSocket, $cmd);
       }
       
   }
   
 =pod  =pod
   
Line 651  sub MakeLondConnection { Line 839  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 {   if($ConnectionCount == 1) { # First Connection:
  &Debug(9,"MakeLondConnection got socket: ".$Socket);      QueueDelayed;
    }
     }      }
   
       
     $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 1131  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 1154  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 1169  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("Forming new session");
   my $childpid = fork;
   if ($childpid != 0) {
       sleep 4; # Give child a chacne to break to
       exit 0; # a new sesion.
   }
   
   if (POSIX::setsid() < 0) {
       print "Could not create new session\n";
       exit -1;
   }
   
   ShowStatus("Forking node servers");
   
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
 while (! $HostIterator->end()) {  while (! $HostIterator->end()) {
   
Line 984  while (! $HostIterator->end()) { Line 1207  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.6

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