Diff for /loncom/loncnew between versions 1.9 and 1.10

version 1.9, 2003/06/13 02:38:43 version 1.10, 2003/06/24 02:46:04
Line 46 Line 46
   
 # Change log:  # Change log:
 #    $Log$  #    $Log$
   #    Revision 1.10  2003/06/24 02:46:04  foxr
   #    Put a limit on  the number of times we'll retry a connection.
   #    Start getting the signal stuff put in as well...note that need to get signals
   #    going or else 6the client will permanently give up on dead servers.
   #
 #    Revision 1.9  2003/06/13 02:38:43  foxr  #    Revision 1.9  2003/06/13 02:38:43  foxr
 #    Add logging in 'expected format'  #    Add logging in 'expected format'
 #  #
Line 120  my $WorkQueue       = Queue->new(); # Qu Line 125  my $WorkQueue       = Queue->new(); # Qu
 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.  my $Status          = ""; # Current status string.
   my $ConnectionRetries=5; # Number of connection retries allowed.
   my $ConnectionRetriesLeft=5; # Number of connection retries remaining.
   
 #  #
 #   The hash below gives the HTML format for log messages  #   The hash below gives the HTML format for log messages
Line 134  $LogFormats{"INFO"}     = "<font color=y Line 140  $LogFormats{"INFO"}     = "<font color=y
 $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";  $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";
 $LogFormats{"DEFAULT"}  = " %s ";  $LogFormats{"DEFAULT"}  = " %s ";
   
 my $lastlog = ''; # Used for status reporting.  
   
   =pod
   
   =head2 LogPerm
   
   Makes an entry into the permanent log file.
   
   =cut
   sub LogPerm {
       my $message=shift;
       my $execdir=$perlvar{'lonDaemons'};
       my $now=time;
       my $local=localtime($now);
       my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
       print $fh "$now:$message:$local\n";
   }
   
 =pod  =pod
   
Line 181  sub Log { Line 203  sub Log {
     my $msg = sprintf($finalformat, $message);      my $msg = sprintf($finalformat, $message);
     print $fh $msg;      print $fh $msg;
           
       
 }  }
   
   
Line 238  sub SocketDump { Line 261  sub SocketDump {
 =head2 ShowStatus  =head2 ShowStatus
   
  Place some text as our pid status.   Place some text as our pid status.
    and as what we return in a SIGUSR1
   
 =cut  =cut
 sub ShowStatus {  sub ShowStatus {
     my $status = shift;      my $state = shift;
     $0 =  "lonc: ".$status;      my $now = time;
     $Status  = $status; # Make available for logging.      my $local = localtime($now);
       $Status   = $local.": ".$state;
       $0='lonc: '.$state.' '.$local;
 }  }
   
 =pod  =pod
Line 283  sub Tick { Line 308  sub Tick {
     #      #
           
     my $Requests = $WorkQueue->Count();      my $Requests = $WorkQueue->Count();
     if (($ConnectionCount == 0)  && ($Requests > 0)) {      if (($ConnectionCount == 0)  && ($Requests > 0)) { 
  my $Connections = ($Requests <= $MaxConnectionCount) ?   if ($ConnectionRetriesLeft > 0) {
                            $Requests : $MaxConnectionCount;      my $Connections = ($Requests <= $MaxConnectionCount) ?
  Debug(1,"Work but no connections, starting ".$Connections." of them");   $Requests : $MaxConnectionCount;
  for ($i =0; $i < $Connections; $i++) {      Debug(1,"Work but no connections, start ".$Connections." of them");
     MakeLondConnection();      for ($i =0; $i < $Connections; $i++) {
    MakeLondConnection();
       }
    } else {
       Debug(1,"Work in queue, but gave up on connections..flushing\n");
       EmptyQueue(); # Connections can't be established.
  }   }
                 
     }      }
Line 466  sub CompleteTransaction { Line 496  sub CompleteTransaction {
  StartClientReply($Transaction, $data);   StartClientReply($Transaction, $data);
     } else { # Delete deferred transaction file.      } else { # Delete deferred transaction file.
  Log("SUCCESS", "A delayed transaction was completed");   Log("SUCCESS", "A delayed transaction was completed");
    LogPerm("S:$Client:".$Transaction->getRequest());
  unlink $Transaction->getFile();   unlink $Transaction->getFile();
     }      }
 }  }
Line 525  Parameters: Line 556  Parameters:
   
 sub FailTransaction {  sub FailTransaction {
     my $transaction = shift;      my $transaction = shift;
     my $Lond        = $transaction->getServer();      Debug(1, "Failing transaction: ".$transaction->getRequest());
     if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it.      if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
  my $client  = $transcation->getClient();   my $client  = $transcation->getClient();
  StartClientReply($client, "con_lost");   Debug(1," Replying con_lost to ".$transaction->getRequest());
    StartClientReply($client, "con_lost\n");
     }      }
 # not needed, done elsewhere if active.  
 #    delete $ActiveTransactions{$Lond};  
   
 }  }
   
