loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.4 and 1.9

version 1.4, 2003/04/24 10:56:55	version 1.9, 2003/06/13 02:38:43
Line 34	Line 34
# - Add timer dispatch. (done)	# - Add timer dispatch. (done)
# - Add ability to accept lonc UNIX domain sockets. (done)	# - Add ability to accept lonc UNIX domain sockets. (done)
# - Add ability to create/negotiate lond connections (done).	# - Add ability to create/negotiate lond connections (done).
# - Add general logic for dispatching requests and timeouts.	# - Add general logic for dispatching requests and timeouts. (done).
# - Add support for the lonc/lond requests.	# - Add support for the lonc/lond requests. (done).
# - Add logging/status monitoring.	# - Add logging/status monitoring.
# - Add Signal handling - HUP restarts. USR1 status report.	# - Add Signal handling - HUP restarts. USR1 status report.
# - Add Configuration file I/O	# - Add Configuration file I/O (done).
# - Add Pending request processing on startup.
# - Add management/status request interface.	# - Add management/status request interface.
	# - Add deferred request capability. (done)
	# - Detect transmission timeouts.
	#

	# Change log:
	# $Log$
	# Revision 1.9 2003/06/13 02:38:43 foxr
	# Add logging in 'expected format'
	#
	# Revision 1.8 2003/06/11 02:04:35 foxr
	# Support delayed transactions... this is done uniformly by encapsulating
	# transactions in an object ... a LondTransaction that is implemented by
	# LondTransaction.pm
	#
	# Revision 1.7 2003/06/03 01:59:39 foxr
	# complete coding to support deferred transactions.
	#
	#

use lib "/home/httpd/lib/perl/";	use lib "/home/httpd/lib/perl/";
use lib "/home/foxr/newloncapa/types";	use lib "/home/foxr/newloncapa/types";
Line 49 use POSIX qw(:signal_h);	Line 66 use POSIX qw(:signal_h);
use IO::Socket;	use IO::Socket;
use IO::Socket::INET;	use IO::Socket::INET;
use IO::Socket::UNIX;	use IO::Socket::UNIX;
	use IO::File;
	use IO::Handle;
use Socket;	use Socket;
use Crypt::IDEA;	use Crypt::IDEA;
use LONCAPA::Queue;	use LONCAPA::Queue;
use LONCAPA::Stack;	use LONCAPA::Stack;
use LONCAPA::LondConnection;	use LONCAPA::LondConnection;
	use LONCAPA::LondTransaction;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
use LONCAPA::HashIterator;	use LONCAPA::HashIterator;

print "Loncnew starting\n";

#	#
# Disable all signals we might receive from outside for now.	# Disable all signals we might receive from outside for now.
Line 82 my %perlvar = %{$perlvarref};	Line 101 my %perlvar = %{$perlvarref};
my %ChildHash; # by pid -> host.	my %ChildHash; # by pid -> host.


my $MaxConnectionCount = 5; # Will get from config later.	my $MaxConnectionCount = 10; # Will get from config later.
my $ClientConnection = 0; # Uniquifier for client events.	my $ClientConnection = 0; # Uniquifier for client events.

my $DebugLevel = 5;	my $DebugLevel = 0;
my $IdleTimeout= 3600; # Wait an hour before pruning connections.	my $IdleTimeout= 3600; # Wait an hour before pruning connections.

#	#
Line 95 my $RemoteHost; # Name of host child i	Line 114 my $RemoteHost; # Name of host child i
my $UnixSocketDir= "/home/httpd/sockets";	my $UnixSocketDir= "/home/httpd/sockets";
my $IdleConnections = Stack->new(); # Set of idle connections	my $IdleConnections = Stack->new(); # Set of idle connections
my %ActiveConnections; # Connections to the remote lond.	my %ActiveConnections; # Connections to the remote lond.
my %ActiveTransactions; # Transactions in flight.	my %ActiveTransactions; # LondTransactions in flight.
my %ActiveClients; # Serial numbers of active clients by socket.	my %ActiveClients; # Serial numbers of active clients by socket.
my $WorkQueue = Queue->new(); # Queue of pending transactions.	my $WorkQueue = Queue->new(); # Queue of pending transactions.
my $ClientQueue = Queue->new(); # Queue of clients causing xactinos.
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.


