--- loncom/loncnew	2004/01/13 09:57:18	1.39
+++ loncom/loncnew	2004/05/25 15:32:13	1.46
@@ -2,7 +2,7 @@
 # The LearningOnline Network with CAPA
 # lonc maintains the connections to remote computers
 #
-# $Id: loncnew,v 1.39 2004/01/13 09:57:18 foxr Exp $
+# $Id: loncnew,v 1.46 2004/05/25 15:32:13 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -63,11 +63,6 @@ use LONCAPA::Configuration;
 use LONCAPA::HashIterator;
 
 
-#
-#   Disable all signals we might receive from outside for now.
-#
-
-
 # Read the httpd configuration file to get perl variables
 # normally set in apache modules:
 
@@ -107,6 +102,7 @@ my $Status          = "";	# Current stat
 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.
 
 #
 #   The hash below gives the HTML format for log messages
@@ -114,10 +110,10 @@ my $ConnectionRetriesLeft=2;	# Number of
 #    
 my %LogFormats;
 
-$LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
-$LogFormats{"SUCCESS"}  = "<font color=green>SUCCESS: %s</font>";
-$LogFormats{"INFO"}     = "<font color=yellow>INFO: %s</font>";
-$LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";
+$LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
+$LogFormats{"SUCCESS"}  = "<font color='green'>SUCCESS: %s</font>";
+$LogFormats{"INFO"}     = "<font color='yellow'>INFO: %s</font>";
+$LogFormats{"WARNING"}  = "<font color='blue'>WARNING: %s</font>";
 $LogFormats{"DEFAULT"}  = " %s ";
 
 
@@ -266,9 +262,16 @@ sub SocketTimeout {
     Log("WARNING", "A socket timeout was detected");
     Debug(0, " SocketTimeout called: ");
     $Socket->Dump();
+    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 ------------------------
 
@@ -330,11 +333,13 @@ 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...
 	}
        
     }
@@ -525,7 +530,9 @@ sub CompleteTransaction {
 	unlink $Transaction->getFile();
     }
 }
+
 =pod
+
 =head1 StartClientReply
 
    Initiates a reply to a client where the reply data is a parameter.
@@ -541,6 +548,7 @@ sub CompleteTransaction {
     The data to send to apached client.
 
 =cut
+
 sub StartClientReply {
     my $Transaction   = shift;
     my $data     = shift;
@@ -558,7 +566,9 @@ sub StartClientReply {
 	      cb       => \&ClientWritable,
 	      data     => $data);
 }
+
 =pod
+
 =head2 FailTransaction
 
   Finishes a transaction with failure because the associated lond socket
@@ -568,8 +578,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:
 
@@ -577,6 +586,7 @@ Parameters:
  
    The LondTransaction we are failing.
  
+
 =cut
 
 sub FailTransaction {
@@ -588,9 +598,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());
-    }
 
 }
 
@@ -618,7 +625,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
@@ -670,6 +680,7 @@ sub KillSocket {
     #
     if($ConnectionCount == 0) {
 	EmptyQueue();
+	CloseAllLondConnections; # Should all already be closed but...
     }
 }
 
@@ -695,6 +706,17 @@ The connection must echo the challenge b
 The challenge has been replied to.  The we are receiveing the 
 'ok' from the partner.
 
+=head3  State=ReadingVersionString
+
+We have requested the lond version and are reading the
+version back.  Upon completion, we'll store the version away
+for future use(?).
+
+=head3 State=HostSet
+
+We have selected the domain name of our peer (multhomed hosts)
+and are getting the reply (presumably ok) back.
+
 =head3 State=RequestingKey
 
 The ok has been received and we need to send the request for
@@ -749,7 +771,7 @@ sub LondReadable {
     &Debug(2, "Socket->Readable returned: $status");
 
     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.
 
 	Log("WARNING",
@@ -767,19 +789,34 @@ sub LondReadable {
     $State = $Socket->GetState(); # Update in case of transition.
     &Debug(6, "After read, state is ".$State);
 
-   if($State eq "Initialized") {
+    if($State eq "Initialized") {
 
 
     } elsif ($State eq "ChallengeReceived") {
 	#  The challenge must be echoed back;  The state machine
 	# in the connection takes care of setting that up.  Just
 	# need to transition to writable:
-
+	
 	$Watcher->cb(\&LondWritable);
 	$Watcher->poll("w");
 
     } elsif ($State eq "ChallengeReplied") {
 
+    } elsif ($State eq "RequestingVersion") {
+	# Need to ask for the version... that is writiability:
+
+	$Watcher->cb(\&LondWritable);
+	$Watcher->poll("w");
+
+    } elsif ($State eq "ReadingVersionString") {
+	# Read the rest of the version string... 
+    } elsif ($State eq "SetHost") {
+	# Need to request the actual domain get set...
+
+	$Watcher->cb(\&LondWritable);
+	$Watcher->poll("w");
+    } elsif ($State eq "HostSet") {
+	# Reading the 'ok' from the peer.
 
     } elsif ($State eq "RequestingKey") {
 	#  The ok was received.  Now we need to request the key
@@ -791,6 +828,14 @@ sub LondReadable {
     } elsif ($State eq "ReceivingKey") {
 
     } elsif ($State eq "Idle") {
+   
+	# This is as good a spot as any to get the peer version
+	# string:
+   
+	if($LondVersion eq "unknown") {
+	    $LondVersion = $Socket->PeerVersion();
+	    Log("INFO", "Connected to lond version: $LondVersion");
+	}
 	# If necessary, complete a transaction and then go into the
 	# idle queue.
 	#  Note that a trasition to idle indicates a live lond
@@ -820,7 +865,7 @@ sub LondReadable {
 
 
     } else {
-	 # Invalid state.
+	# Invalid state.
 	Debug(4, "Invalid state in LondReadable");
     }
 }
@@ -902,21 +947,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;
 	}
-	#  "init" is being sent...
+	$Watcher->cancel();
+	KillSocket($Socket);
+	return;
+    }
 
-	
+
+
+    if      ($State eq "Connected")         {
+
+	#  "init" is being sent...
+ 
     } elsif ($State eq "Initialized")       {
 
 	# Now that init was sent, we switch 
@@ -924,40 +984,43 @@ sub LondWritable {
 
 	$Watcher->cb(\&LondReadable);
 	$Watcher->poll("r");
-
+	
     } elsif ($State eq "ChallengeReceived") {
 	# We received the challenge, now we 
 	# 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.
 
 	$Watcher->cb(\&LondReadable);
 	$Watcher->poll("r");
+    } elsif ($State eq "RequestingVersion") {
+	# Sending the peer a version request...
+
+    } elsif ($State eq "ReadingVersionString") {
+	# Transition to read since we have sent the
+	# version command and now just need to read the
+	# version string from the peer:
+      
+	$Watcher->cb(\&LondReadable);
+	$Watcher->poll("r");
+      
+    } elsif ($State eq "SetHost") {
+	#  Setting the remote domain...
+
+    } elsif ($State eq "HostSet") {
+	# Back to readable to get the ok.
+      
+	$Watcher->cb(\&LondReadable);
+	$Watcher->poll("r");
+      
 
     } 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:
@@ -966,20 +1029,10 @@ sub LondWritable {
 	$Watcher->poll("r");
 
     } elsif ($State eq "SendingRequest")    {
+ 
 	# 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
@@ -1168,10 +1221,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:
@@ -1214,7 +1269,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");
@@ -1361,6 +1416,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;
@@ -1373,16 +1429,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();
+	    $i++;	
+	}
     }
     $ConnectionRetriesLeft = $ConnectionRetries;
 }