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

Diff for /loncom/loncnew between versions 1.5 and 1.7

version 1.5, 2003/04/29 03:24:51 version 1.7, 2003/06/03 01:59:39
Line 34 Line 34
 #    - Add timer dispatch.       (done)  #    - Add timer dispatch.       (done)
 #    - Add ability to accept lonc UNIX domain sockets.  (done)  #    - Add ability to accept lonc UNIX domain sockets.  (done)
 #    - Add ability to create/negotiate lond connections (done).  #    - Add ability to create/negotiate lond connections (done).
 #    - Add general logic for dispatching requests and timeouts.  #    - Add general logic for dispatching requests and timeouts. (done).
 #    - Add support for the lonc/lond requests.  #    - Add support for the lonc/lond requests.          (done).
 #    - Add logging/status monitoring.  #    - Add logging/status monitoring.
 #    - Add Signal handling - HUP restarts. USR1 status report.  #    - Add Signal handling - HUP restarts. USR1 status report.
 #    - Add Configuration file I/O  #    - Add Configuration file I/O                       (done).
 #    - Add Pending request processing on startup.  #    - Add Pending request processing on startup.
 #    - Add management/status request interface.  #    - Add management/status request interface.
   #    - Add deferred request capability.
   #
   
   # Change log:
   #    $Log$
   #    Revision 1.7  2003/06/03 01:59:39  foxr
   #    complete coding to support deferred transactions.
   #
   #
   
 use lib "/home/httpd/lib/perl/";  use lib "/home/httpd/lib/perl/";
 use lib "/home/foxr/newloncapa/types";  use lib "/home/foxr/newloncapa/types";
Line 49  use POSIX qw(:signal_h); Line 58  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;
 use LONCAPA::Stack;  use LONCAPA::Stack;
 use LONCAPA::LondConnection;  use LONCAPA::LondConnection;
   use LONCAPA::LondTransaction;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::HashIterator;  use LONCAPA::HashIterator;
   
