loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.61 and 1.62

version 1.61, 2004/09/29 10:37:35	version 1.62, 2004/10/04 10:30:50
Line 75 my %perlvar = %{$perlvarref};	Line 75 my %perlvar = %{$perlvarref};
my %ChildHash; # by pid -> host.	my %ChildHash; # by pid -> host.
my %HostToPid; # By host -> pid.	my %HostToPid; # By host -> pid.
my %HostHash; # by loncapaname -> IP.	my %HostHash; # by loncapaname -> IP.
	my %listening_to; # Socket->host table for who the parent
	# is listening to.
	my %parent_dispatchers; # host-> listener watcher events.

my $MaxConnectionCount = 10; # 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.
Line 110 my $LondConnecting = 0; # True wh	Line 112 my $LondConnecting = 0; # True wh
# DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!!	# DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!!

my $DieWhenIdle = 0; # When true children die when trimmed -> 0.	my $DieWhenIdle = 0; # When true children die when trimmed -> 0.
	my $I_am_child = 0; # True if this is the child process.

#	#
# The hash below gives the HTML format for log messages	# The hash below gives the HTML format for log messages
Line 1356 sub ClientRequest {	Line 1359 sub ClientRequest {

}	}

	#
	# Accept a connection request for a client (lonc child) and
	# start up an event watcher to keep an eye on input from that
	# Event. This can be called both from NewClient and from
	# ChildProcess if we are started in DieWhenIdle mode.
	# Parameters:
	# $socket - The listener socket.
	# Returns:
	# NONE
	# Side Effects:
	# An event is made to watch the accepted connection.
	# Active clients hash is updated to reflect the new connection.
	# The client connection count is incremented.
	#
	sub accept_client {
	my ($socket) = @_;

	Debug(8, "Entering accept for lonc UNIX socket\n");
	my $connection = $socket->accept(); # Accept the client connection.
	Debug(8,"Connection request accepted from "
	.GetPeername($connection, AF_UNIX));


	my $description = sprintf("Connection to lonc client %d",
	$ClientConnection);
	Debug(9, "Creating event named: ".$description);
	Event->io(cb => \&ClientRequest,
	poll => 'r',
	desc => $description,
	data => "",
	fd => $connection);
	$ActiveClients{$connection} = $ClientConnection;
	$ClientConnection++;
	}

=pod	=pod

Line 1374 sub NewClient {	Line 1411 sub NewClient {
my $event = shift; # Get the event parameters.	my $event = shift; # Get the event parameters.
my $watcher = $event->w;	my $watcher = $event->w;
my $socket = $watcher->fd; # Get the event' socket.	my $socket = $watcher->fd; # Get the event' socket.
my $connection = $socket->accept(); # Accept the client connection.
Debug(8,"Connection request accepted from "
.GetPeername($connection, AF_UNIX));

	&accept_client($socket);
my $description = sprintf("Connection to lonc client %d",
$ClientConnection);
Debug(9, "Creating event named: ".$description);
Event->io(cb => \&ClientRequest,
poll => 'r',
desc => $description,
data => "",
fd => $connection);
$ActiveClients{$connection} = $ClientConnection;
$ClientConnection++;
}	}

=pod	=pod
Line 1578 Optional parameter:	Line 1602 Optional parameter:
=cut	=cut

