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

Diff for /loncom/loncnew between versions 1.13 and 1.17

version 1.13, 2003/07/02 01:31:55 version 1.17, 2003/08/03 00:44:31
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.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
   #    Get all of the signals to work correctly.
   #
 #    Revision 1.13  2003/07/02 01:31:55  foxr  #    Revision 1.13  2003/07/02 01:31:55  foxr
 #    Added kill -HUP logic (restart).  #    Added kill -HUP logic (restart).
 #  #
Line 93  use LONCAPA::HashIterator; Line 112  use LONCAPA::HashIterator;
 #  #
 #   Disable all signals we might receive from outside for now.  #   Disable all signals we might receive from outside for now.
 #  #
 $SIG{QUIT}  = IGNORE;  #$SIG{QUIT}  = IGNORE;
 $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__}  = IGNORE;
   
   
 # Read the httpd configuration file to get perl variables  # Read the httpd configuration file to get perl variables
Line 117  my $MaxConnectionCount = 10; # Will get Line 136  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.
   
 #  #
Line 132  my $WorkQueue       = Queue->new(); # Qu Line 152  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 $RecentLogEntry  = "";
 my $ConnectionRetries=5; # Number of connection retries allowed.  my $ConnectionRetries=5; # Number of connection retries allowed.
 my $ConnectionRetriesLeft=5; # Number of connection retries remaining.  my $ConnectionRetriesLeft=5; # Number of connection retries remaining.
   