Line 95  my $RemoteHost;   # Name of host child i Line 106  my $RemoteHost;   # Name of host child i
 my $UnixSocketDir= "/home/httpd/sockets";   my $UnixSocketDir= "/home/httpd/sockets"; 
 my $IdleConnections = Stack->new(); # Set of idle connections  my $IdleConnections = Stack->new(); # Set of idle connections
 my %ActiveConnections; # Connections to the remote lond.  my %ActiveConnections; # Connections to the remote lond.
 my %ActiveTransactions; # Transactions in flight.  my %ActiveTransactions; # LondTransactions in flight.
 my %ActiveClients; # Serial numbers of active clients by socket.  my %ActiveClients; # Serial numbers of active clients by socket.
 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.  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 190  sub Tick { Line 207  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.
Line 250  long enough, it will be shut down and re Line 267  long enough, it will be shut down and re
   
 sub ServerToIdle {  sub ServerToIdle {
     my $Socket   = shift; # Get the socket.      my $Socket   = shift; # Get the socket.
       delete($ActiveTransactions{$Socket}); # Server has no transaction
   
     &Debug(6, "Server to idle");      &Debug(6, "Server to idle");
   
     #  If there's work to do, start the transaction:      #  If there's work to do, start the transaction:
   
     $reqdata = $WorkQueue->dequeue();      $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
     Debug(9, "Queue gave request data: ".$reqdata);  
     unless($reqdata eq undef)  {      unless($reqdata eq undef)  {
  my $unixSocket = $ClientQueue->dequeue();   Debug(9, "Queue gave request data: ".$reqdata->getRequest());
  &Debug(6, "Starting new work request");   &StartRequest($Socket,  $reqdata);
  &Debug(7, "Request: ".$reqdata);  
   
  &StartRequest($Socket, $unixSocket, $reqdata);  
     } else {      } else {
   
     #  There's no work waiting, so push the server to idle list.      #  There's no work waiting, so push the server to idle list.
  &Debug(8, "No new work requests, server connection going idle");   &Debug(8, "No new work requests, server connection going idle");
  delete($ActiveTransactions{$Socket});  
  $IdleConnections->push($Socket);   $IdleConnections->push($Socket);
     }      }
 }  }
Line 302  sub ClientWritable { Line 315  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 367  Parameters: Line 384  Parameters:
 Socket on which the lond transaction occured.  This is a  Socket on which the lond transaction occured.  This is a
 LondConnection. The data received is in the TransactionReply member.  LondConnection. The data received is in the TransactionReply member.
   
 =item Client  =item Transaction
   
 Unix domain socket open on the ultimate client.  The transaction that is being completed.
   
 =cut  =cut
   
 sub CompleteTransaction {  sub CompleteTransaction {
     &Debug(6,"Complete transaction");      &Debug(6,"Complete transaction");
     my $Socket = shift;      my $Socket = shift;
     my $Client = shift;      my $Transaction = shift;
   
       if (!$Transaction->isDeferred()) { # Normal transaction
    my $data   = $Socket->GetReply(); # Data to send.
    StartClientReply($Transaction, $data);
       } else { # Delete deferred transaction file.
    unlink $Transaction->getFile();
       }
   }
   =pod
   =head1 StartClientReply
   
      Initiates a reply to a client where the reply data is a parameter.
   
   =head2  parameters:
   
   =item Transaction
   
     my $data   = $Socket->GetReply(); # Data to send.      The transaction for which we are responding to the client.
   
   =item data
   
       The data to send to apached client.
   
   =cut
   sub StartClientReply {
       my $Transaction   = shift;
       my $data     = shift;
   
       my $Client   = $Transaction->getClient();
   
     &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 394  sub CompleteTransaction { Line 439  sub CompleteTransaction {
 =head2 FailTransaction  =head2 FailTransaction
   
   Finishes a transaction with failure because the associated lond socket    Finishes a transaction with failure because the associated lond socket
   disconnected.  It is up to our client to retry if desired.      disconnected.  There are two possibilities:
     - The transaction is deferred: in which case we just quietly
       delete the transaction since there is no client connection.
     - The transaction is 'live' in which case we initiate the sending
       of "con_lost" to the client.
   
   Deleting the transaction means killing it from the 
   %ActiveTransactions hash.
   
 Parameters:  Parameters:
   
 =item client    =item client  
     
    The UNIX domain socket open on our client.     The LondTransaction we are failing.
    
 =cut  =cut
   
 sub FailTransaction {  sub FailTransaction {
     my $client = shift;      my $transaction = shift;
       my $Lond        = $transaction->getServer();
       if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it.
    my $client  = $transcation->getClient();
    StartClientReply($client, "con_lost");
       }
   # not needed, done elsewhere if active.
   #    delete $ActiveTransactions{$Lond};
   
   }
   
     &Debug(8, "Failing transaction due to disconnect");  =pod
     my $Serial = $ActiveClients{$client};  =head1  EmptyQueue
     my $desc   = sprintf("Connection to lonc client %d", $Serial);  
     my $data   = "error: Connection to lond lost\n";    Fails all items in the work queue with con_lost.
     Note that each item in the work queue is a transaction.
     Event->io(fd     => $client,  
       poll   => "w",  
       desc   => $desc,  
       cb     => \&ClientWritable,  
       data   => $data);  
   
   =cut
   sub EmptyQueue {
       while($WorkQueue->Count()) {
    my $request = $Workqueue->dequeue(); # This is a transaction
    FailTransaction($request);
       }
 }  }
   
 =pod  =pod
Line 444  nonzero if we are allowed to create a ne Line 506  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,
     # otherwise it came from the idle set and has already been destroyed:      #  delete its transaction... note that FailTransaction should
       #  already have been called!!!
       #  otherwise it came from the idle set.
       #  
           
     if(exists($ActiveTransactions{$Socket})) {      if(exists($ActiveTransactions{$Socket})) {
  delete ($ActiveTransactions{$Socket});   delete ($ActiveTransactions{$Socket});
Line 456  sub KillSocket { Line 520  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 541  sub LondReadable { Line 608  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 582  sub LondReadable { Line 649  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 667  sub LondWritable { Line 734  sub LondWritable {
     my @data    = $Watcher->data;      my @data    = $Watcher->data;
     Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");      Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");
   
     my $Socket  = $data[0]; # I know there's at least a socket.      my $Socket  = $data; # I know there's at least a socket.
   
     #  Figure out what to do depending on the state of the socket:      #  Figure out what to do depending on the state of the socket:
           
Line 684  sub LondWritable { Line 751  sub LondWritable {
     # We'll treat this as if the socket got disconnected:      # We'll treat this as if the socket got disconnected:
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
  }   }
  #  "init" is being sent...   #  "init" is being sent...
Line 706  sub LondWritable { Line 773  sub LondWritable {
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
  }   }
   
Line 727  sub LondWritable { Line 794  sub LondWritable {
     # Write resulted in an error.      # Write resulted in an error.
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
   
  }   }
Line 749  sub LondWritable { Line 816  sub LondWritable {
  FailTransaction($ActiveTransactions{$Socket});   FailTransaction($ActiveTransactions{$Socket});
     }      }
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
           
  }   }
Line 771  sub LondWritable { Line 838  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);
    my $Transaction = LondTransaction->new($cmd);
    $Transaction->SetDeferred($reqfile);
    QueueTransaction($Transaction);
       }
       
   }
   
 =pod  =pod
   
Line 810  sub MakeLondConnection { Line 898  sub MakeLondConnection {
  $event = Event->io(fd       => $Socket,   $event = Event->io(fd       => $Socket,
    poll     => 'w',     poll     => 'w',
    cb       => \&LondWritable,     cb       => \&LondWritable,
    data     => ($Connection, undef),     data     => \$Connection,
    desc => 'Connection to lond server');     desc => 'Connection to lond server');
  $ActiveConnections{$Connection} = $event;   $ActiveConnections{$Connection} = $event;
   
  $ConnectionCount++;   $ConnectionCount++;
    if($ConnectionCount == 1) { # First Connection:
       QueueDelayed;
    }
     }      }
           
 }  }
Line 846  The text of the request to send. Line 937  The text of the request to send.
   
 sub StartRequest {  sub StartRequest {
     my $Lond     = shift;      my $Lond     = shift;
     my $Client   = shift;      my $Request  = shift; # This is a LondTransaction.
     my $Request  = shift;  
           
     Debug(6, "StartRequest: ".$Request);      Debug(6, "StartRequest: ".$Request->getRequest());
   
     my $Socket = $Lond->GetSocket();      my $Socket = $Lond->GetSocket();
           
     $ActiveTransactions{$Lond} = $Client; # Socket to relay to client.      $Request->Activate($Lond);
       $ActiveTransactions{$Lond} = $Request;
   
     $Lond->InitiateTransaction($Request);      $Lond->InitiateTransaction($Request->getRequest());
     $event = Event->io(fd      => $Lond->GetSocket(),      $event = Event->io(fd      => $Lond->GetSocket(),
        poll    => "w",         poll    => "w",
        cb      => \&LondWritable,         cb      => \&LondWritable,
Line 887  data to send to the lond. Line 978  data to send to the lond.
 =cut  =cut
   
 sub QueueTransaction {  sub QueueTransaction {
     my $requestSocket = shift;  
     my $requestData   = shift;  
   
     Debug(6,"QueueTransaction: ".$requestData);      my $requestData   = shift; # This is a LondTransaction.
       my $cmd           = $requestData->getRequest();
   
       Debug(6,"QueueTransaction: ".$cmd);
   
     my $LondSocket    = $IdleConnections->pop();      my $LondSocket    = $IdleConnections->pop();
     if(!defined $LondSocket) { # Need to queue request.      if(!defined $LondSocket) { # Need to queue request.
  Debug(8,"Must queue...");   Debug(8,"Must queue...");
  $ClientQueue->enqueue($requestSocket);  
  $WorkQueue->enqueue($requestData);   $WorkQueue->enqueue($requestData);
  if($ConnectionCount < $MaxConnectionCount) {   if($ConnectionCount < $MaxConnectionCount) {
     Debug(4,"Starting additional lond connection");      Debug(4,"Starting additional lond connection");
Line 903  sub QueueTransaction { Line 994  sub QueueTransaction {
  }   }
     } else { # Can start the request:      } else { # Can start the request:
  Debug(8,"Can start...");   Debug(8,"Can start...");
  StartRequest($LondSocket, $requestSocket, $requestData);   StartRequest($LondSocket,  $requestData);
     }      }
 }  }
   
Line 943  sub ClientRequest { Line 1034  sub ClientRequest {
     $watcher->data($data);      $watcher->data($data);
     if($data =~ /(.*\n)/) { # Request entirely read.      if($data =~ /(.*\n)/) { # Request entirely read.
  Debug(8, "Complete transaction received: ".$data);   Debug(8, "Complete transaction received: ".$data);
  QueueTransaction($socket, $data);   my $Transaction = new LondTransaction->new($data);
    $Transaction->SetClient($socket);
    QueueTransaction($Transaction);
  $watcher->cancel(); # Done looking for input data.   $watcher->cancel(); # Done looking for input data.
     }      }
   
Line 1005  Returns the host whose lond we talk with Line 1098  Returns the host whose lond we talk with
   
 =cut  =cut
   
 sub GetServerHost { # Stub - get this from config.  sub GetServerHost {
     return $RemoteHost; # Setup by the fork.      return $RemoteHost; # Setup by the fork.
 }  }
   
Line 1017  Returns the lond port number. Line 1110  Returns the lond port number.
   
 =cut  =cut
   
 sub GetServerPort { # Stub - get this from config.  sub GetServerPort {
     return $perlvar{londPort};      return $perlvar{londPort};
 }  }
   
Line 1038  sub SetupLoncListener { Line 1131  sub SetupLoncListener {
     my $socket;      my $socket;
     my $SocketName = GetLoncSocketPath();      my $SocketName = GetLoncSocketPath();
     unlink($SocketName);      unlink($SocketName);
     unless ($socket = IO::Socket::UNIX->new(Local  => $SocketName,      unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
     Listen => 10,       Listen => 10, 
     Type   => SOCK_STREAM)) {      Type   => SOCK_STREAM)) {
  die "Failed to create a lonc listner socket";   die "Failed to create a lonc listner socket";
Line 1125  sub CreateChild { Line 1218  sub CreateChild {
 #  #
   
   
   
   
 ShowStatus("Parent writing pid file:");  ShowStatus("Parent writing pid file:");
 $execdir = $perlvar{'lonDaemons'};  $execdir = $perlvar{'lonDaemons'};
 open (PIDSAVE, ">$execdir/logs/lonc.pid");  open (PIDSAVE, ">$execdir/logs/lonc.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  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");  ShowStatus("Forking node servers");
   
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
Removed from v.1.5  
changed lines
  Added in v.1.7

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