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

Diff for /loncom/loncnew between versions 1.42 and 1.49

version 1.42, 2004/02/17 09:43:21 version 1.49, 2004/06/17 22:37:06
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.
   
 #  #
 #   The hash below gives the HTML format for log messages  #   The hash below gives the HTML format for log messages
Line 110  my $LondVersion     = "unknown"; # Versi Line 111  my $LondVersion     = "unknown"; # Versi
 #      #    
 my %LogFormats;  my %LogFormats;
   
 $LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";  $LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
 $LogFormats{"SUCCESS"}  = "<font color=green>SUCCESS: %s</font>";  $LogFormats{"SUCCESS"}  = "<font color='green'>SUCCESS: %s</font>";
 $LogFormats{"INFO"}     = "<font color=yellow>INFO: %s</font>";  $LogFormats{"INFO"}     = "<font color='yellow'>INFO: %s</font>";
 $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";  $LogFormats{"WARNING"}  = "<font color='blue'>WARNING: %s</font>";
 $LogFormats{"DEFAULT"}  = " %s ";  $LogFormats{"DEFAULT"}  = " %s ";
   
   
Line 156  host and the time will be formatted into Line 157  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 194  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 220  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 261  sub SocketTimeout { Line 266  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(0, " SocketTimeout called: ");
     $Socket->Dump();      $Socket->Dump(0);
     if(exists($ActiveTransactions{$Socket})) {      if(exists($ActiveTransactions{$Socket})) {
       FailTransaction($ActiveTransactions{$Socket});   FailTransaction($ActiveTransactions{$Socket});
     }      }
     KillSocket($Socket); # A transaction timeout also counts as      KillSocket($Socket); # A transaction timeout also counts as
                                 # a connection failure:                                  # a connection failure:
Line 288  sub Tick { Line 293  sub Tick {
     my $client;      my $client;
     if($ConnectionRetriesLeft > 0) {      if($ConnectionRetriesLeft > 0) {
  ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount   ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
    ." Retries remaining: ".$ConnectionRetriesLeft);     ." Retries remaining: ".$ConnectionRetriesLeft
      ." ($KeyMode)");
     } else {      } else {
  ShowStatus(GetServerHost()." >> DEAD <<");   ShowStatus(GetServerHost()." >> DEAD <<");
     }      }
Line 343  sub Tick { Line 349  sub Tick {
  }   }
                 
     }      }
       if ($ConnectionCount == 0) {
    $KeyMode = ""; 
       }
 }  }
   
 =pod  =pod
Line 383  long enough, it will be shut down and re Line 392  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 515  The transaction that is being completed. Line 525  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 560  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 959  sub LondWritable { Line 968  sub LondWritable {
     # so that the writing states are actually NO-OPs.      # so that the writing states are actually NO-OPs.
   
     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.   Log("WARNING", "Connection to ".$RemoteHost.
   " has been disconnected");      " has been disconnected");
       if(exists($ActiveTransactions{$Socket})) {   if(exists($ActiveTransactions{$Socket})) {
  FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
       }   }
       $Watcher->cancel();   $Watcher->cancel();
       KillSocket($Socket);   KillSocket($Socket);
       return;   return;
     }      }
   
   
Line 1164  The text of the request to send. Line 1173  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 1269  sub ClientRequest { Line 1278  sub ClientRequest {
     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 eq "close_connection_exit\n") {   if($data eq "close_connection_exit\n") {
     Log("CRITICAL",      Log("CRITICAL",
  "Request Close Connection ... exiting");   "Request Close Connection ... exiting");
Line 1416  into the status file. Line 1425  into the status file.
 We also use this to reset the retries count in order to allow the  We also use this to reset the retries count in order to allow the
 client to retry connections with a previously dead server.  client to retry connections with a previously dead server.
 =cut  =cut
   
 sub ChildStatus {  sub ChildStatus {
     my $event = shift;      my $event = shift;
     my $watcher = $event->w;      my $watcher = $event->w;
Line 1428  sub ChildStatus { Line 1438  sub ChildStatus {
     #      #
     #  Write out information about each of the connections:      #  Write out information about each of the connections:
     #      #
     print $fh "Active connection statuses: \n";      if ($DebugLevel > 2) {
     my $i = 1;   print $fh "Active connection statuses: \n";
     print STDERR  "================================= Socket Status Dump:\n";   my $i = 1;
     foreach my $item (keys %ActiveConnections) {   print STDERR  "================================= Socket Status Dump:\n";
  my $Socket = $ActiveConnections{$item}->data;   foreach my $item (keys %ActiveConnections) {
  my $state  = $Socket->GetState();      my $Socket = $ActiveConnections{$item}->data;
  print $fh "Connection $i State: $state\n";      my $state  = $Socket->GetState();
  print STDERR "---------------------- Connection $i \n";      print $fh "Connection $i State: $state\n";
  $Socket->Dump();      print STDERR "---------------------- Connection $i \n";
  $i++;      $Socket->Dump(-1); # Ensure it gets dumped..
       $i++;
    }
     }      }
     $ConnectionRetriesLeft = $ConnectionRetries;      $ConnectionRetriesLeft = $ConnectionRetries;
 }  }
Removed from v.1.42  
changed lines
  Added in v.1.49

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