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

Diff for /loncom/loncnew between versions 1.7 and 1.9

version 1.7, 2003/06/03 01:59:39 version 1.9, 2003/06/13 02:38:43
Line 39 Line 39
 #    - 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                       (done).  #    - Add Configuration file I/O                       (done).
 #    - Add Pending request processing on startup.  
 #    - Add management/status request interface.  #    - Add management/status request interface.
 #    - Add deferred request capability.  #    - Add deferred request capability.                  (done)
   #    - Detect transmission timeouts.
 #  #
   
 # Change log:  # Change log:
 #    $Log$  #    $Log$
   #    Revision 1.9  2003/06/13 02:38:43  foxr
   #    Add logging in 'expected format'
   #
   #    Revision 1.8  2003/06/11 02:04:35  foxr
   #    Support delayed transactions... this is done uniformly by encapsulating
   #    transactions in an object ... a LondTransaction that is implemented by
   #    LondTransaction.pm
   #
 #    Revision 1.7  2003/06/03 01:59:39  foxr  #    Revision 1.7  2003/06/03 01:59:39  foxr
 #    complete coding to support deferred transactions.  #    complete coding to support deferred transactions.
 #  #
Line 58  use POSIX qw(:signal_h); Line 66  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::File;
 use IO::Handle;  use IO::Handle;
 use Socket;  use Socket;
 use Crypt::IDEA;  use Crypt::IDEA;
Line 68  use LONCAPA::LondTransaction; Line 77  use LONCAPA::LondTransaction;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::HashIterator;  use LONCAPA::HashIterator;
   
 print "Loncnew starting\n";  
   
 #  #
 #   Disable all signals we might receive from outside for now.  #   Disable all signals we might receive from outside for now.
Line 93  my %perlvar    = %{$perlvarref}; Line 101  my %perlvar    = %{$perlvarref};
 my %ChildHash; # by pid -> host.  my %ChildHash; # by pid -> host.
   
   
 my $MaxConnectionCount = 5; # Will get from config later.  my $MaxConnectionCount = 10; # Will get from config later.
 my $ClientConnection = 0; # Uniquifier for client events.  my $ClientConnection = 0; # Uniquifier for client events.
   
 my $DebugLevel = 5;  my $DebugLevel = 0;
 my $IdleTimeout= 3600; # Wait an hour before pruning connections.  my $IdleTimeout= 3600; # Wait an hour before pruning connections.
   
 #  #
Line 109  my %ActiveConnections;  # Connections to Line 117  my %ActiveConnections;  # Connections to
 my %ActiveTransactions; # LondTransactions 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 $ConnectionCount = 0;  my $ConnectionCount = 0;
 my $IdleSeconds     = 0; # Number of seconds idle.  my $IdleSeconds     = 0; # Number of seconds idle.
   my $Status          = ""; # Current status string.
   
 #  
 #   This disconnected socket makes posible a bit more regular  
 #   code when processing delayed requests:  
 #  
 my $NullSocket = IO::Socket->new();  
   
 #  #
   #   The hash below gives the HTML format for log messages
   #   given a severity.
   #    
   my %LogFormats;
   
   $LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
   $LogFormats{"SUCCESS"}  = "<font color=green>SUCCESS: %s</font>";
   $LogFormats{"INFO"}     = "<font color=yellow>INFO: %s</font>";
   $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";
   $LogFormats{"DEFAULT"}  = " %s ";
   
   my $lastlog = ''; # Used for status reporting.
   
   =pod
   
   =head2 Log
   
   Logs a message to the log file.
   Parameters:
   
   =item severity
   
   One of CRITICAL, WARNING, INFO, SUCCESS used to select the
   format string used to format the message.  if the severity is
   not a defined severity the Default format string is used.
   
   =item message
   
   The base message.  In addtion to the format string, the message
   will be appended to a string containing the name of our remote
   host and the time will be formatted into the message.
   
   =cut
   
   sub Log {
       my $severity = shift;
       my $message  = shift;
      
       if(!$LogFormats{$severity}) {
    $severity = "DEFAULT";
       }
   
       my $format = $LogFormats{$severity};
       
       #  Put the window dressing in in front of the message format:
   
       my $now   = time;
       my $local = localtime($now);
       my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
       my $finalformat = $finalformat.$format."\n";
   
       # open the file and put the result.
   
       my $execdir = $perlvar{'lonDaemons'};
       my $fh      = IO::File->new(">>$execdir/logs/lonc.log");
       my $msg = sprintf($finalformat, $message);
       print $fh $msg;
       
   }
   
   
 =pod  =pod
   