Line 544  sub FailTransaction { Line 574  sub FailTransaction {
 =cut  =cut
 sub EmptyQueue {  sub EmptyQueue {
     while($WorkQueue->Count()) {      while($WorkQueue->Count()) {
  my $request = $Workqueue->dequeue(); # This is a transaction   my $request = $WorkQueue->dequeue(); # This is a transaction
  FailTransaction($request);   FailTransaction($request);
     }      }
 }  }
Line 978  sub MakeLondConnection { Line 1008  sub MakeLondConnection {
   
     if($Connection == undef) { # Needs to be more robust later.      if($Connection == undef) { # Needs to be more robust later.
  Log("CRITICAL","Failed to make a connection with lond.");   Log("CRITICAL","Failed to make a connection with lond.");
    $ConnectionRetriesLeft--;
    return 0; # Failure.
     }  else {      }  else {
    $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
  # 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
  # that starts the whole authentication/key   # that starts the whole authentication/key
Line 1006  sub MakeLondConnection { Line 1039  sub MakeLondConnection {
  }   }
  Log("SUCESS", "Created connection ".$ConnectionCount   Log("SUCESS", "Created connection ".$ConnectionCount
     ." to host ".GetServerHost());      ." to host ".GetServerHost());
    return 1; # Return success.
     }      }
           
 }  }
Line 1103  sub QueueTransaction { Line 1137  sub QueueTransaction {
 =pod  =pod
   
 =head2 ClientRequest  =head2 ClientRequest
   
 Callback that is called when data can be read from the UNIX domain  Callback that is called when data can be read from the UNIX domain
 socket connecting us with an apache server process.  socket connecting us with an apache server process.
   
Line 1128  sub ClientRequest { Line 1161  sub ClientRequest {
  close($socket);   close($socket);
  $watcher->cancel();   $watcher->cancel();
  delete($ActiveClients{$socket});   delete($ActiveClients{$socket});
    return;
     }      }
     Debug(8,"Data: ".$data." this read: ".$thisread);      Debug(8,"Data: ".$data." this read: ".$thisread);
     $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") {   if($data eq "close_connection_exit\n") {
     Log("CRITICAL",      Log("CRITICAL",
  "Request Close Connection ... exiting");   "Request Close Connection ... exiting");
     CloseAllLondConnections();      CloseAllLondConnections();
Line 1250  sub SetupLoncListener { Line 1284  sub SetupLoncListener {
   
 =pod  =pod
   
   =head2 SignalledToDeath
   
   Called in response to a signal that causes a chid process to die.
   
   =cut
   
   =pod
   
   sub SignalledToDeath {
       my ($signal) = @_;
       chomp($signal);
       Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "
    ."died through "."\"$signal\"");
       LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
       ."\"$signal\"");
       die("Signal abnormal end");
   
   }
 =head2 ChildProcess  =head2 ChildProcess
   
 This sub implements a child process for a single lonc daemon.  This sub implements a child process for a single lonc daemon.
Line 1261  sub ChildProcess { Line 1313  sub ChildProcess {
   
     # For now turn off signals.      # For now turn off signals.
           
     $SIG{QUIT}  = IGNORE;      $SIG{QUIT}  = \&SignalledToDeath;
     $SIG{HUP}   = IGNORE;      $SIG{HUP}   = IGNORE;
     $SIG{USR1}  = IGNORE;      $SIG{USR1}  = IGNORE;
     $SIG{INT}   = IGNORE;      $SIG{INT}   = IGNORE;
     $SIG{CHLD}  = IGNORE;      $SIG{CHLD}  = IGNORE;
     $SIG{__DIE__}  = IGNORE;      $SIG{__DIE__}  = \&SignalledToDeath;
   
     SetupTimer();      SetupTimer();
           
Line 1278  sub ChildProcess { Line 1330  sub ChildProcess {
   
 # Setup the initial server connection:  # Setup the initial server connection:
           
     &MakeLondConnection();       # &MakeLondConnection(); // let first work requirest do it.
   
   
     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 1363  while (! $HostIterator->end()) { Line 1412  while (! $HostIterator->end()) {
   
 ShowStatus("Parent keeping the flock");  ShowStatus("Parent keeping the flock");
   
   #
   #   Set up parent signals:
   #
   $SIG{INT}  = &KillThemAll;
   $SIG{TERM} = &KillThemAll; 
   
 while(1) {  while(1) {
     $deadchild = wait();      $deadchild = wait();
     if(exists $ChildHash{$deadchild}) { # need to restart.      if(exists $ChildHash{$deadchild}) { # need to restart.
Line 1374  while(1) { Line 1429  while(1) {
  CreateChild($deadhost);   CreateChild($deadhost);
     }      }
 }  }
   sub KillThemAll {
   }
   
 =head1 Theory  =head1 Theory
   

Removed from v.1.9  
changed lines
  Added in v.1.10


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