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

Diff for /loncom/loncnew between versions 1.46 and 1.59

version 1.46, 2004/05/25 15:32:13 version 1.59, 2004/09/22 10:46:06
Line 82  my $ClientConnection = 0; # Uniquifier f Line 82  my $ClientConnection = 0; # Uniquifier f
   
 my $DebugLevel = 0;  my $DebugLevel = 0;
 my $NextDebugLevel= 2; # So Sigint can toggle this.  my $NextDebugLevel= 2; # So Sigint can toggle this.
 my $IdleTimeout= 3600; # Wait an hour before pruning connections.  my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
   
 my $LogTransactions = 0; # When True, all transactions/replies get logged.  my $LogTransactions = 0; # When True, all transactions/replies get logged.
   
Line 103  my $RecentLogEntry  = ""; Line 103  my $RecentLogEntry  = "";
 my $ConnectionRetries=2; # Number of connection retries allowed.  my $ConnectionRetries=2; # Number of connection retries allowed.
 my $ConnectionRetriesLeft=2; # Number of connection retries remaining.  my $ConnectionRetriesLeft=2; # Number of connection retries remaining.
 my $LondVersion     = "unknown"; # Version of lond we talk with.  my $LondVersion     = "unknown"; # Version of lond we talk with.
   my $KeyMode         = "";       # e.g. ssl, local, insecure from last connect.
   my $LondConnecting  = 0;       # True when a connection is being built.
   
   my $DieWhenIdle     = 0; # When true children die when trimmed -> 0.
   
 #  #
 #   The hash below gives the HTML format for log messages  #   The hash below gives the HTML format for log messages
Line 117  $LogFormats{"WARNING"}  = "<font color=' Line 121  $LogFormats{"WARNING"}  = "<font color='
 $LogFormats{"DEFAULT"}  = " %s ";  $LogFormats{"DEFAULT"}  = " %s ";
   
   
   #  UpdateStatus;
   #    Update the idle status display to show how many connections
   #    are left, retries and other stuff.
   #
   sub UpdateStatus {
       if ($ConnectionRetriesLeft > 0) {
    ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
      ." Retries remaining: ".$ConnectionRetriesLeft
      ." ($KeyMode)");
       } else {
    ShowStatus(GetServerHost()." >> DEAD <<");
       }
   }
   
   
 =pod  =pod
   