Line 180  sub SocketDump { Line 243  sub SocketDump {
 sub ShowStatus {  sub ShowStatus {
     my $status = shift;      my $status = shift;
     $0 =  "lonc: ".$status;      $0 =  "lonc: ".$status;
       $Status  = $status; # Make available for logging.
   
 }  }
   
 =pod  =pod
Line 277  sub ServerToIdle { Line 342  sub ServerToIdle {
     unless($reqdata eq undef)  {      unless($reqdata eq undef)  {
  Debug(9, "Queue gave request data: ".$reqdata->getRequest());   Debug(9, "Queue gave request data: ".$reqdata->getRequest());
  &StartRequest($Socket,  $reqdata);   &StartRequest($Socket,  $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.
Line 399  sub CompleteTransaction { Line 465  sub CompleteTransaction {
  my $data   = $Socket->GetReply(); # Data to send.   my $data   = $Socket->GetReply(); # Data to send.
  StartClientReply($Transaction, $data);   StartClientReply($Transaction, $data);
     } else { # Delete deferred transaction file.      } else { # Delete deferred transaction file.
    Log("SUCCESS", "A delayed transaction was completed");
  unlink $Transaction->getFile();   unlink $Transaction->getFile();
     }      }
 }  }
Line 484  sub EmptyQueue { Line 551  sub EmptyQueue {
   
 =pod  =pod
   
   =head2 CloseAllLondConnections
   
   Close all connections open on lond prior to exit e.g.
   
   =cut
   sub CloseAllLondConnections {
       foreach $Socket (keys %ActiveConnections) {
    KillSocket($Socket);
       }
   }
   =cut
   
   =pod
   
 =head2 KillSocket  =head2 KillSocket
     
 Destroys a socket.  This function can be called either when a socket  Destroys a socket.  This function can be called either when a socket
Line 507  nonzero if we are allowed to create a ne Line 588  nonzero if we are allowed to create a ne
 sub KillSocket {  sub KillSocket {
     my $Socket = shift;      my $Socket = shift;
   
       $Socket->Shutdown();
   
     #  If the socket came from the active connection set,      #  If the socket came from the active connection set,
     #  delete its transaction... note that FailTransaction should      #  delete its transaction... note that FailTransaction should
     #  already have been called!!!      #  already have been called!!!
Line 588  transaction is in progress, the socket a Line 671  transaction is in progress, the socket a
 =cut  =cut
   
 sub LondReadable {  sub LondReadable {
   
     my $Event      = shift;      my $Event      = shift;
     my $Watcher    = $Event->w;      my $Watcher    = $Event->w;
     my $Socket     = $Watcher->data;      my $Socket     = $Watcher->data;
     my $client     = undef;      my $client     = undef;
   
       &Debug(6,"LondReadable called state = ".$State);
   
   
     my $State = $Socket->GetState(); # All action depends on the state.      my $State = $Socket->GetState(); # All action depends on the state.
   
     &Debug(6,"LondReadable called state = ".$State);  
     SocketDump(6, $Socket);      SocketDump(6, $Socket);
   
     if($Socket->Readable() != 0) {      if($Socket->Readable() != 0) {
Line 624  sub LondReadable { Line 709  sub LondReadable {
  # in the connection takes care of setting that up.  Just   # in the connection takes care of setting that up.  Just
  # need to transition to writable:   # need to transition to writable:
   
  $Watcher->poll("w");  
  $Watcher->cb(\&LondWritable);   $Watcher->cb(\&LondWritable);
    $Watcher->poll("w");
   
     } elsif ($State eq "ChallengeReplied") {      } elsif ($State eq "ChallengeReplied") {
   
Line 634  sub LondReadable { Line 719  sub LondReadable {
  #  The ok was received.  Now we need to request the key   #  The ok was received.  Now we need to request the key
  #  That requires us to be writable:   #  That requires us to be writable:
   
  $Watcher->poll("w");  
  $Watcher->cb(\&LondWritable);   $Watcher->cb(\&LondWritable);
    $Watcher->poll("w");
   
     } elsif ($State eq "ReceivingKey") {      } elsif ($State eq "ReceivingKey") {
   
     } elsif ($State eq "Idle") {      } elsif ($State eq "Idle") {
  # If necessary, complete a transaction and then go into the   # If necessary, complete a transaction and then go into the
  # idle queue.   # idle queue.
    $Watcher->cancel();
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     Debug(8,"Completing transaction!!");      Debug(8,"Completing transaction!!");
     CompleteTransaction($Socket,       CompleteTransaction($Socket, 
  $ActiveTransactions{$Socket});   $ActiveTransactions{$Socket});
    } else {
       Log("SUCCESS", "Connection ".$ConnectionCount." to "
    .$RemoteHost." now ready for action");
  }   }
  $Watcher->cancel();  
  ServerToIdle($Socket); # Next work unit or idle.   ServerToIdle($Socket); # Next work unit or idle.
   
     } elsif ($State eq "SendingRequest") {      } elsif ($State eq "SendingRequest") {
Line 731  is the socket on which to return a reply Line 819  is the socket on which to return a reply
 sub LondWritable {  sub LondWritable {
     my $Event   = shift;      my $Event   = shift;
     my $Watcher = $Event->w;      my $Watcher = $Event->w;
     my @data    = $Watcher->data;      my $Socket  = $Watcher->data;
     Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");      my $State   = $Socket->GetState();
   
     my $Socket  = $data; # I know there's at least a socket.      Debug(6,"LondWritable State = ".$State."\n");
   
    
     #  Figure out what to do depending on the state of the socket:      #  Figure out what to do depending on the state of the socket:
           
   
     my $State   = $Socket->GetState();  
   
   
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 749  sub LondWritable { Line 837  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:
       Log("WARNING", "Connection to ".$RemoteHost.
    " has been disconnected");
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket);      KillSocket($Socket);
     return;      return;
Line 762  sub LondWritable { Line 851  sub LondWritable {
  # Now that init was sent, we switch    # Now that init was sent, we switch 
  # to watching for readability:   # to watching for readability:
   
  $Watcher->poll("r");  
  $Watcher->cb(\&LondReadable);   $Watcher->cb(\&LondReadable);
    $Watcher->poll("r");
   
     } elsif ($State eq "ChallengeReceived") {      } elsif ($State eq "ChallengeReceived") {
  # We received the challenge, now we    # We received the challenge, now we 
Line 781  sub LondWritable { Line 870  sub LondWritable {
  # The echo was sent back, so we switch   # The echo was sent back, so we switch
  # to watching readability.   # to watching readability.
   
  $Watcher->poll("r");  
  $Watcher->cb(\&LondReadable);   $Watcher->cb(\&LondReadable);
    $Watcher->poll("r");
   
     } elsif ($State eq "RequestingKey")     {      } elsif ($State eq "RequestingKey")     {
  # At this time we're requesting the key.   # At this time we're requesting the key.
Line 802  sub LondWritable { Line 891  sub LondWritable {
  # 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:
   
  $Watcher->poll("r");  
  $Watcher->cb(\&LondReadable);   $Watcher->cb(\&LondReadable);
    $Watcher->poll("r");
   
     } elsif ($State eq "SendingRequest")    {      } elsif ($State eq "SendingRequest")    {
  # At this time we are sending a request to the   # At this time we are sending a request to the
Line 825  sub LondWritable { Line 914  sub LondWritable {
  # The send has completed.  Wait for the   # The send has completed.  Wait for the
  # data to come in for a reply.   # data to come in for a reply.
  Debug(8,"Writable sent request/receiving reply");   Debug(8,"Writable sent request/receiving reply");
  $Watcher->poll("r");  
  $Watcher->cb(\&LondReadable);   $Watcher->cb(\&LondReadable);
    $Watcher->poll("r");
   
     } else {      } else {
  #  Control only passes here on an error:    #  Control only passes here on an error: 
Line 842  sub LondWritable { Line 931  sub LondWritable {
           
 =cut  =cut
 sub QueueDelayed {  sub QueueDelayed {
       Debug(3,"QueueDelayed called");
   
     my $path = "$perlvar{'lonSockDir'}/delayed";      my $path = "$perlvar{'lonSockDir'}/delayed";
   
       Debug(4, "Delayed path: ".$path);
     opendir(DIRHANDLE, $path);      opendir(DIRHANDLE, $path);
       
     @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;      @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
       Debug(4, "Got ".$alldelayed." delayed files");
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     my $dfname;      my $dfname;
     my $reqfile      my $reqfile;
     foreach $reqfile (sort @alldelayed) {      foreach $dfname (sort  @alldelayed) {
  $reqfile = $path/$reqfile;   $reqfile = "$path/$dfname";
    Debug(4, "queueing ".$reqfile);
  my $Handle = IO::File->new($reqfile);   my $Handle = IO::File->new($reqfile);
  my $cmd    = <$Handle>;   my $cmd    = <$Handle>;
  chomp($cmd);   chomp $cmd; # There may or may not be a newline...
    $cmd = $cmd."\ny"; # now for sure there's exactly one newline.
  my $Transaction = LondTransaction->new($cmd);   my $Transaction = LondTransaction->new($cmd);
  $Transaction->SetDeferred($reqfile);   $Transaction->SetDeferred($reqfile);
  QueueTransaction($Transaction);   QueueTransaction($Transaction);
Line 880  sub MakeLondConnection { Line 977  sub MakeLondConnection {
  &GetServerPort());   &GetServerPort());
   
     if($Connection == undef) { # Needs to be more robust later.      if($Connection == undef) { # Needs to be more robust later.
  Debug(0,"Failed to make a connection with lond.");   Log("CRITICAL","Failed to make a connection with lond.");
     }  else {      }  else {
  # 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 898  sub MakeLondConnection { Line 995  sub MakeLondConnection {
  $event = Event->io(fd       => $Socket,   $event = Event->io(fd       => $Socket,
    poll     => 'w',     poll     => 'w',
    cb       => \&LondWritable,     cb       => \&LondWritable,
    data     => \$Connection,     data     => $Connection,
    desc => 'Connection to lond server');     desc => 'Connection to lond server');
  $ActiveConnections{$Connection} = $event;   $ActiveConnections{$Connection} = $event;
   
  $ConnectionCount++;   $ConnectionCount++;
    Debug(4, "Connection count = ".$ConnectionCount);
  if($ConnectionCount == 1) { # First Connection:   if($ConnectionCount == 1) { # First Connection:
     QueueDelayed;      QueueDelayed;
  }   }
    Log("SUCESS", "Created connection ".$ConnectionCount
       ." to host ".GetServerHost());
     }      }
           
 }  }
Line 947  sub StartRequest { Line 1047  sub StartRequest {
     $ActiveTransactions{$Lond} = $Request;      $ActiveTransactions{$Lond} = $Request;
   
     $Lond->InitiateTransaction($Request->getRequest());      $Lond->InitiateTransaction($Request->getRequest());
     $event = Event->io(fd      => $Lond->GetSocket(),      $event = Event->io(fd      => $Socket,
        poll    => "w",         poll    => "w",
        cb      => \&LondWritable,         cb      => \&LondWritable,
        data    => $Lond,         data    => $Lond,
Line 1033  sub ClientRequest { Line 1133  sub ClientRequest {
     $data = $data.$thisread; # Append new data.      $data = $data.$thisread; # Append new data.
     $watcher->data($data);      $watcher->data($data);
     if($data =~ /(.*\n)/) { # Request entirely read.      if($data =~ /(.*\n)/) { # Request entirely read.
    if($data == "close_connection_exit\n") {
       Log("CRITICAL",
    "Request Close Connection ... exiting");
       CloseAllLondConnections();
       exit;
    }
  Debug(8, "Complete transaction received: ".$data);   Debug(8, "Complete transaction received: ".$data);
  my $Transaction = new LondTransaction->new($data);   my $Transaction = LondTransaction->new($data);
  $Transaction->SetClient($socket);   $Transaction->SetClient($socket);
  QueueTransaction($Transaction);   QueueTransaction($Transaction);
  $watcher->cancel(); # Done looking for input data.   $watcher->cancel(); # Done looking for input data.
Line 1152  This sub implements a child process for Line 1258  This sub implements a child process for
   
 sub ChildProcess {  sub ChildProcess {
   
     print "Loncnew\n";  
   
     # For now turn off signals.      # For now turn off signals.
           
Line 1191  sub ChildProcess { Line 1296  sub ChildProcess {
 sub CreateChild {  sub CreateChild {
     my $host = shift;      my $host = shift;
     $RemoteHost = $host;      $RemoteHost = $host;
     Debug(3, "Forking off child for ".$RemoteHost);      Log("CRITICAL", "Forking server for ".$host);
     sleep(5);  
     $pid          = fork;      $pid          = fork;
     if($pid) { # Parent      if($pid) { # Parent
  $ChildHash{$pid} = $RemoteHost;   $ChildHash{$pid} = $RemoteHost;
Line 1220  sub CreateChild { Line 1324  sub CreateChild {
   
   
   
 ShowStatus("Parent writing pid file:");  
 $execdir = $perlvar{'lonDaemons'};  
 open (PIDSAVE, ">$execdir/logs/lonc.pid");  
 print PIDSAVE "$$\n";  
 close(PIDSAVE);  
   
 ShowStatus("Forming new session");  ShowStatus("Forming new session");
 my $childpid = fork;  my $childpid = fork;
Line 1232  if ($childpid != 0) { Line 1332  if ($childpid != 0) {
     sleep 4; # Give child a chacne to break to      sleep 4; # Give child a chacne to break to
     exit 0; # a new sesion.      exit 0; # a new sesion.
 }  }
   #
   #   Write my pid into the pid file so I can be located
   #
   
   ShowStatus("Parent writing pid file:");
   $execdir = $perlvar{'lonDaemons'};
   open (PIDSAVE, ">$execdir/logs/lonc.pid");
   print PIDSAVE "$$\n";
   close(PIDSAVE);
   
 if (POSIX::setsid() < 0) {  if (POSIX::setsid() < 0) {
     print "Could not create new session\n";      print "Could not create new session\n";
Line 1240  if (POSIX::setsid() < 0) { Line 1349  if (POSIX::setsid() < 0) {
   
 ShowStatus("Forking node servers");  ShowStatus("Forking node servers");
   
   Log("CRITICAL", "--------------- Starting children ---------------");
   
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
 while (! $HostIterator->end()) {  while (! $HostIterator->end()) {
   
Line 1257  while(1) { Line 1368  while(1) {
     if(exists $ChildHash{$deadchild}) { # need to restart.      if(exists $ChildHash{$deadchild}) { # need to restart.
  $deadhost = $ChildHash{$deadchild};   $deadhost = $ChildHash{$deadchild};
  delete($ChildHash{$deadchild});   delete($ChildHash{$deadchild});
  Debug(4,"Lost child pid= ".$deadchild.   Log("WARNING","Lost child pid= ".$deadchild.
       "Connected to host ".$deadhost);        "Connected to host ".$deadhost);
    Log("INFO", "Restarting child procesing ".$deadhost);
  CreateChild($deadhost);   CreateChild($deadhost);
     }      }
 }  }
Removed from v.1.7  
changed lines
  Added in v.1.9

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