#	#
	# The hash below gives the HTML format for log messages
	# given a severity.
	#
	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{"DEFAULT"} = " %s ";

	my $lastlog = ''; # Used for status reporting.

	=pod

	=head2 Log

	Logs a message to the log file.
	Parameters:

	=item severity

	One of CRITICAL, WARNING, INFO, SUCCESS used to select the
	format string used to format the message. if the severity is
	not a defined severity the Default format string is used.

	=item message

	The base message. In addtion to the format string, the message
	will be appended to a string containing the name of our remote
	host and the time will be formatted into the message.

	=cut

	sub Log {
	my $severity = shift;
	my $message = shift;

	if(!$LogFormats{$severity}) {
	$severity = "DEFAULT";
	}

	my $format = $LogFormats{$severity};

	# Put the window dressing in in front of the message format:

	my $now = time;
	my $local = localtime($now);
	my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
	my $finalformat = $finalformat.$format."\n";

	# open the file and put the result.

	my $execdir = $perlvar{'lonDaemons'};
	my $fh = IO::File->new(">>$execdir/logs/lonc.log");
	my $msg = sprintf($finalformat, $message);
	print $fh $msg;

	}


=pod	=pod

Line 155 sub SocketDump {	Line 235 sub SocketDump {

=pod	=pod

	=head2 ShowStatus

	Place some text as our pid status.

	=cut
	sub ShowStatus {
	my $status = shift;
	$0 = "lonc: ".$status;
	$Status = $status; # Make available for logging.

	}

	=pod

=head2 Tick	=head2 Tick

Invoked each timer tick.	Invoked each timer tick.

=cut	=cut


sub Tick {	sub Tick {
my $client;	my $client;
$0 = 'lonc: '.GetServerHost()." Connection count: ".$ConnectionCount;	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
Debug(6, "Tick");	Debug(6, "Tick");
Debug(6, " Current connection count: ".$ConnectionCount);	Debug(6, " Current connection count: ".$ConnectionCount);
foreach $client (keys %ActiveClients) {	foreach $client (keys %ActiveClients) {
Line 177 sub Tick {	Line 272 sub Tick {
$IdleSeconds++;	$IdleSeconds++;
if($IdleSeconds > $IdleTimeout) { # Prune a connection...	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
$Socket = $IdleConnections->pop();	$Socket = $IdleConnections->pop();
KillSocket($Socket, 0);	KillSocket($Socket);
}	}
} else {	} else {
$IdleSeconds = 0; # Reset idle count if not idle.	$IdleSeconds = 0; # Reset idle count if not idle.
}	}

	# 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.
	#

	my $Requests = $WorkQueue->Count();
	if (($ConnectionCount == 0) && ($Requests > 0)) {
	my $Connections = ($Requests <= $MaxConnectionCount) ?
	$Requests : $MaxConnectionCount;
	Debug(1,"Work but no connections, starting ".$Connections." of them");
	for ($i =0; $i < $Connections; $i++) {
	MakeLondConnection();
	}

	}
}	}

=pod	=pod
Line 222 long enough, it will be shut down and re	Line 332 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.
	delete($ActiveTransactions{$Socket}); # Server has no transaction

&Debug(6, "Server to idle");	&Debug(6, "Server to idle");

# If there's work to do, start the transaction:	# If there's work to do, start the transaction:

$reqdata = $WorkQueue->dequeue();	$reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
Debug(9, "Queue gave request data: ".$reqdata);
unless($reqdata eq undef) {	unless($reqdata eq undef) {
my $unixSocket = $ClientQueue->dequeue();	Debug(9, "Queue gave request data: ".$reqdata->getRequest());
&Debug(6, "Starting new work request");	&StartRequest($Socket, $reqdata);
&Debug(7, "Request: ".$reqdata);

&StartRequest($Socket, $unixSocket, $reqdata);
} else {	} else {

# There's no work waiting, so push the server to idle list.	# There's no work waiting, so push the server to idle list.
&Debug(8, "No new work requests, server connection going idle");	&Debug(8, "No new work requests, server connection going idle");
delete($ActiveTransactions{$Socket});
$IdleConnections->push($Socket);	$IdleConnections->push($Socket);
}	}
}	}
Line 274 sub ClientWritable {	Line 381 sub ClientWritable {
&Debug(6, "ClientWritable writing".$Data);	&Debug(6, "ClientWritable writing".$Data);
&Debug(9, "Socket is: ".$Socket);	&Debug(9, "Socket is: ".$Socket);

my $result = $Socket->send($Data, 0);	if($Socket->connected) {
	my $result = $Socket->send($Data, 0);
# $result undefined: the write failed.
# otherwise $result is the number of bytes written.
# Remove that preceding string from the data.
# If the resulting data is empty, destroy the watcher
# and set up a read event handler to accept the next
# request.

&Debug(9,"Send result is ".$result." Defined: ".defined($result));
if(defined($result)) {
&Debug(9, "send result was defined");
if($result == length($Data)) { # Entire string sent.
&Debug(9, "ClientWritable data all written");
$Watcher->cancel();
#
# Set up to read next request from socket:

my $descr = sprintf("Connection to lonc client %d",
$ActiveClients{$Socket});
Event->io(cb => \&ClientRequest,
poll => 'r',
desc => $descr,
data => "",
fd => $Socket);

} else { # Partial string sent.
$Watcher->data(substr($Data, $result));
}

} else { # Error of some sort...	# $result undefined: the write failed.
	# otherwise $result is the number of bytes written.
# Some errnos are possible:	# Remove that preceding string from the data.
my $errno = $!;	# If the resulting data is empty, destroy the watcher
if($errno == POSIX::EWOULDBLOCK \|\|	# and set up a read event handler to accept the next
$errno == POSIX::EAGAIN \|\|	# request.
$errno == POSIX::EINTR) {
# No action taken?
} else { # Unanticipated errno.
&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
$Watcher->cancel; # Stop the watcher.
$Socket->shutdown(2); # Kill connection
$Socket->close(); # Close the socket.
}

	&Debug(9,"Send result is ".$result." Defined: ".defined($result));
	if(defined($result)) {
	&Debug(9, "send result was defined");
	if($result == length($Data)) { # Entire string sent.
	&Debug(9, "ClientWritable data all written");
	$Watcher->cancel();
	#
	# Set up to read next request from socket:

	my $descr = sprintf("Connection to lonc client %d",
	$ActiveClients{$Socket});
	Event->io(cb => \&ClientRequest,
	poll => 'r',
	desc => $descr,
	data => "",
	fd => $Socket);

	} else { # Partial string sent.
	$Watcher->data(substr($Data, $result));
	}

	} else { # Error of some sort...

	# Some errnos are possible:
	my $errno = $!;
	if($errno == POSIX::EWOULDBLOCK \|\|
	$errno == POSIX::EAGAIN \|\|
	$errno == POSIX::EINTR) {
	# No action taken?
	} else { # Unanticipated errno.
	&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
	$Watcher->cancel; # Stop the watcher.
	$Socket->shutdown(2); # Kill connection
	$Socket->close(); # Close the socket.
	}

	}
	} else {
	$Watcher->cancel(); # A delayed request...just cancel.
}	}
}	}

Line 339 Parameters:	Line 450 Parameters:
Socket on which the lond transaction occured. This is a	Socket on which the lond transaction occured. This is a
LondConnection. The data received is in the TransactionReply member.	LondConnection. The data received is in the TransactionReply member.

=item Client	=item Transaction

Unix domain socket open on the ultimate client.	The transaction that is being completed.

=cut	=cut

sub CompleteTransaction {	sub CompleteTransaction {
&Debug(6,"Complete transaction");	&Debug(6,"Complete transaction");
my $Socket = shift;	my $Socket = shift;
my $Client = shift;	my $Transaction = shift;

	if (!$Transaction->isDeferred()) { # Normal transaction
	my $data = $Socket->GetReply(); # Data to send.
	StartClientReply($Transaction, $data);
	} else { # Delete deferred transaction file.
	Log("SUCCESS", "A delayed transaction was completed");
	unlink $Transaction->getFile();
	}
	}
	=pod
	=head1 StartClientReply

	Initiates a reply to a client where the reply data is a parameter.

	=head2 parameters:

	=item Transaction

	The transaction for which we are responding to the client.

	=item data

my $data = $Socket->GetReply(); # Data to send.	The data to send to apached client.

	=cut
	sub StartClientReply {
	my $Transaction = shift;
	my $data = shift;

	my $Client = $Transaction->getClient();

&Debug(8," Reply was: ".$data);	&Debug(8," Reply was: ".$data);
my $Serial = $ActiveClients{$Client};	my $Serial = $ActiveClients{$Client};
my $desc = sprintf("Connection to lonc client %d",	my $desc = sprintf("Connection to lonc client %d",

$Serial);	$Serial);
Event->io(fd => $Client,	Event->io(fd => $Client,
poll => "w",	poll => "w",
Line 366 sub CompleteTransaction {	Line 506 sub CompleteTransaction {
=head2 FailTransaction	=head2 FailTransaction

Finishes a transaction with failure because the associated lond socket	Finishes a transaction with failure because the associated lond socket
disconnected. It is up to our client to retry if desired.	disconnected. There are two possibilities:
	- The transaction is deferred: in which case we just quietly
	delete the transaction since there is no client connection.
	- 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.

Parameters:	Parameters:

=item client	=item client

The UNIX domain socket open on our client.	The LondTransaction we are failing.

=cut	=cut

sub FailTransaction {	sub FailTransaction {
my $client = shift;	my $transaction = shift;
	my $Lond = $transaction->getServer();
	if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it.
	my $client = $transcation->getClient();
	StartClientReply($client, "con_lost");
	}
	# not needed, done elsewhere if active.
	# delete $ActiveTransactions{$Lond};

	}

	=pod
	=head1 EmptyQueue

&Debug(8, "Failing transaction due to disconnect");	Fails all items in the work queue with con_lost.
my $Serial = $ActiveClients{$client};	Note that each item in the work queue is a transaction.
my $desc = sprintf("Connection to lonc client %d", $Serial);
my $data = "error: Connection to lond lost\n";

Event->io(fd => $client,
poll => "w",
desc => $desc,
cb => \&ClientWritable,
data => $data);

	=cut
	sub EmptyQueue {
	while($WorkQueue->Count()) {
	my $request = $Workqueue->dequeue(); # This is a transaction
	FailTransaction($request);
	}
}	}

=pod	=pod

	=head2 CloseAllLondConnections

	Close all connections open on lond prior to exit e.g.

	=cut
	sub CloseAllLondConnections {
	foreach $Socket (keys %ActiveConnections) {
	KillSocket($Socket);
	}
	}
	=cut

	=pod

=head2 KillSocket	=head2 KillSocket

Destroys a socket. This function can be called either when a socket	Destroys a socket. This function can be called either when a socket
Line 416 nonzero if we are allowed to create a ne	Line 587 nonzero if we are allowed to create a ne
=cut	=cut
sub KillSocket {	sub KillSocket {
my $Socket = shift;	my $Socket = shift;
my $Restart= shift;

# If the socket came from the active connection set, delete it.	$Socket->Shutdown();
# otherwise it came from the idle set and has already been destroyed:
	# If the socket came from the active connection set,
	# delete its transaction... note that FailTransaction should
	# already have been called!!!
	# otherwise it came from the idle set.
	#

if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
delete ($ActiveTransactions{$Socket});	delete ($ActiveTransactions{$Socket});
Line 428 sub KillSocket {	Line 603 sub KillSocket {
delete($ActiveConnections{$Socket});	delete($ActiveConnections{$Socket});
}	}
$ConnectionCount--;	$ConnectionCount--;
if( ($ConnectionCount = 0) && ($Restart)) {
MakeLondConnection();
}

	# If the connection count has gone to zero and there is work in the
	# work queue, the work all gets failed with con_lost.
	#
	if($ConnectionCount == 0) {
	EmptyQueue;
	}
}	}

=pod	=pod
Line 493 transaction is in progress, the socket a	Line 671 transaction is in progress, the socket a
=cut	=cut

sub LondReadable {	sub LondReadable {

my $Event = shift;	my $Event = shift;
my $Watcher = $Event->w;	my $Watcher = $Event->w;
my $Socket = $Watcher->data;	my $Socket = $Watcher->data;
my $client = undef;	my $client = undef;

	&Debug(6,"LondReadable called state = ".$State);


my $State = $Socket->GetState(); # All action depends on the state.	my $State = $Socket->GetState(); # All action depends on the state.

&Debug(6,"LondReadable called state = ".$State);
SocketDump(6, $Socket);	SocketDump(6, $Socket);

if($Socket->Readable() != 0) {	if($Socket->Readable() != 0) {
Line 513 sub LondReadable {	Line 693 sub LondReadable {
FailTransaction($ActiveTransactions{$Socket});	FailTransaction($ActiveTransactions{$Socket});
}	}
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket, 1);	KillSocket($Socket);
return;	return;
}	}
SocketDump(6,$Socket);	SocketDump(6,$Socket);
Line 529 sub LondReadable {	Line 709 sub LondReadable {
# in the connection takes care of setting that up. Just	# in the connection takes care of setting that up. Just
# need to transition to writable:	# need to transition to writable:

$Watcher->poll("w");
$Watcher->cb(\&LondWritable);	$Watcher->cb(\&LondWritable);
	$Watcher->poll("w");

} elsif ($State eq "ChallengeReplied") {	} elsif ($State eq "ChallengeReplied") {

Line 539 sub LondReadable {	Line 719 sub LondReadable {
# The ok was received. Now we need to request the key	# The ok was received. Now we need to request the key
# That requires us to be writable:	# That requires us to be writable:

$Watcher->poll("w");
$Watcher->cb(\&LondWritable);	$Watcher->cb(\&LondWritable);
	$Watcher->poll("w");

} elsif ($State eq "ReceivingKey") {	} elsif ($State eq "ReceivingKey") {

} elsif ($State eq "Idle") {	} elsif ($State eq "Idle") {
# If necessary, complete a transaction and then go into the	# If necessary, complete a transaction and then go into the
# idle queue.	# idle queue.
	$Watcher->cancel();
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
Debug(8,"Completing transaction!!");	Debug(8,"Completing transaction!!");
CompleteTransaction($Socket,	CompleteTransaction($Socket,
$ActiveTransactions{$Socket});	$ActiveTransactions{$Socket});
	} else {
	Log("SUCCESS", "Connection ".$ConnectionCount." to "
	.$RemoteHost." now ready for action");
}	}
$Watcher->cancel();
ServerToIdle($Socket); # Next work unit or idle.	ServerToIdle($Socket); # Next work unit or idle.

} 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
# here inthe first place.	# here inthe first place.
Line 636 is the socket on which to return a reply	Line 819 is the socket on which to return a reply
sub LondWritable {	sub LondWritable {
my $Event = shift;	my $Event = shift;
my $Watcher = $Event->w;	my $Watcher = $Event->w;
my @data = $Watcher->data;	my $Socket = $Watcher->data;
Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");	my $State = $Socket->GetState();

my $Socket = $data[0]; # I know there's at least a socket.	Debug(6,"LondWritable State = ".$State."\n");


# Figure out what to do depending on the state of the socket:	# Figure out what to do depending on the state of the socket:


my $State = $Socket->GetState();


SocketDump(6,$Socket);	SocketDump(6,$Socket);
Line 654 sub LondWritable {	Line 837 sub LondWritable {
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:
if(exists($ActiveTransactions{$Socket})) {	Log("WARNING", "Connection to ".$RemoteHost.
Debug(3, "Lond connection lost, failing transactions");	" has been disconnected");
FailTransaction($ActiveTransactions{$Socket});
}
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket, 1);	KillSocket($Socket);
return;	return;
}	}
# "init" is being sent...	# "init" is being sent...
Line 670 sub LondWritable {	Line 851 sub LondWritable {
# Now that init was sent, we switch	# Now that init was sent, we switch
# to watching for readability:	# to watching for readability:

$Watcher->poll("r");
$Watcher->cb(\&LondReadable);	$Watcher->cb(\&LondReadable);
	$Watcher->poll("r");

} elsif ($State eq "ChallengeReceived") {	} elsif ($State eq "ChallengeReceived") {
# We received the challenge, now we	# We received the challenge, now we
Line 679 sub LondWritable {	Line 860 sub LondWritable {
# we're waiting for the state to change	# we're waiting for the state to change

if($Socket->Writable() != 0) {	if($Socket->Writable() != 0) {
# Write of the next chunk resulted in an error.
	$Watcher->cancel();
	KillSocket($Socket);
	return;
}	}

} elsif ($State eq "ChallengeReplied") {	} elsif ($State eq "ChallengeReplied") {
# The echo was sent back, so we switch	# The echo was sent back, so we switch
# to watching readability.	# to watching readability.

$Watcher->poll("r");
$Watcher->cb(\&LondReadable);	$Watcher->cb(\&LondReadable);
	$Watcher->poll("r");

} elsif ($State eq "RequestingKey") {	} elsif ($State eq "RequestingKey") {
# At this time we're requesting the key.	# At this time we're requesting the key.
Line 697 sub LondWritable {	Line 881 sub LondWritable {

if($Socket->Writable() != 0) {	if($Socket->Writable() != 0) {
# Write resulted in an error.	# Write resulted in an error.
}

	$Watcher->cancel();
	KillSocket($Socket);
	return;

	}
} elsif ($State eq "ReceivingKey") {	} elsif ($State eq "ReceivingKey") {
# Now we need to wait for the key	# Now we need to wait for the key
# to come back from the peer:	# to come back from the peer:

$Watcher->poll("r");
$Watcher->cb(\&LondReadable);	$Watcher->cb(\&LondReadable);
	$Watcher->poll("r");

} elsif ($State eq "SendingRequest") {	} elsif ($State eq "SendingRequest") {
# At this time we are sending a request to the	# At this time we are sending a request to the
# peer... write the next chunk:	# peer... write the next chunk:

if($Socket->Writable() != 0) {	if($Socket->Writable() != 0) {
# Write resulted in an error.

	if(exists($ActiveTransactions{$Socket})) {
	Debug(3, "Lond connection lost, failing transactions");
	FailTransaction($ActiveTransactions{$Socket});
	}
	$Watcher->cancel();
	KillSocket($Socket);
	return;

}	}

} elsif ($State eq "ReceivingReply") {	} elsif ($State eq "ReceivingReply") {
# The send has completed. Wait for the	# The send has completed. Wait for the
# data to come in for a reply.	# data to come in for a reply.
Debug(8,"Writable sent request/receiving reply");	Debug(8,"Writable sent request/receiving reply");
$Watcher->poll("r");
$Watcher->cb(\&LondReadable);	$Watcher->cb(\&LondReadable);
	$Watcher->poll("r");

} else {	} else {
# Control only passes here on an error:	# Control only passes here on an error:
Line 732 sub LondWritable {	Line 927 sub LondWritable {
}	}

}	}
	=pod

	=cut
	sub QueueDelayed {
	Debug(3,"QueueDelayed called");

	my $path = "$perlvar{'lonSockDir'}/delayed";

	Debug(4, "Delayed path: ".$path);
	opendir(DIRHANDLE, $path);

	@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
	Debug(4, "Got ".$alldelayed." delayed files");
	closedir(DIRHANDLE);
	my $dfname;
	my $reqfile;
	foreach $dfname (sort @alldelayed) {
	$reqfile = "$path/$dfname";
	Debug(4, "queueing ".$reqfile);
	my $Handle = IO::File->new($reqfile);
	my $cmd = <$Handle>;
	chomp $cmd; # There may or may not be a newline...
	$cmd = $cmd."\ny"; # now for sure there's exactly one newline.
	my $Transaction = LondTransaction->new($cmd);
	$Transaction->SetDeferred($reqfile);
	QueueTransaction($Transaction);
	}

	}

=pod	=pod

Line 753 sub MakeLondConnection {	Line 977 sub MakeLondConnection {
&GetServerPort());	&GetServerPort());

if($Connection == undef) { # Needs to be more robust later.	if($Connection == undef) { # Needs to be more robust later.
die "Failed to make a connection!!".$!."\n";	Log("CRITICAL","Failed to make a connection with lond.");
	} else {
	# The connection needs to have writability
	# monitored in order to send the init sequence
	# that starts the whole authentication/key
	# exchange underway.
	#
	my $Socket = $Connection->GetSocket();
	if($Socket == undef) {
	die "did not get a socket from the connection";
	} else {
	&Debug(9,"MakeLondConnection got socket: ".$Socket);
	}

}
# The connection needs to have writability	$event = Event->io(fd => $Socket,
# monitored in order to send the init sequence	poll => 'w',
# that starts the whole authentication/key	cb => \&LondWritable,
# exchange underway.	data => $Connection,
#	desc => 'Connection to lond server');
my $Socket = $Connection->GetSocket();	$ActiveConnections{$Connection} = $event;
if($Socket == undef) {
die "did not get a socket from the connection";	$ConnectionCount++;
} else {	Debug(4, "Connection count = ".$ConnectionCount);
&Debug(9,"MakeLondConnection got socket: ".$Socket);	if($ConnectionCount == 1) { # First Connection:
	QueueDelayed;
	}
	Log("SUCESS", "Created connection ".$ConnectionCount
	." to host ".GetServerHost());
}	}


$event = Event->io(fd => $Socket,
poll => 'w',
cb => \&LondWritable,
data => ($Connection, undef),
desc => 'Connection to lond server');
$ActiveConnections{$Connection} = $event;

$ConnectionCount++;


}	}

Line 808 The text of the request to send.	Line 1037 The text of the request to send.

sub StartRequest {	sub StartRequest {
my $Lond = shift;	my $Lond = shift;
my $Client = shift;	my $Request = shift; # This is a LondTransaction.
my $Request = shift;

Debug(6, "StartRequest: ".$Request);	Debug(6, "StartRequest: ".$Request->getRequest());

my $Socket = $Lond->GetSocket();	my $Socket = $Lond->GetSocket();

$ActiveTransactions{$Lond} = $Client; # Socket to relay to client.	$Request->Activate($Lond);
	$ActiveTransactions{$Lond} = $Request;

$Lond->InitiateTransaction($Request);	$Lond->InitiateTransaction($Request->getRequest());
$event = Event->io(fd => $Lond->GetSocket(),	$event = Event->io(fd => $Socket,
poll => "w",	poll => "w",
cb => \&LondWritable,	cb => \&LondWritable,
data => $Lond,	data => $Lond,
Line 849 data to send to the lond.	Line 1078 data to send to the lond.
=cut	=cut

sub QueueTransaction {	sub QueueTransaction {
my $requestSocket = shift;
my $requestData = shift;

Debug(6,"QueueTransaction: ".$requestData);	my $requestData = shift; # This is a LondTransaction.
	my $cmd = $requestData->getRequest();

	Debug(6,"QueueTransaction: ".$cmd);

my $LondSocket = $IdleConnections->pop();	my $LondSocket = $IdleConnections->pop();
if(!defined $LondSocket) { # Need to queue request.	if(!defined $LondSocket) { # Need to queue request.
Debug(8,"Must queue...");	Debug(8,"Must queue...");
$ClientQueue->enqueue($requestSocket);
$WorkQueue->enqueue($requestData);	$WorkQueue->enqueue($requestData);
if($ConnectionCount < $MaxConnectionCount) {	if($ConnectionCount < $MaxConnectionCount) {
Debug(4,"Starting additional lond connection");	Debug(4,"Starting additional lond connection");
Line 865 sub QueueTransaction {	Line 1094 sub QueueTransaction {
}	}
} else { # Can start the request:	} else { # Can start the request:
Debug(8,"Can start...");	Debug(8,"Can start...");
StartRequest($LondSocket, $requestSocket, $requestData);	StartRequest($LondSocket, $requestData);
}	}
}	}

Line 904 sub ClientRequest {	Line 1133 sub ClientRequest {
$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 == "close_connection_exit\n") {
	Log("CRITICAL",
	"Request Close Connection ... exiting");
	CloseAllLondConnections();
	exit;
	}
Debug(8, "Complete transaction received: ".$data);	Debug(8, "Complete transaction received: ".$data);
QueueTransaction($socket, $data);	my $Transaction = LondTransaction->new($data);
	$Transaction->SetClient($socket);
	QueueTransaction($Transaction);
$watcher->cancel(); # Done looking for input data.	$watcher->cancel(); # Done looking for input data.
}	}

Line 967 Returns the host whose lond we talk with	Line 1204 Returns the host whose lond we talk with

=cut	=cut

sub GetServerHost { # Stub - get this from config.	sub GetServerHost {
return $RemoteHost; # Setup by the fork.	return $RemoteHost; # Setup by the fork.
}	}

Line 979 Returns the lond port number.	Line 1216 Returns the lond port number.

=cut	=cut

sub GetServerPort { # Stub - get this from config.	sub GetServerPort {
return $perlvar{londPort};	return $perlvar{londPort};
}	}

Line 1000 sub SetupLoncListener {	Line 1237 sub SetupLoncListener {
my $socket;	my $socket;
my $SocketName = GetLoncSocketPath();	my $SocketName = GetLoncSocketPath();
unlink($SocketName);	unlink($SocketName);
unless ($socket = IO::Socket::UNIX->new(Local => $SocketName,	unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
Listen => 10,	Listen => 10,
Type => SOCK_STREAM)) {	Type => SOCK_STREAM)) {
die "Failed to create a lonc listner socket";	die "Failed to create a lonc listner socket";
Line 1021 This sub implements a child process for	Line 1258 This sub implements a child process for

sub ChildProcess {	sub ChildProcess {

print "Loncnew\n";

# For now turn off signals.	# For now turn off signals.

Line 1043 sub ChildProcess {	Line 1279 sub ChildProcess {
# Setup the initial server connection:	# Setup the initial server connection:

&MakeLondConnection();	&MakeLondConnection();

	if($ConnectionCount == 0) {
	Debug(1,"Could not make initial connection..\n");
	Debug(1,"Will retry when there's work to do\n");
	}
Debug(9,"Entering event loop");	Debug(9,"Entering event loop");
my $ret = Event::loop(); # Start the main event loop.	my $ret = Event::loop(); # Start the main event loop.

Line 1056 sub ChildProcess {	Line 1296 sub ChildProcess {
sub CreateChild {	sub CreateChild {
my $host = shift;	my $host = shift;
$RemoteHost = $host;	$RemoteHost = $host;
Debug(3, "Forking off child for ".$RemoteHost);	Log("CRITICAL", "Forking server for ".$host);
sleep(5);
$pid = fork;	$pid = fork;
if($pid) { # Parent	if($pid) { # Parent
$ChildHash{$pid} = $RemoteHost;	$ChildHash{$pid} = $RemoteHost;
} else { # child.	} else { # child.
	ShowStatus("Connected to ".$RemoteHost);
ChildProcess;	ChildProcess;
}	}

Line 1076 sub CreateChild {	Line 1316 sub CreateChild {
# Each exit gets logged and the child gets restarted.	# Each exit gets logged and the child gets restarted.
#	#

	#
	# Fork and start in new session so hang-up isn't going to
	# happen without intent.
	#






	ShowStatus("Forming new session");
	my $childpid = fork;
	if ($childpid != 0) {
	sleep 4; # Give child a chacne to break to
	exit 0; # a new sesion.
	}
	#
	# Write my pid into the pid file so I can be located
	#

	ShowStatus("Parent writing pid file:");
	$execdir = $perlvar{'lonDaemons'};
	open (PIDSAVE, ">$execdir/logs/lonc.pid");
	print PIDSAVE "$$\n";
	close(PIDSAVE);

	if (POSIX::setsid() < 0) {
	print "Could not create new session\n";
	exit -1;
	}

	ShowStatus("Forking node servers");

	Log("CRITICAL", "--------------- Starting children ---------------");

my $HostIterator = LondConnection::GetHostIterator;	my $HostIterator = LondConnection::GetHostIterator;
while (! $HostIterator->end()) {	while (! $HostIterator->end()) {

Line 1086 while (! $HostIterator->end()) {	Line 1361 while (! $HostIterator->end()) {

# Maintain the population:	# Maintain the population:

	ShowStatus("Parent keeping the flock");

while(1) {	while(1) {
$deadchild = wait();	$deadchild = wait();
if(exists $ChildHash{$deadchild}) { # need to restart.	if(exists $ChildHash{$deadchild}) { # need to restart.
$deadhost = $ChildHash{$deadchild};	$deadhost = $ChildHash{$deadchild};
delete($ChildHash{$deadchild});	delete($ChildHash{$deadchild});
Debug(4,"Lost child pid= ".$deadchild.	Log("WARNING","Lost child pid= ".$deadchild.
"Connected to host ".$deadhost);	"Connected to host ".$deadhost);
	Log("INFO", "Restarting child procesing ".$deadhost);
CreateChild($deadhost);	CreateChild($deadhost);
}	}
}	}

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

Removed from v.1.4
changed lines
	Added in v.1.9