Line 208  sub Log { Line 229  sub Log {
     my $execdir = $perlvar{'lonDaemons'};      my $execdir = $perlvar{'lonDaemons'};
     my $fh      = IO::File->new(">>$execdir/logs/lonc.log");      my $fh      = IO::File->new(">>$execdir/logs/lonc.log");
     my $msg = sprintf($finalformat, $message);      my $msg = sprintf($finalformat, $message);
       $RecentLogEntry = $msg;
     print $fh $msg;      print $fh $msg;
           
           
Line 251  sub Debug { Line 273  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 281  sub ShowStatus { Line 303  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);
   }
   
   =pod
   
 =head2 Tick  =head2 Tick
   
 Invoked  each timer tick.  Invoked  each timer tick.
Line 305  sub Tick { Line 342  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 443  sub ClientWritable { Line 486  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 560  Parameters: Line 609  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();
Line 622  nonzero if we are allowed to create a ne Line 672  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 718  sub LondReadable { Line 769  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();
Line 1130  sub QueueTransaction { Line 1183  sub QueueTransaction {
  $WorkQueue->enqueue($requestData);   $WorkQueue->enqueue($requestData);
  if($ConnectionCount < $MaxConnectionCount) {   if($ConnectionCount < $MaxConnectionCount) {
     Debug(4,"Starting additional lond connection");      Debug(4,"Starting additional lond connection");
     MakeLondConnection();      if(MakeLondConnection() == 0) {
    EmptyQueue(); # Fail transactions, can't make connection.
       }
  }   }
     } else { # Can start the request:      } else { # Can start the request:
  Debug(8,"Can start...");   Debug(8,"Can start...");
Line 1288  sub SetupLoncListener { Line 1343  sub SetupLoncListener {
       fd     => $socket);        fd     => $socket);
 }  }
   
   =pod 
   
   =head2 ChildStatus
    
   Child USR1 signal handler to report the most recent status
   into the status file.
   
   =cut
   sub ChildStatus {
       my $event = shift;
       my $watcher = $event->w;
   
       Debug(2, "Reporting child status because : ".$watcher->data);
       my $docdir = $perlvar{'lonDocRoot'};
       my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
       print $fh $$."\t".$RemoteHost."\t".$Status."\t".
    $RecentLogEntry."\n";
   }
   
 =pod  =pod
   
 =head2 SignalledToDeath  =head2 SignalledToDeath
Line 1298  Called in response to a signal that caus Line 1372  Called in response to a signal that caus
   
   
 sub SignalledToDeath {  sub SignalledToDeath {
     Debug(2,"Signalled to death!");      my $event  = shift;
     my ($signal) = @_;      my $watcher= $event->w;
   
       Debug(2,"Signalled to death! via ".$watcher->data);
       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 1318  This sub implements a child process for Line 1410  This sub implements a child process for
 sub ChildProcess {  sub ChildProcess {
   
   
     # For now turn off signals.      #
           #  Signals must be handled by the Event framework...
     $SIG{QUIT}  = \&SignalledToDeath;  #
     $SIG{HUP}   = IGNORE;  
     $SIG{USR1}  = IGNORE;      Event->signal(signal   => "QUIT",
     $SIG{INT}   = DEFAULT;    cb       => \&SignalledToDeath,
     $SIG{CHLD}  = IGNORE;    data     => "QUIT");
     $SIG{__DIE__}  = \&SignalledToDeath;      Event->signal(signal   => "HUP",
     cb       => \&ChildStatus,
     data     => "HUP");
       Event->signal(signal   => "USR1",
     cb       => \&ChildStatus,
     data     => "USR1");
       Event->signal(signal   => "INT",
     cb       => \&ToggleDebug,
     data     => "INT");
   
     SetupTimer();      SetupTimer();
           
Line 1337  sub ChildProcess { Line 1437  sub ChildProcess {
   
 # Setup the initial server connection:  # Setup the initial server connection:
           
      # &MakeLondConnection(); // let first work requirest do it.       # &MakeLondConnection(); // let first work requirest do it.
   
   
     Debug(9,"Entering event loop");      Debug(9,"Entering event loop");
Line 1357  sub CreateChild { Line 1457  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 1404  open (PIDSAVE, ">$execdir/logs/lonc.pid" Line 1505  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 1430  ShowStatus("Parent keeping the flock"); Line 1533  ShowStatus("Parent keeping the flock");
 #   Set up parent signals:  #   Set up parent signals:
 #  #
   
 $SIG{INT}  = \&KillThemAll;  $SIG{INT}  = \&Terminate;
 $SIG{TERM} = \&KillThemAll;   $SIG{TERM} = \&Terminate; 
 $SIG{HUP}  = \&Restart;  $SIG{HUP}  = \&Restart;
   $SIG{USR1} = \&CheckKids; 
   
 while(1) {  while(1) {
     $deadchild = wait();      $deadchild = wait();
Line 1446  while(1) { Line 1550  while(1) {
     }      }
 }  }
   
   
   
   =pod
   
   =head1 CheckKids
   
     Since kids do not die as easily in this implementation
   as the previous one, there  is no need to restart the
   dead ones (all dead kids get restarted when they die!!)
   The only thing this function does is to pass USR1 to the
   kids so that they report their status.
   
   =cut
   
   sub CheckKids {
       Debug(2, "Checking status of children");
       my $docdir = $perlvar{'lonDocRoot'};
       my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
       my $now=time;
       my $local=localtime($now);
       print $fh "LONC status $local - parent $$ \n\n";
       foreach $pid (keys %ChildHash) {
    Debug(2, "Sending USR1 -> $pid");
    kill 'USR1' => $pid; # Tell Child to report status.
    sleep 1; # Wait so file doesn't intermix.
       }
   }
   
 =pod  =pod
   
 =head1 Restart  =head1 Restart
Line 1469  sub Restart { Line 1601  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 1481  sub KillThemAll { Line 1613  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($ChildHash{$pid});
     }      }
     Log("CRITICAL", "Killing the master process.");      my $execdir = $perlvar{'lonDaemons'};
     exit      unlink("$execdir/logs/lonc.pid");
   
 }  }
   
 =pod  =pod
   
   =head1 Terminate
    
   Terminate the system.
   
   =cut
   
   sub Terminate {
       KillThemAll;
       Log("CRITICAL","Master process exiting");
       exit 0;
   
   }
   =pod
   
 =head1 Theory  =head1 Theory
   
 The event class is used to build this as a single process with an  The event class is used to build this as a single process with an
Removed from v.1.13  
changed lines
  Added in v.1.17

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