Diff for /loncom/loncnew between versions 1.14 and 1.22

version 1.14, 2003/07/03 02:10:18 version 1.22, 2003/09/02 10:34:47
Line 7 Line 7
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  ## LON-CAPA is free software; you can redistribute it and/or modify
 # LON-CAPA is free software; you can redistribute it and/or modify  
 # it under the terms of the GNU General Public License as published by  # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2 of the License, or  # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.  # (at your option) any later version.
Line 27 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #  #
 # new lonc handles n requestors spread out bver m connections to londs.  # new lonc handles n request out bver m connections to londs.
 # This module is based on the Event class.  # This module is based on the Event class.
 #   Development iterations:  #   Development iterations:
 #    - Setup basic event loop.   (done)  #    - Setup basic event loop.   (done)
Line 46 Line 45
   
 # Change log:  # Change log:
 #    $Log$  #    $Log$
   #    Revision 1.22  2003/09/02 10:34:47  foxr
   #    - Fix errors in host dead detection logic (too many cases where the
   #      retries left were not getting incremented or just not checked).
   #    - Added some additional status to the ps axuww display:
   #      o Remaining retries on a host.
   #      o >>> DEAD <<< indicator if I've given up on a host.
   #    - Tested the SIGHUP will reset the retries remaining count (thanks to
   #      the above status stuff, and get allow the loncnew to re-try again
   #      on the host (thanks to the log).
   #
   #    Revision 1.21  2003/08/26 09:19:51  foxr
   #    How embarrassing... put in the SocketTimeout function in loncnew and forgot
   #    to actually hook it into the LondTransaction.  Added this to MakeLondConnection
   #    where it belongs... hopefully transactions (not just connection attempts) will
   #    timeout more speedily than the socket errors will catch it.
   #
   #    Revision 1.20  2003/08/25 18:48:11  albertel
   #    - fixing a forgotten ;
   #
   #    Revision 1.19  2003/08/19 09:31:46  foxr
   #    Get socket directory from configuration rather than the old hard coded test
   #    way that I forgot to un-hard code.
   #
   #    Revision 1.18  2003/08/06 09:52:29  foxr
   #    Also needed to remember to fail in-flight transactions if their sends fail.
   #
   #    Revision 1.17  2003/08/03 00:44:31  foxr
   #    1. Correct handling of connection failure: Assume it means the host is
   #       unreachable and fail all of the queued transactions.  Note that the
   #       inflight transactions should fail on their own time due either to timeout
   #       or send/receive failures.
   #    2. Correct handling of logs for forced death signals.  Pull the signal
   #       from the event watcher.
   #
   #    Revision 1.16  2003/07/29 02:33:05  foxr
   #    Add SIGINT processing to child processes to toggle annoying trace mode
   #    on/off.. will try to use this to isolate the compute boud process issue.
   #
   #    Revision 1.15  2003/07/15 02:07:05  foxr
   #    Added code for lonc/lond transaction timeouts.  Who knows if it works right.
   #    The intent is for a timeout to fail any transaction in progress and kill
   #    off the sockt that timed out.
   #
 #    Revision 1.14  2003/07/03 02:10:18  foxr  #    Revision 1.14  2003/07/03 02:10:18  foxr
 #    Get all of the signals to work correctly.  #    Get all of the signals to work correctly.
 #  #
Line 58 Line 100
 #    Revision 1.10  2003/06/24 02:46:04  foxr  #    Revision 1.10  2003/06/24 02:46:04  foxr
 #    Put a limit on  the number of times we'll retry a connection.  #    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  #    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.  #    going or else the 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 $MaxConnectionCount = 10; # Will get Line 162  my $MaxConnectionCount = 10; # Will get
 my $ClientConnection = 0; # Uniquifier for client events.  my $ClientConnection = 0; # Uniquifier for client events.
   
 my $DebugLevel = 0;  my $DebugLevel = 0;
   my $NextDebugLevel= 10; # So Sigint can toggle this.
 my $IdleTimeout= 3600; # Wait an hour before pruning connections.  my $IdleTimeout= 3600; # Wait an hour before pruning connections.
   
 #  #
 #  The variables below are only used by the child processes.  #  The variables below are only used by the child processes.
 #  #
 my $RemoteHost; # Name of host child is talking to.  my $RemoteHost; # Name of host child is talking to.
 my $UnixSocketDir= "/home/httpd/sockets";   my $UnixSocketDir= $perlvar{'lonSockDir'};
 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; # LondTransactions in flight.  my %ActiveTransactions; # LondTransactions in flight.
