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

Diff for /loncom/loncnew between versions 1.4 and 1.6

version 1.4, 2003/04/24 10:56:55 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 103  my $ConnectionCount = 0; Line 104  my $ConnectionCount = 0;
 my $IdleSeconds     = 0; # Number of seconds idle.  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();
   
   #
   
 =pod  =pod
   
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;
     $0 = 'lonc: '.GetServerHost()." Connection count: ".$ConnectionCount;      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) {
Line 177  sub Tick { Line 197  sub Tick {
  $IdleSeconds++;   $IdleSeconds++;
  if($IdleSeconds > $IdleTimeout) { # Prune a connection...   if($IdleSeconds > $IdleTimeout) { # Prune a connection...
     $Socket = $IdleConnections->pop();      $Socket = $IdleConnections->pop();
     KillSocket($Socket, 0);      KillSocket($Socket);
  }   }
     } else {      } else {
  $IdleSeconds = 0; # Reset idle count if not idle.   $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 274  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.  
     # Remove that preceding string from the data.  
     # If the resulting data is empty, destroy the watcher  
     # 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 was defined");  
  if($result == length($Data)) { # Entire string sent.  
     &Debug(9, "ClientWritable data all written");  
     $Watcher->cancel();  
     #  
     #  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...   # $result undefined: the write failed.
    # otherwise $result is the number of bytes written.
  # Some errnos are possible:   # Remove that preceding string from the data.
  my $errno = $!;   # If the resulting data is empty, destroy the watcher
  if($errno == POSIX::EWOULDBLOCK   ||   # and set up a read event handler to accept the next
    $errno == POSIX::EAGAIN        ||   # request.
    $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.  
  }  
   
    &Debug(9,"Send result is ".$result." Defined: ".defined($result));
    if(defined($result)) {
       &Debug(9, "send result was defined");
       if($result == length($Data)) { # Entire string sent.
    &Debug(9, "ClientWritable data all written");
    $Watcher->cancel();
    #
    #  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.
       }
       
    }
       } else {
    $Watcher->cancel(); # A delayed request...just cancel.
     }      }
 }  }
   
Line 351  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 379  Parameters: Line 430  Parameters:
 sub FailTransaction {  sub FailTransaction {
     my $client = shift;      my $client = shift;
   
     &Debug(8, "Failing transaction due to disconnect");      StartClientReply($client, "con_lost");
     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  =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  =head2 KillSocket
     
Line 416  nonzero if we are allowed to create a ne Line 470  nonzero if we are allowed to create a ne
 =cut  =cut
 sub KillSocket {  sub KillSocket {
     my $Socket = shift;      my $Socket = shift;
     my $Restart= shift;  
   
     #  If the socket came from the active connection set, delete it.      #  If the socket came from the active connection set, delete it.
     # otherwise it came from the idle set and has already been destroyed:      # otherwise it came from the idle set and has already been destroyed:
Line 428  sub KillSocket { Line 481  sub KillSocket {
  delete($ActiveConnections{$Socket});   delete($ActiveConnections{$Socket});
     }      }
     $ConnectionCount--;      $ConnectionCount--;
     if( ($ConnectionCount = 0) && ($Restart)) {  
  MakeLondConnection();  
     }  
   
       #  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 513  sub LondReadable { Line 569  sub LondReadable {
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket, 1);   KillSocket($Socket);
  return;   return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 554  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 654  sub LondWritable { Line 710  sub LondWritable {
  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:      # We'll treat this as if the socket got disconnected:
     if(exists($ActiveTransactions{$Socket})) {  
  Debug(3, "Lond connection lost, failing transactions");  
  FailTransaction($ActiveTransactions{$Socket});  
     }  
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
  }   }
  #  "init" is being sent...   #  "init" is being sent...
Line 679  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 697  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 711  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 732  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 753  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{$Connection} = $event;  
   
     $ConnectionCount++;  
      
           
 }  }
   
Line 1043  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 1062  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 1076  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 1086  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.4  
changed lines
  Added in v.1.6

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