Line 156  host and the time will be formatted into Line 174  host and the time will be formatted into
 =cut  =cut
   
 sub Log {  sub Log {
     my $severity = shift;  
     my $message  = shift;      my ($severity, $message) = @_;
      
     if(!$LogFormats{$severity}) {      if(!$LogFormats{$severity}) {
  $severity = "DEFAULT";   $severity = "DEFAULT";
     }      }
Line 193  Returns the name of the host that a sock Line 211  Returns the name of the host that a sock
 =cut  =cut
   
 sub GetPeername {  sub GetPeername {
     my $connection = shift;  
     my $AdrFamily  = shift;  
       my ($connection, $AdrFamily) = @_;
   
     my $peer       = $connection->peername();      my $peer       = $connection->peername();
     my $peerport;      my $peerport;
     my $peerip;      my $peerip;
Line 217  Invoked to issue a debug message. Line 237  Invoked to issue a debug message.
 =cut  =cut
   
 sub Debug {  sub Debug {
     my $level   = shift;  
     my $message = shift;      my ($level, $message) = @_;
   
     if ($level <= $DebugLevel) {      if ($level <= $DebugLevel) {
  Log("INFO", "-Debug- $message host = $RemoteHost");   Log("INFO", "-Debug- $message host = $RemoteHost");
     }      }
 }  }
   
 sub SocketDump {  sub SocketDump {
     my $level = shift;  
     my $socket= shift;      my ($level, $socket) = @_;
   
     if($level <= $DebugLevel) {      if($level <= $DebugLevel) {
  $socket->Dump();   $socket->Dump(-1); # Ensure it will get dumped.
     }      }
 }  }
   
Line 260  sub ShowStatus { Line 282  sub ShowStatus {
 sub SocketTimeout {  sub SocketTimeout {
     my $Socket = shift;      my $Socket = shift;
     Log("WARNING", "A socket timeout was detected");      Log("WARNING", "A socket timeout was detected");
     Debug(0, " SocketTimeout called: ");      Debug(5, " SocketTimeout called: ");
     $Socket->Dump();      $Socket->Dump(0);
     if(exists($ActiveTransactions{$Socket})) {      if(exists($ActiveTransactions{$Socket})) {
  FailTransaction($ActiveTransactions{$Socket});   FailTransaction($ActiveTransactions{$Socket});
     }      }
Line 269  sub SocketTimeout { Line 291  sub SocketTimeout {
                                 # a connection failure:                                  # a connection failure:
     $ConnectionRetriesLeft--;      $ConnectionRetriesLeft--;
     if($ConnectionRetriesLeft <= 0) {      if($ConnectionRetriesLeft <= 0) {
  Log("CRITICAL", "Host marked dead: ".GetServerHost());   Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
    $LondConnecting = 0;
     }      }
   
 }  }
Line 285  Invoked  each timer tick. Line 308  Invoked  each timer tick.
   
   
 sub Tick {  sub Tick {
       my ($Event)       = @_;
       my $clock_watcher = $Event->w;
   
     my $client;      my $client;
     if($ConnectionRetriesLeft > 0) {      UpdateStatus();
  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 301  sub Tick { Line 323  sub Tick {
  if($IdleSeconds > $IdleTimeout) { # Prune a connection...   if($IdleSeconds > $IdleTimeout) { # Prune a connection...
     my $Socket = $IdleConnections->pop();      my $Socket = $IdleConnections->pop();
     KillSocket($Socket);      KillSocket($Socket);
       $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
       UpdateStatus();
       if(($ConnectionCount == 0) && $DieWhenIdle) {
    #
    #  Create a lock file since there will be a time window
    #  between our exit and the parent's picking up the listen
    #  during which no listens will be done on the
    #  lonnet client socket.
    #
    my $lock_file = GetLoncSocketPath().".lock";
    open(LOCK,">$lock_file");
    print LOCK "Contents not important";
    close(LOCK);
   
    exit(0);
       }
  }   }
     } else {      } else {
  $IdleSeconds = 0; # Reset idle count if not idle.   $IdleSeconds = 0; # Reset idle count if not idle.
Line 319  sub Tick { Line 357  sub 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.
     #      #
           #   Note this code is dead now...
       #
     my $Requests = $WorkQueue->Count();      my $Requests = $WorkQueue->Count();
     if (($ConnectionCount == 0)  && ($Requests > 0)) {       if (($ConnectionCount == 0)  && ($Requests > 0) && (!$LondConnecting)) { 
  if ($ConnectionRetriesLeft > 0) {   if ($ConnectionRetriesLeft > 0) {
     my $Connections = ($Requests <= $MaxConnectionCount) ?      Debug(5,"Work but no connections, Make a new one");
  $Requests : $MaxConnectionCount;      my $success;
     Debug(5,"Work but no connections, start ".$Connections." of them");      $success    = &MakeLondConnection;
     my $successCount = 0;      if($success == 0) { # All connections failed:
     for (my $i =0; $i < $Connections; $i++) {  
  $successCount += MakeLondConnection();  
     }  
     if($successCount == 0) { # All connections failed:  
  Debug(5,"Work in queue failed to make any connectiouns\n");   Debug(5,"Work in queue failed to make any connectiouns\n");
  EmptyQueue(); # Fail pending transactions with con_lost.   EmptyQueue(); # Fail pending transactions with con_lost.
  CloseAllLondConnections(); # Should all be closed but....   CloseAllLondConnections(); # Should all be closed but....
     }      }
  } else {   } else {
       $LondConnecting = 0;
     ShowStatus(GetServerHost()." >>> DEAD!!! <<<");      ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
     Debug(5,"Work in queue, but gave up on connections..flushing\n");      Debug(5,"Work in queue, but gave up on connections..flushing\n");
     EmptyQueue(); # Connections can't be established.      EmptyQueue(); # Connections can't be established.
Line 343  sub Tick { Line 379  sub Tick {
  }   }
                 
     }      }
       if ($ConnectionCount == 0) {
    $KeyMode = ""; 
    $clock_watcher->cancel();
       }
 }  }
   
 =pod  =pod
Line 383  long enough, it will be shut down and re Line 423  long enough, it will be shut down and re
   
 sub ServerToIdle {  sub ServerToIdle {
     my $Socket   = shift; # Get the socket.      my $Socket   = shift; # Get the socket.
       $KeyMode = $Socket->{AuthenticationMode};
     delete($ActiveTransactions{$Socket}); # Server has no transaction      delete($ActiveTransactions{$Socket}); # Server has no transaction
   
     &Debug(5, "Server to idle");      &Debug(5, "Server to idle");
Line 462  sub ClientWritable { Line 503  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!!   if($result == 0) {    # client hung up on us!!
     Log("INFO", "lonc pipe client hung up on us!");      # Log("INFO", "lonc pipe client hung up on us!");
     $Watcher->cancel;      $Watcher->cancel;
     $Socket->shutdown(2);      $Socket->shutdown(2);
     $Socket->close();      $Socket->close();
Line 515  The transaction that is being completed. Line 556  The transaction that is being completed.
   
 sub CompleteTransaction {  sub CompleteTransaction {
     &Debug(5,"Complete transaction");      &Debug(5,"Complete transaction");
     my $Socket = shift;  
     my $Transaction = shift;      my ($Socket, $Transaction) = @_;
   
     if (!$Transaction->isDeferred()) { # Normal transaction      if (!$Transaction->isDeferred()) { # Normal transaction
  my $data   = $Socket->GetReply(); # Data to send.   my $data   = $Socket->GetReply(); # Data to send.
Line 550  sub CompleteTransaction { Line 591  sub CompleteTransaction {
 =cut  =cut
   
 sub StartClientReply {  sub StartClientReply {
     my $Transaction   = shift;  
     my $data     = shift;  
   
       my ($Transaction, $data) = @_;
   
     my $Client   = $Transaction->getClient();      my $Client   = $Transaction->getClient();
   
Line 591  Parameters: Line 631  Parameters:
   
 sub FailTransaction {  sub FailTransaction {
     my $transaction = shift;      my $transaction = shift;
     Log("WARNING", "Failing transaction ".$transaction->getRequest());      
       #  If the socket is dead, that's already logged.
   
       if ($ConnectionRetriesLeft > 0) {
    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 778  sub LondReadable { Line 824  sub LondReadable {
     "Lond connection lost.");      "Lond connection lost.");
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
    } else {
       #  Socket is connecting and failed... need to mark
       #  no longer connecting.
      
       $LondConnecting = 0;
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket);   KillSocket($Socket);
Line 852  sub LondReadable { Line 903  sub LondReadable {
  .$RemoteHost." now ready for action");   .$RemoteHost." now ready for action");
  }   }
  ServerToIdle($Socket); # Next work unit or idle.   ServerToIdle($Socket); # Next work unit or idle.
   
    #
    $LondConnecting = 0; # Best spot I can think of for this.
    # 
   
     } elsif ($State eq "SendingRequest") {      } elsif ($State eq "SendingRequest") {
  #  We need to be writable for this and probably don't belong   #  We need to be writable for this and probably don't belong
Line 965  sub LondWritable { Line 1020  sub LondWritable {
     " has been disconnected");      " has been disconnected");
  if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
    } else {
       #  In the process of conneting, so need to turn that off.
       
       $LondConnecting = 0;
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket);   KillSocket($Socket);
Line 1125  sub MakeLondConnection { Line 1184  sub MakeLondConnection {
    data     => $Connection,     data     => $Connection,
    desc => 'Connection to lond server');     desc => 'Connection to lond server');
  $ActiveConnections{$Connection} = $event;   $ActiveConnections{$Connection} = $event;
    if ($ConnectionCount == 0) {
       &SetupTimer; # Need to handle timeouts with connections...
    }
  $ConnectionCount++;   $ConnectionCount++;
  Debug(4, "Connection count = ".$ConnectionCount);   Debug(4, "Connection count = ".$ConnectionCount);
  if($ConnectionCount == 1) { # First Connection:   if($ConnectionCount == 1) { # First Connection:
Line 1133  sub MakeLondConnection { Line 1194  sub MakeLondConnection {
  }   }
  Log("SUCESS", "Created connection ".$ConnectionCount   Log("SUCESS", "Created connection ".$ConnectionCount
     ." to host ".GetServerHost());      ." to host ".GetServerHost());
    $LondConnecting = 1; # Connection in progress.
  return 1; # Return success.   return 1; # Return success.
     }      }
           
Line 1164  The text of the request to send. Line 1226  The text of the request to send.
 =cut  =cut
   
 sub StartRequest {  sub StartRequest {
     my $Lond     = shift;  
     my $Request  = shift; # This is a LondTransaction.      my ($Lond, $Request) = @_;
           
     Debug(6, "StartRequest: ".$Request->getRequest());      Debug(6, "StartRequest: ".$Request->getRequest());
   
Line 1216  sub QueueTransaction { Line 1278  sub QueueTransaction {
     if(!defined $LondSocket) { # Need to queue request.      if(!defined $LondSocket) { # Need to queue request.
  Debug(5,"Must queue...");   Debug(5,"Must queue...");
  $WorkQueue->enqueue($requestData);   $WorkQueue->enqueue($requestData);
  if($ConnectionCount < $MaxConnectionCount) {   Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting");
    if(($ConnectionCount < $MaxConnectionCount)   && (! $LondConnecting)) {
   
     if($ConnectionRetriesLeft > 0) {      if($ConnectionRetriesLeft > 0) {
  Debug(5,"Starting additional lond connection");   Debug(5,"Starting additional lond connection");
  if(MakeLondConnection() == 0) {   if(&MakeLondConnection() == 0) {
     EmptyQueue(); # Fail transactions, can't make connection.      EmptyQueue(); # Fail transactions, can't make connection.
     CloseAllLondConnections; # Should all be closed but...      CloseAllLondConnections; # Should all be closed but...
  }   }
     } else {      } else {
  ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");   ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
    $LondConnecting = 0;
  EmptyQueue(); # It's worse than that ... he's dead Jim.   EmptyQueue(); # It's worse than that ... he's dead Jim.
  CloseAllLondConnections; # Should all be closed but..   CloseAllLondConnections; # Should all be closed but..
     }      }
Line 1330  sub NewClient { Line 1395  sub NewClient {
 Returns the name of the UNIX socket on which to listen for client  Returns the name of the UNIX socket on which to listen for client
 connections.  connections.
   
   =head2 Parameters:
   
       host (optional)  - Name of the host socket to return.. defaults to
                          the return from GetServerHost().
   
 =cut  =cut
   
 sub GetLoncSocketPath {  sub GetLoncSocketPath {
     return $UnixSocketDir."/".GetServerHost();  
       my $host = GetServerHost(); # Default host.
       if (@_) {
    ($host)  = @_; # Override if supplied.
       }
       return $UnixSocketDir."/".$host;
 }  }
   
 =pod  =pod
Line 1370  connection.  The event handler establish Line 1445  connection.  The event handler establish
 (creating a communcations channel), that int turn will establish  (creating a communcations channel), that int turn will establish
 another event handler to subess requests.  another event handler to subess requests.
   
   =head2  Parameters:
   
      host (optional)   Name of the host to set up a unix socket to.
   
 =cut  =cut
   
 sub SetupLoncListener {  sub SetupLoncListener {
   
       my $host       = GetServerHost(); # Default host.
       if (@_) {
    ($host)    = @_ # Override host with parameter.
       }
   
     my $socket;      my $socket;
     my $SocketName = GetLoncSocketPath();      my $SocketName = GetLoncSocketPath($host);
     unlink($SocketName);      unlink($SocketName);
     unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,      unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
     Listen => 10,       Listen => 250, 
     Type   => SOCK_STREAM)) {      Type   => SOCK_STREAM)) {
  die "Failed to create a lonc listner socket";   die "Failed to create a lonc listner socket";
     }      }
     Event->io(cb     => \&NewClient,      return $socket;
       poll   => 'r',  
       desc   => 'Lonc listener Unix Socket',  
       fd     => $socket);  
 }  }
   
 #  #
Line 1438  sub ChildStatus { Line 1519  sub ChildStatus {
     my $state  = $Socket->GetState();      my $state  = $Socket->GetState();
     print $fh "Connection $i State: $state\n";      print $fh "Connection $i State: $state\n";
     print STDERR "---------------------- Connection $i \n";      print STDERR "---------------------- Connection $i \n";
     $Socket->Dump();      $Socket->Dump(-1); # Ensure it gets dumped..
     $i++;      $i++;
  }   }
     }      }
Line 1512  sub ChildProcess { Line 1593  sub ChildProcess {
   cb       => \&ToggleDebug,    cb       => \&ToggleDebug,
   data     => "INT");    data     => "INT");
   
     SetupTimer();  
           
     SetupLoncListener();      my $socket =  SetupLoncListener();
       Event->io(cb   => \&NewClient,
         poll => 'r',
         desc => 'Lonc Listener Unix Socket',
         fd   => $socket);
           
     $Event::Debuglevel = $DebugLevel;      $Event::Debuglevel = $DebugLevel;
           
Line 1535  sub ChildProcess { Line 1619  sub ChildProcess {
 #  Create a new child for host passed in:  #  Create a new child for host passed in:
   
 sub CreateChild {  sub CreateChild {
       my $host = shift;
   
     my $sigset = POSIX::SigSet->new(SIGINT);      my $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset);      sigprocmask(SIG_BLOCK, $sigset);
     my $host = shift;  
     $RemoteHost = $host;      $RemoteHost = $host;
     Log("CRITICAL", "Forking server for ".$host);      Log("CRITICAL", "Forking server for ".$host);
     my $pid          = fork;      my $pid          = fork;
Line 1808  sub KillThemAll { Line 1893  sub KillThemAll {
     local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.      local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
     foreach my $pid (keys %ChildHash) {      foreach my $pid (keys %ChildHash) {
  my $serving = $ChildHash{$pid};   my $serving = $ChildHash{$pid};
  Debug(2, "Killing lonc for $serving pid = $pid");   ShowStatus("Nicely Killing lonc for $serving pid = $pid");
  ShowStatus("Killing lonc for $serving pid = $pid");   Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
  Log("CRITICAL", "Killing lonc for $serving pid = $pid");  
  kill 'QUIT' => $pid;   kill 'QUIT' => $pid;
  delete($ChildHash{$pid});  
     }      }
     my $execdir = $perlvar{'lonDaemons'};  
     unlink("$execdir/logs/lonc.pid");  
   
 }  }
   
   
   #
   #  Kill all children via KILL.  Just in case the
   #  first shot didn't get them.
   
   sub really_kill_them_all_dammit
   {
       Debug(2, "Kill them all Dammit");
       local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them.
       foreach my $pid (keys %ChildHash) {
    my $serving = $ChildHash{$pid};
    &ShowStatus("Nastily killing lonc for $serving pid = $pid");
    Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
    kill 'KILL' => $pid;
    delete($ChildHash{$pid});
    my $execdir = $perlvar{'lonDaemons'};
    unlink("$execdir/logs/lonc.pid");
       }
   }
 =pod  =pod
   
 =head1 Terminate  =head1 Terminate
Line 1828  Terminate the system. Line 1929  Terminate the system.
 =cut  =cut
   
 sub Terminate {  sub Terminate {
     KillThemAll;      &Log("CRITICAL", "Asked to kill children.. first be nice...");
       &KillThemAll;
       #
       #  By now they really should all be dead.. but just in case 
       #  send them all SIGKILL's after a bit of waiting:
   
       sleep(4);
       &Log("CRITICAL", "Now kill children nasty");
       &really_kill_them_all_dammit;
     Log("CRITICAL","Master process exiting");      Log("CRITICAL","Master process exiting");
     exit 0;      exit 0;
   
Removed from v.1.46  
changed lines
  Added in v.1.59

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