Line 256  sub Debug { Line 299  sub Debug {
     my $level   = shift;      my $level   = shift;
     my $message = shift;      my $message = shift;
     if ($level <= $DebugLevel) {      if ($level <= $DebugLevel) {
  print $message." host = ".$RemoteHost."\n";   Log("INFO", "-Debug- $message host = $RemotHost");
     }      }
 }  }
   
Line 286  sub ShowStatus { Line 329  sub ShowStatus {
   
 =pod  =pod
   
   =head 2 SocketTimeout
   
       Called when an action on the socket times out.  The socket is 
      destroyed and any active transaction is failed.
   
   
   =cut
   sub SocketTimeout {
       my $Socket = shift;
       
       KillSocket($Socket); # A transaction timeout also counts as
                                   # a connection failure:
       $ConnectionRetriesLeft--;
   }
   
   =pod
   
 =head2 Tick  =head2 Tick
   
 Invoked  each timer tick.  Invoked  each timer tick.
Line 295  Invoked  each timer tick. Line 355  Invoked  each timer tick.
   
 sub Tick {  sub Tick {
     my $client;      my $client;
     ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);      if($ConnectionRetriesLeft > 0) {
    ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
      ." Retries remaining: ".$ConnectionRetriesLeft);
       } else {
    ShowStatus(GetServerHost()." >> DEAD <<");
       }
     # Is it time to prune connection count:      # Is it time to prune connection count:
   
   
Line 310  sub Tick { Line 374  sub Tick {
     } else {      } else {
  $IdleSeconds = 0; # Reset idle count if not idle.   $IdleSeconds = 0; # Reset idle count if not idle.
     }      }
       #
       #  For each inflight transaction, tick down its timeout counter.
       #
       foreach $item (keys %ActiveTransactions) {
    my $Socket = $ActiveTransactions{$item}->getServer();
    $Socket->Tick();
       }
     # Do we have work in the queue, but no connections to service them?      # 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.      # If so, try to make some new connections to get things going again.
     #      #
Line 321  sub Tick { Line 391  sub Tick {
     my $Connections = ($Requests <= $MaxConnectionCount) ?      my $Connections = ($Requests <= $MaxConnectionCount) ?
  $Requests : $MaxConnectionCount;   $Requests : $MaxConnectionCount;
     Debug(1,"Work but no connections, start ".$Connections." of them");      Debug(1,"Work but no connections, start ".$Connections." of them");
       my $successCount = 0;
     for ($i =0; $i < $Connections; $i++) {      for ($i =0; $i < $Connections; $i++) {
  MakeLondConnection();   $successCount += MakeLondConnection();
       }
       if($successCount == 0) { # All connections failed:
    Debug(1,"Work in queue failed to make any connectiouns\n");
    EmptyQueue(); # Fail pending transactions with con_lost.
     }      }
  } else {   } else {
       ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
     Debug(1,"Work in queue, but gave up on connections..flushing\n");      Debug(1,"Work in queue, but gave up on connections..flushing\n");
     EmptyQueue(); # Connections can't be established.      EmptyQueue(); # Connections can't be established.
  }   }
Line 448  sub ClientWritable { Line 524  sub ClientWritable {
   
     } else { # Partial string sent.      } else { # Partial string sent.
  $Watcher->data(substr($Data, $result));   $Watcher->data(substr($Data, $result));
    if($result == 0) {    # client hung up on us!!
       Log("INFO", "lonc pipe client hung up on us!");
       $Watcher->cancel;
       $Socket->shutdown(2);
       $Socket->close();
    }
     }      }
           
  } else { # Error of some sort...   } else { # Error of some sort...
Line 565  Parameters: Line 647  Parameters:
   
 sub FailTransaction {  sub FailTransaction {
     my $transaction = shift;      my $transaction = shift;
       Log("WARNING", "Failing transaction ".$transaction->getRequest());
     Debug(1, "Failing transaction: ".$transaction->getRequest());      Debug(1, "Failing transaction: ".$transaction->getRequest());
     if (!$transaction->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  = $transaction->getClient();   my $client  = $transaction->getClient();
  Debug(1," Replying con_lost to ".$transaction->getRequest());   Debug(1," Replying con_lost to ".$transaction->getRequest());
  StartClientReply($transaction, "con_lost\n");   StartClientReply($transaction, "con_lost\n");
     }      }
       if($ConnectionRetriesLeft <= 0) {
    Log("CRITICAL", "Host marked dead: ".GetServerHost());
       }
   
 }  }
   
Line 582  sub FailTransaction { Line 668  sub FailTransaction {
   
 =cut  =cut
 sub EmptyQueue {  sub EmptyQueue {
       $ConnectionRetriesLeft--; # Counts as connection failure too.
     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 627  nonzero if we are allowed to create a ne Line 714  nonzero if we are allowed to create a ne
 sub KillSocket {  sub KillSocket {
     my $Socket = shift;      my $Socket = shift;
   
       Log("WARNING", "Shutting down a socket");
     $Socket->Shutdown();      $Socket->Shutdown();
   
     #  If the socket came from the active connection set,      #  If the socket came from the active connection set,
Line 647  sub KillSocket { Line 735  sub KillSocket {
     #  work queue, the work all gets failed with con_lost.      #  work queue, the work all gets failed with con_lost.
     #      #
     if($ConnectionCount == 0) {      if($ConnectionCount == 0) {
  EmptyQueue;   EmptyQueue();
     }      }
 }  }
   
Line 723  sub LondReadable { Line 811  sub LondReadable {
   
     SocketDump(6, $Socket);      SocketDump(6, $Socket);
     my $status = $Socket->Readable();      my $status = $Socket->Readable();
   
     &Debug(2, "Socket->Readable returned: $status");      &Debug(2, "Socket->Readable returned: $status");
   
     if($status != 0) {      if($status != 0) {
  # bad return from socket read. Currently this means that   # bad return from socket read. Currently this means that
  # The socket has become disconnected. We fail the transaction.   # The socket has become disconnected. We fail the transaction.
   
    Log("WARNING",
       "Lond connection lost.");
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     Debug(3,"Lond connection lost failing transaction");  
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket);   KillSocket($Socket);
    $ConnectionRetriesLeft--;       # Counts as connection failure
  return;   return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 768  sub LondReadable { Line 859  sub LondReadable {
     } 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.
    #  Note that a trasition to idle indicates a live lond
    # on the other end so reset the connection retries.
    #
    $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
  $Watcher->cancel();   $Watcher->cancel();
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     Debug(8,"Completing transaction!!");      Debug(8,"Completing transaction!!");
Line 880  sub LondWritable { Line 975  sub LondWritable {
     # 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.      Log("WARNING", "Connection to ".$RemoteHost.
  " has been disconnected");   " has been disconnected");
       FailTransaction($ActiveTransactions{$Socket});
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket);      KillSocket($Socket);
     return;      return;
Line 1022  sub MakeLondConnection { Line 1118  sub MakeLondConnection {
  $ConnectionRetriesLeft--;   $ConnectionRetriesLeft--;
  return 0; # Failure.   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 1035  sub MakeLondConnection { Line 1131  sub MakeLondConnection {
     &Debug(9,"MakeLondConnection got socket: ".$Socket);      &Debug(9,"MakeLondConnection got socket: ".$Socket);
  }   }
   
    $Connection->SetTimeoutCallback(\&SocketTimeout);
   
  $event = Event->io(fd       => $Socket,   $event = Event->io(fd       => $Socket,
    poll     => 'w',     poll     => 'w',
    cb       => \&LondWritable,     cb       => \&LondWritable,
Line 1134  sub QueueTransaction { Line 1231  sub QueueTransaction {
  Debug(8,"Must queue...");   Debug(8,"Must queue...");
  $WorkQueue->enqueue($requestData);   $WorkQueue->enqueue($requestData);
  if($ConnectionCount < $MaxConnectionCount) {   if($ConnectionCount < $MaxConnectionCount) {
     Debug(4,"Starting additional lond connection");      if($ConnectionRetriesLeft > 0) {
     MakeLondConnection();   Debug(4,"Starting additional lond connection");
    if(MakeLondConnection() == 0) {
       EmptyQueue(); # Fail transactions, can't make connection.
    }
       } else {
    ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
    EmptyQueue(); # It's worse than that ... he's dead Jim.
       }
  }   }
     } else { # Can start the request:      } else { # Can start the request:
  Debug(8,"Can start...");   Debug(8,"Can start...");
Line 1300  sub SetupLoncListener { Line 1404  sub SetupLoncListener {
 Child USR1 signal handler to report the most recent status  Child USR1 signal handler to report the most recent status
 into the status file.  into the status file.
   
   We also use this to reset the retries count in order to allow the
   client to retry connections with a previously dead server.
 =cut  =cut
 sub ChildStatus {  sub ChildStatus {
     my $event = shift;      my $event = shift;
Line 1310  sub ChildStatus { Line 1416  sub ChildStatus {
     my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");      my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
     print $fh $$."\t".$RemoteHost."\t".$Status."\t".      print $fh $$."\t".$RemoteHost."\t".$Status."\t".
  $RecentLogEntry."\n";   $RecentLogEntry."\n";
       $ConnectionRetriesLeft = $ConnectionRetries;
 }  }
   
 =pod  =pod
Line 1326  sub SignalledToDeath { Line 1433  sub SignalledToDeath {
     my $watcher= $event->w;      my $watcher= $event->w;
   
     Debug(2,"Signalled to death! via ".$watcher->data);      Debug(2,"Signalled to death! via ".$watcher->data);
     my ($signal) = @_;      my ($signal) = $watcher->data;
     chomp($signal);      chomp($signal);
     Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "      Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "
  ."died through "."\"$signal\"");   ."died through "."\"$signal\"");
     LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "      LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
     ."\"$signal\"");      ."\"$signal\"");
     die("Signal abnormal end");  
     exit 0;      exit 0;
   
 }  }
   
   =head2 ToggleDebug
   
   This sub toggles trace debugging on and off.
   
   =cut
   
   sub ToggleDebug {
       my $Current    = $DebugLevel;
          $DebugLevel = $NextDebugLevel;
          $NextDebugLevel = $Current;
   
       Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");
   
   }
   
 =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 1348  sub ChildProcess { Line 1470  sub ChildProcess {
     #      #
     #  Signals must be handled by the Event framework...      #  Signals must be handled by the Event framework...
 #  #
 #    $SIG{QUIT}  = \&SignalledToDeath;  
 #    $SIG{HUP}   = \&ChildStatus;  
 #    $SIG{USR1}  = IGNORE;  
 #    $SIG{INT}   = DEFAULT;  
 #    $SIG{CHLD}  = IGNORE;  
 #    $SIG{__DIE__}  = \&SignalledToDeath;  
   
     Event->signal(signal   => "QUIT",      Event->signal(signal   => "QUIT",
   cb       => \&SignalledToDeath,    cb       => \&SignalledToDeath,
Line 1364  sub ChildProcess { Line 1480  sub ChildProcess {
     Event->signal(signal   => "USR1",      Event->signal(signal   => "USR1",
   cb       => \&ChildStatus,    cb       => \&ChildStatus,
   data     => "USR1");    data     => "USR1");
       Event->signal(signal   => "INT",
     cb       => \&ToggleDebug,
     data     => "INT");
   
     SetupTimer();      SetupTimer();
           
Line 1395  sub CreateChild { Line 1514  sub CreateChild {
     Log("CRITICAL", "Forking server for ".$host);      Log("CRITICAL", "Forking server for ".$host);
     $pid          = fork;      $pid          = fork;
     if($pid) { # Parent      if($pid) { # Parent
    $RemoteHost = "Parent";
  $ChildHash{$pid} = $RemoteHost;   $ChildHash{$pid} = $RemoteHost;
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
   
Line 1442  open (PIDSAVE, ">$execdir/logs/lonc.pid" Line 1562  open (PIDSAVE, ">$execdir/logs/lonc.pid"
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
   
   
   
 if (POSIX::setsid() < 0) {  if (POSIX::setsid() < 0) {
     print "Could not create new session\n";      print "Could not create new session\n";
     exit -1;      exit -1;
Line 1536  sub Restart { Line 1658  sub Restart {
 =head1 KillThemAll  =head1 KillThemAll
   
 Signal handler that kills all children by sending them a   Signal handler that kills all children by sending them a 
 SIGINT.  Responds to sigint and sigterm.  SIGHUP.  Responds to sigint and sigterm.
   
 =cut  =cut
   
Line 1548  sub KillThemAll { Line 1670  sub KillThemAll {
  Debug(2, "Killing lonc for $serving pid = $pid");   Debug(2, "Killing lonc for $serving pid = $pid");
  ShowStatus("Killing lonc for $serving pid = $pid");   ShowStatus("Killing lonc for $serving pid = $pid");
  Log("CRITICAL", "Killing lonc for $serving pid = $pid");   Log("CRITICAL", "Killing lonc for $serving pid = $pid");
  kill('INT', $pid);   kill 'QUIT' => $pid;
  delete($ChildeHash{$pid});   delete($ChildHash{$pid});
     }      }
     my $execdir = $perlvar{'lonDaemons'};      my $execdir = $perlvar{'lonDaemons'};
     unlink("$execdir/logs/lonc.pid");      unlink("$execdir/logs/lonc.pid");
     ShowStatus("Killing the master process");  
     Log("CRITICAL", "Killing the master process.");  
 }  }
   
 =pod  =pod
Line 1567  Terminate the system. Line 1688  Terminate the system.
   
 sub Terminate {  sub Terminate {
     KillThemAll;      KillThemAll;
     exit;      Log("CRITICAL","Master process exiting");
       exit 0;
   
 }  }
 =pod  =pod

Removed from v.1.14  
changed lines
  Added in v.1.22


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