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

Diff for /loncom/loncnew between versions 1.8 and 1.9

version 1.8, 2003/06/11 02:04:35 version 1.9, 2003/06/13 02:38:43
Line 41 Line 41
 #    - Add Configuration file I/O                       (done).  #    - Add Configuration file I/O                       (done).
 #    - Add management/status request interface.  #    - Add management/status request interface.
 #    - Add deferred request capability.                  (done)  #    - 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  #    Revision 1.8  2003/06/11 02:04:35  foxr
 #    Support delayed transactions... this is done uniformly by encapsulating  #    Support delayed transactions... this is done uniformly by encapsulating
 #    transactions in an object ... a LondTransaction that is implemented by  #    transactions in an object ... a LondTransaction that is implemented by
Line 62  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 72  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 97  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 = 2;  my $DebugLevel = 0;
 my $IdleTimeout= 3600; # Wait an hour before pruning connections.  my $IdleTimeout= 3600; # Wait an hour before pruning connections.
   
 #  #
Line 113  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 184  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 404  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.
  &Debug(4, "Deferred transaction complete: ".$Transaction->getFile().   Log("SUCCESS", "A delayed transaction was completed");
        " request: ".$Transaction->getRequest().  
        " answer: ".$Socket->GetReply());  
  unlink $Transaction->getFile();   unlink $Transaction->getFile();
     }      }
 }  }
Line 492  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 515  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 657  sub LondReadable { Line 732  sub LondReadable {
     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");
  }   }
  ServerToIdle($Socket); # Next work unit or idle.   ServerToIdle($Socket); # Next work unit or idle.
   
Line 759  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 898  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 925  sub MakeLondConnection { Line 1004  sub MakeLondConnection {
  if($ConnectionCount == 1) { # First Connection:   if($ConnectionCount == 1) { # First Connection:
     QueueDelayed;      QueueDelayed;
  }   }
    Log("SUCESS", "Created connection ".$ConnectionCount
       ." to host ".GetServerHost());
     }      }
           
 }  }
Line 1052  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 = LondTransaction->new($data);   my $Transaction = LondTransaction->new($data);
  $Transaction->SetClient($socket);   $Transaction->SetClient($socket);
Line 1171  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 1210  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 1264  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 1281  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.8  
changed lines
  Added in v.1.9

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