--- loncom/loncnew 2004/02/09 13:39:28 1.41 +++ loncom/loncnew 2004/07/02 09:28:14 1.50 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.41 2004/02/09 13:39:28 albertel Exp $ +# $Id: loncnew,v 1.50 2004/07/02 09:28:14 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -82,7 +82,7 @@ my $ClientConnection = 0; # Uniquifier f my $DebugLevel = 0; 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. @@ -103,6 +103,7 @@ my $RecentLogEntry = ""; my $ConnectionRetries=2; # Number of connection retries allowed. my $ConnectionRetriesLeft=2; # Number of connection retries remaining. 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 @@ -110,10 +111,10 @@ my $LondVersion = "unknown"; # Versi # my %LogFormats; -$LogFormats{"CRITICAL"} = "CRITICAL: %s"; -$LogFormats{"SUCCESS"} = "SUCCESS: %s"; -$LogFormats{"INFO"} = "INFO: %s"; -$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; $LogFormats{"DEFAULT"} = " %s "; @@ -156,9 +157,9 @@ host and the time will be formatted into =cut sub Log { - my $severity = shift; - my $message = shift; - + + my ($severity, $message) = @_; + if(!$LogFormats{$severity}) { $severity = "DEFAULT"; } @@ -193,8 +194,10 @@ Returns the name of the host that a sock =cut sub GetPeername { - my $connection = shift; - my $AdrFamily = shift; + + + my ($connection, $AdrFamily) = @_; + my $peer = $connection->peername(); my $peerport; my $peerip; @@ -217,18 +220,20 @@ Invoked to issue a debug message. =cut sub Debug { - my $level = shift; - my $message = shift; + + my ($level, $message) = @_; + if ($level <= $DebugLevel) { Log("INFO", "-Debug- $message host = $RemoteHost"); } } sub SocketDump { - my $level = shift; - my $socket= shift; + + my ($level, $socket) = @_; + if($level <= $DebugLevel) { - $socket->Dump(); + $socket->Dump(-1); # Ensure it will get dumped. } } @@ -261,10 +266,17 @@ sub SocketTimeout { my $Socket = shift; Log("WARNING", "A socket timeout was detected"); Debug(0, " SocketTimeout called: "); - $Socket->Dump(); + $Socket->Dump(0); + if(exists($ActiveTransactions{$Socket})) { + FailTransaction($ActiveTransactions{$Socket}); + } KillSocket($Socket); # A transaction timeout also counts as # a connection failure: $ConnectionRetriesLeft--; + if($ConnectionRetriesLeft <= 0) { + Log("CRITICAL", "Host marked dead: ".GetServerHost()); + } + } #----------------------------- Timer management ------------------------ @@ -281,7 +293,8 @@ sub Tick { my $client; if($ConnectionRetriesLeft > 0) { ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount - ." Retries remaining: ".$ConnectionRetriesLeft); + ." Retries remaining: ".$ConnectionRetriesLeft + ." ($KeyMode)"); } else { ShowStatus(GetServerHost()." >> DEAD <<"); } @@ -326,14 +339,19 @@ sub Tick { if($successCount == 0) { # All connections failed: Debug(5,"Work in queue failed to make any connectiouns\n"); EmptyQueue(); # Fail pending transactions with con_lost. + CloseAllLondConnections(); # Should all be closed but.... } } else { ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); Debug(5,"Work in queue, but gave up on connections..flushing\n"); EmptyQueue(); # Connections can't be established. + CloseAllLondConnections(); # Should all already be closed but... } } + if ($ConnectionCount == 0) { + $KeyMode = ""; + } } =pod @@ -374,6 +392,7 @@ long enough, it will be shut down and re sub ServerToIdle { my $Socket = shift; # Get the socket. + $KeyMode = $Socket->{AuthenticationMode}; delete($ActiveTransactions{$Socket}); # Server has no transaction &Debug(5, "Server to idle"); @@ -506,8 +525,8 @@ The transaction that is being completed. sub CompleteTransaction { &Debug(5,"Complete transaction"); - my $Socket = shift; - my $Transaction = shift; + + my ($Socket, $Transaction) = @_; if (!$Transaction->isDeferred()) { # Normal transaction my $data = $Socket->GetReply(); # Data to send. @@ -521,7 +540,9 @@ sub CompleteTransaction { unlink $Transaction->getFile(); } } + =pod + =head1 StartClientReply Initiates a reply to a client where the reply data is a parameter. @@ -537,10 +558,10 @@ sub CompleteTransaction { The data to send to apached client. =cut + sub StartClientReply { - my $Transaction = shift; - my $data = shift; + my ($Transaction, $data) = @_; my $Client = $Transaction->getClient(); @@ -554,7 +575,9 @@ sub StartClientReply { cb => \&ClientWritable, data => $data); } + =pod + =head2 FailTransaction Finishes a transaction with failure because the associated lond socket @@ -564,8 +587,7 @@ sub StartClientReply { - The transaction is 'live' in which case we initiate the sending of "con_lost" to the client. -Deleting the transaction means killing it from the -%ActiveTransactions hash. +Deleting the transaction means killing it from the %ActiveTransactions hash. Parameters: @@ -573,6 +595,7 @@ Parameters: The LondTransaction we are failing. + =cut sub FailTransaction { @@ -584,9 +607,6 @@ sub FailTransaction { Debug(1," Replying con_lost to ".$transaction->getRequest()); StartClientReply($transaction, "con_lost\n"); } - if($ConnectionRetriesLeft <= 0) { - Log("CRITICAL", "Host marked dead: ".GetServerHost()); - } } @@ -614,7 +634,10 @@ Close all connections open on lond prior =cut sub CloseAllLondConnections { foreach my $Socket (keys %ActiveConnections) { - KillSocket($Socket); + if(exists($ActiveTransactions{$Socket})) { + FailTransaction($ActiveTransactions{$Socket}); + } + KillSocket($Socket); } } =cut @@ -666,6 +689,7 @@ sub KillSocket { # if($ConnectionCount == 0) { EmptyQueue(); + CloseAllLondConnections; # Should all already be closed but... } } @@ -932,21 +956,36 @@ sub LondWritable { SocketDump(6,$Socket); - if ($State eq "Connected") { - - if ($Socket->Writable() != 0) { - # The write resulted in an error. - # We'll treat this as if the socket got disconnected: - Log("WARNING", "Connection to ".$RemoteHost. - " has been disconnected"); + # If the socket is writable, we must always write. + # Only by writing will we undergo state transitions. + # Old logic wrote in state specific code below, however + # That forces us at least through another invocation of + # this function after writability is possible again. + # This logic also factors out common code for handling + # write failures... in all cases, write failures + # Kill the socket. + # This logic makes the branches of the >big< if below + # so that the writing states are actually NO-OPs. + + if ($Socket->Writable() != 0) { + # The write resulted in an error. + # We'll treat this as if the socket got disconnected: + Log("WARNING", "Connection to ".$RemoteHost. + " has been disconnected"); + if(exists($ActiveTransactions{$Socket})) { FailTransaction($ActiveTransactions{$Socket}); - $Watcher->cancel(); - KillSocket($Socket); - return; } - + $Watcher->cancel(); + KillSocket($Socket); + return; + } + + + + if ($State eq "Connected") { + # "init" is being sent... - + } elsif ($State eq "Initialized") { # Now that init was sent, we switch @@ -960,13 +999,6 @@ sub LondWritable { # are echoing it back. This is a no-op, # we're waiting for the state to change - if($Socket->Writable() != 0) { - - $Watcher->cancel(); - KillSocket($Socket); - return; - } - } elsif ($State eq "ChallengeReplied") { # The echo was sent back, so we switch # to watching readability. @@ -975,12 +1007,7 @@ sub LondWritable { $Watcher->poll("r"); } elsif ($State eq "RequestingVersion") { # Sending the peer a version request... - - if($Socket->Writable() != 0) { - $Watcher->cancel(); - KillSocket($Socket); - return; - } + } elsif ($State eq "ReadingVersionString") { # Transition to read since we have sent the # version command and now just need to read the @@ -991,12 +1018,7 @@ sub LondWritable { } elsif ($State eq "SetHost") { # Setting the remote domain... - - if($Socket->Writable() != 0) { - $Watcher->cancel(); - KillSocket($Socket); - return; - } + } elsif ($State eq "HostSet") { # Back to readable to get the ok. @@ -1007,17 +1029,7 @@ sub LondWritable { } elsif ($State eq "RequestingKey") { # At this time we're requesting the key. # again, this is essentially a no-op. - # we'll write the next chunk until the - # state changes. - - if($Socket->Writable() != 0) { - # Write resulted in an error. - $Watcher->cancel(); - KillSocket($Socket); - return; - - } } elsif ($State eq "ReceivingKey") { # Now we need to wait for the key # to come back from the peer: @@ -1030,17 +1042,6 @@ sub LondWritable { # At this time we are sending a request to the # peer... write the next chunk: - if($Socket->Writable() != 0) { - - if(exists($ActiveTransactions{$Socket})) { - Debug(3, "Lond connection lost, failing transactions"); - FailTransaction($ActiveTransactions{$Socket}); - } - $Watcher->cancel(); - KillSocket($Socket); - return; - - } } elsif ($State eq "ReceivingReply") { # The send has completed. Wait for the @@ -1172,8 +1173,8 @@ The text of the request to send. =cut sub StartRequest { - my $Lond = shift; - my $Request = shift; # This is a LondTransaction. + + my ($Lond, $Request) = @_; Debug(6, "StartRequest: ".$Request->getRequest()); @@ -1229,10 +1230,12 @@ sub QueueTransaction { Debug(5,"Starting additional lond connection"); if(MakeLondConnection() == 0) { EmptyQueue(); # Fail transactions, can't make connection. + CloseAllLondConnections; # Should all be closed but... } } else { ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); EmptyQueue(); # It's worse than that ... he's dead Jim. + CloseAllLondConnections; # Should all be closed but.. } } } else { # Can start the request: @@ -1275,7 +1278,7 @@ sub ClientRequest { Debug(8,"Data: ".$data." this read: ".$thisread); $data = $data.$thisread; # Append new data. $watcher->data($data); - if($data =~ /(.*\n)/) { # Request entirely read. + if($data =~ /\n$/) { # Request entirely read. if($data eq "close_connection_exit\n") { Log("CRITICAL", "Request Close Connection ... exiting"); @@ -1422,6 +1425,7 @@ 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 + sub ChildStatus { my $event = shift; my $watcher = $event->w; @@ -1434,16 +1438,18 @@ sub ChildStatus { # # Write out information about each of the connections: # - print $fh "Active connection statuses: \n"; - my $i = 1; - print STDERR "================================= Socket Status Dump:\n"; - foreach my $item (keys %ActiveConnections) { - my $Socket = $ActiveConnections{$item}->data; - my $state = $Socket->GetState(); - print $fh "Connection $i State: $state\n"; - print STDERR "---------------------- Connection $i \n"; - $Socket->Dump(); - $i++; + if ($DebugLevel > 2) { + print $fh "Active connection statuses: \n"; + my $i = 1; + print STDERR "================================= Socket Status Dump:\n"; + foreach my $item (keys %ActiveConnections) { + my $Socket = $ActiveConnections{$item}->data; + my $state = $Socket->GetState(); + print $fh "Connection $i State: $state\n"; + print STDERR "---------------------- Connection $i \n"; + $Socket->Dump(-1); # Ensure it gets dumped.. + $i++; + } } $ConnectionRetriesLeft = $ConnectionRetries; }