sub ChildProcess {	sub ChildProcess {
	# If we are in DieWhenIdle mode, we've inherited all the
	# events of our parent and those have to be cancelled or else
	# all holy bloody chaos will result.. trust me, I already made
	# >that< mistake.

	my $host = GetServerHost();
	foreach my $listener (keys %parent_dispatchers) {
	my $watcher = $parent_dispatchers{$listener};
	my $s = $watcher->fd;
	if ($listener ne $host) { # Close everyone but me.
	Debug(5, "Closing listen socket for $listener");
	$s->close();
	}
	Debug(5, "Killing watcher for $listener");

	$watcher->cancel();
	undef $parent_dispatchers{$listener};

	}
	$I_am_child = 1; # Seems like in spite of it all I'm still getting
	# parent event dispatches.


#	#
Line 1599 sub ChildProcess {	Line 1644 sub ChildProcess {
cb => \&ToggleDebug,	cb => \&ToggleDebug,
data => "INT");	data => "INT");

	# Figure out if we got passed a socket or need to open one to listen for
	# client requests.

my ($socket) = @_;	my ($socket) = @_;
if (!$socket) {	if (!$socket) {

$socket = SetupLoncListener();	$socket = SetupLoncListener();
}	}
	# Establish an event to listen for client connection requests.


Event->io(cb => \&NewClient,	Event->io(cb => \&NewClient,
poll => 'r',	poll => 'r',
desc => 'Lonc Listener Unix Socket',	desc => 'Lonc Listener Unix Socket',
Line 1616 sub ChildProcess {	Line 1666 sub ChildProcess {

# Setup the initial server connection:	# Setup the initial server connection:

# &MakeLondConnection(); // let first work requirest do it.	# &MakeLondConnection(); // let first work request do it.

	# If We are in diwhenidle, need to accept the connection since the
	# event may not fire.

	if ($DieWhenIdle) {
	&accept_client($socket);
	}

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 1629 sub ChildProcess {	Line 1685 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 ($host, $socket) = @_;

my $sigset = POSIX::SigSet->new(SIGINT);	my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);	sigprocmask(SIG_BLOCK, $sigset);
Line 1646 sub CreateChild {	Line 1702 sub CreateChild {
ShowStatus("Connected to ".$RemoteHost);	ShowStatus("Connected to ".$RemoteHost);
$SIG{INT} = 'DEFAULT';	$SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);	sigprocmask(SIG_UNBLOCK, $sigset);
ChildProcess; # Does not return.	if(defined $socket) {
	&ChildProcess($socket);
	} else {
	ChildProcess; # Does not return.
	}
}	}
}	}

Line 1664 sub CreateChild {	Line 1724 sub CreateChild {
# NONE	# NONE
#	#
sub parent_client_connection {	sub parent_client_connection {
die "DieWhenIdle processing not completely operational yet";	if ($I_am_child) {
	# Should not get here, but seem to anyway:
	&Debug(5," Child caught parent client connection event!!");
	my ($event) = @_;
	my $watcher = $event->w;
	$watcher->cancel(); # Try to kill it off again!!
	} else {
	&Debug(9, "parent_client_connection");
	my ($event) = @_;
	my $watcher = $event->w;
	my $socket = $watcher->fd;

	# Lookup the host associated with this socket:

	my $host = $listening_to{$socket};

	# Start the child:



	&Debug(9,"Creating child for $host (parent_client_connection)");
	&CreateChild($host, $socket);

	# Clean up the listen since now the child takes over until it exits.

	$watcher->cancel(); # Nolonger listening to this event
	delete($listening_to{$socket});
	delete($parent_dispatchers{$host});
	$socket->close();
	}
}	}

# parent_listen:	# parent_listen:
Line 1688 sub parent_listen {	Line 1776 sub parent_listen {
Debug(5, "parent_listen: $loncapa_host");	Debug(5, "parent_listen: $loncapa_host");

my $socket = &SetupLoncListener($loncapa_host);	my $socket = &SetupLoncListener($loncapa_host);
	$listening_to{$socket} = $loncapa_host;
if (!$socket) {	if (!$socket) {
die "Unable to create a listen socket for $loncapa_host";	die "Unable to create a listen socket for $loncapa_host";
}	}

my $lock_file = &GetLoncSocketPath().".lock";	my $lock_file = &GetLoncSocketPath($loncapa_host).".lock";
unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]	unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]

Event->io(cb => &parent_client_connection,	my $watcher = Event->io(cb => \&parent_client_connection,
poll => 'r',	poll => 'r',
desc => 'Parent listener unix socket',	desc => "Parent listener unix socket ($loncapa_host)",
fd => $socket);	fd => $socket);
	$parent_dispatchers{$loncapa_host} = $watcher;

}	}

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

Removed from v.1.61
changed lines
	Added in v.1.62