loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.9 and 1.15

version 1.9, 2003/06/13 02:38:43	version 1.15, 2003/07/15 02:07:05
Line 27	Line 27
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
#	#
# new lonc handles n requestors spread out bver m connections to londs.	# new lonc handles n request out bver m connections to londs.
# This module is based on the Event class.	# This module is based on the Event class.
# Development iterations:	# Development iterations:
# - Setup basic event loop. (done)	# - Setup basic event loop. (done)
Line 46	Line 46

# Change log:	# Change log:
# $Log$	# $Log$
	# Revision 1.15 2003/07/15 02:07:05 foxr
	# Added code for lonc/lond transaction timeouts. Who knows if it works right.
	# The intent is for a timeout to fail any transaction in progress and kill
	# off the sockt that timed out.
	#
	# Revision 1.14 2003/07/03 02:10:18 foxr
	# Get all of the signals to work correctly.
	#
	# Revision 1.13 2003/07/02 01:31:55 foxr
	# Added kill -HUP logic (restart).
	#
	# Revision 1.11 2003/06/25 01:54:44 foxr
	# Fix more problems with transaction failure.
	#
	# Revision 1.10 2003/06/24 02:46:04 foxr
	# Put a limit on the number of times we'll retry a connection.
	# Start getting the signal stuff put in as well...note that need to get signals
	# going or else 6the client will permanently give up on dead servers.
	#
# Revision 1.9 2003/06/13 02:38:43 foxr	# Revision 1.9 2003/06/13 02:38:43 foxr
# Add logging in 'expected format'	# Add logging in 'expected format'
#	#
Line 63 use lib "/home/httpd/lib/perl/";	Line 82 use lib "/home/httpd/lib/perl/";
use lib "/home/foxr/newloncapa/types";	use lib "/home/foxr/newloncapa/types";
use Event qw(:DEFAULT );	use Event qw(:DEFAULT );
use POSIX qw(:signal_h);	use POSIX qw(:signal_h);
	use POSIX;
use IO::Socket;	use IO::Socket;
use IO::Socket::INET;	use IO::Socket::INET;
use IO::Socket::UNIX;	use IO::Socket::UNIX;
Line 81 use LONCAPA::HashIterator;	Line 101 use LONCAPA::HashIterator;
#	#
# Disable all signals we might receive from outside for now.	# Disable all signals we might receive from outside for now.
#	#
$SIG{QUIT} = IGNORE;	#$SIG{QUIT} = IGNORE;
$SIG{HUP} = IGNORE;	#$SIG{HUP} = IGNORE;
$SIG{USR1} = IGNORE;	#$SIG{USR1} = IGNORE;
$SIG{INT} = IGNORE;	#$SIG{INT} = IGNORE;
$SIG{CHLD} = IGNORE;	#$SIG{CHLD} = IGNORE;
$SIG{__DIE__} = IGNORE;	#$SIG{__DIE__} = IGNORE;


# Read the httpd configuration file to get perl variables	# Read the httpd configuration file to get perl variables
Line 120 my $WorkQueue = Queue->new(); # Qu	Line 140 my $WorkQueue = Queue->new(); # Qu
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.	my $Status = ""; # Current status string.
	my $RecentLogEntry = "";
	my $ConnectionRetries=5; # Number of connection retries allowed.
	my $ConnectionRetriesLeft=5; # Number of connection retries remaining.

#	#
# The hash below gives the HTML format for log messages	# The hash below gives the HTML format for log messages
Line 134 $LogFormats{"INFO"} = "<font color=y	Line 156 $LogFormats{"INFO"} = "<font color=y
$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>";	$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>";
$LogFormats{"DEFAULT"} = " %s ";	$LogFormats{"DEFAULT"} = " %s ";

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

	=pod

	=head2 LogPerm

	Makes an entry into the permanent log file.

	=cut
	sub LogPerm {
	my $message=shift;
	my $execdir=$perlvar{'lonDaemons'};
	my $now=time;
	my $local=localtime($now);
	my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
	print $fh "$now:$message:$local\n";
	}

=pod	=pod

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


}	}


Line 238 sub SocketDump {	Line 278 sub SocketDump {
=head2 ShowStatus	=head2 ShowStatus

Place some text as our pid status.	Place some text as our pid status.
	and as what we return in a SIGUSR1

=cut	=cut
sub ShowStatus {	sub ShowStatus {
my $status = shift;	my $state = shift;
$0 = "lonc: ".$status;	my $now = time;
$Status = $status; # Make available for logging.	my $local = localtime($now);
	$Status = $local.": ".$state;
	$0='lonc: '.$state.' '.$local;
	}

	=pod

	=head 2 SocketTimeout

	Called when an action on the socket times out. The socket is
	destroyed and any active transaction is failed.


	=cut
	sub SocketTimeout {
	my $Socket = shift;

	KillSocket($Socket);
}	}

=pod	=pod
Line 259 Invoked each timer tick.	Line 316 Invoked each timer tick.
sub Tick {	sub Tick {
my $client;	my $client;
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
Debug(6, "Tick");
Debug(6, " Current connection count: ".$ConnectionCount);
foreach $client (keys %ActiveClients) {
Debug(7, " Have client: with id: ".$ActiveClients{$client});
}
# Is it time to prune connection count:	# Is it time to prune connection count:


Line 277 sub Tick {	Line 330 sub Tick {
} else {	} else {
$IdleSeconds = 0; # Reset idle count if not idle.	$IdleSeconds = 0; # Reset idle count if not idle.
}	}
	#
	# For each inflight transaction, tick down its timeout counter.
	#
	foreach $item (keys %ActiveTransactions) {
	my $Socket = $ActiveTransactions{$item}->getServer();
	$Socket->Tick();
	}
# Do we have work in the queue, but no connections to service them?	# 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.	# If so, try to make some new connections to get things going again.
#	#

my $Requests = $WorkQueue->Count();	my $Requests = $WorkQueue->Count();
if (($ConnectionCount == 0) && ($Requests > 0)) {	if (($ConnectionCount == 0) && ($Requests > 0)) {
my $Connections = ($Requests <= $MaxConnectionCount) ?	if ($ConnectionRetriesLeft > 0) {
$Requests : $MaxConnectionCount;	my $Connections = ($Requests <= $MaxConnectionCount) ?
Debug(1,"Work but no connections, starting ".$Connections." of them");	$Requests : $MaxConnectionCount;
for ($i =0; $i < $Connections; $i++) {	Debug(1,"Work but no connections, start ".$Connections." of them");
MakeLondConnection();	for ($i =0; $i < $Connections; $i++) {
	MakeLondConnection();
	}
	} else {
	Debug(1,"Work in queue, but gave up on connections..flushing\n");
	EmptyQueue(); # Connections can't be established.
}	}

}	}
Line 410 sub ClientWritable {	Line 474 sub ClientWritable {

} else { # Partial string sent.	} else { # Partial string sent.
$Watcher->data(substr($Data, $result));	$Watcher->data(substr($Data, $result));
	if($result == 0) { # client hung up on us!!
	Log("INFO", "lonc pipe client hung up on us!");
	$Watcher->cancel;
	$Socket->shutdown(2);
	$Socket->close();
	}
}	}

} else { # Error of some sort...	} else { # Error of some sort...
Line 466 sub CompleteTransaction {	Line 536 sub CompleteTransaction {
StartClientReply($Transaction, $data);	StartClientReply($Transaction, $data);
} else { # Delete deferred transaction file.	} else { # Delete deferred transaction file.
Log("SUCCESS", "A delayed transaction was completed");	Log("SUCCESS", "A delayed transaction was completed");
	LogPerm("S:$Client:".$Transaction->getRequest());
unlink $Transaction->getFile();	unlink $Transaction->getFile();
}	}
}	}
Line 489 sub StartClientReply {	Line 560 sub StartClientReply {
my $Transaction = shift;	my $Transaction = shift;
my $data = shift;	my $data = shift;


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

&Debug(8," Reply was: ".$data);	&Debug(8," Reply was: ".$data);
Line 525 Parameters:	Line 597 Parameters:

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

}	}

Line 544 sub FailTransaction {	Line 615 sub FailTransaction {
=cut	=cut
sub EmptyQueue {	sub EmptyQueue {
while($WorkQueue->Count()) {	while($WorkQueue->Count()) {
my $request = $Workqueue->dequeue(); # This is a transaction	my $request = $WorkQueue->dequeue(); # This is a transaction
FailTransaction($request);	FailTransaction($request);
}	}
}	}
Line 683 sub LondReadable {	Line 754 sub LondReadable {
my $State = $Socket->GetState(); # All action depends on the state.	my $State = $Socket->GetState(); # All action depends on the state.

SocketDump(6, $Socket);	SocketDump(6, $Socket);
	my $status = $Socket->Readable();
	&Debug(2, "Socket->Readable returned: $status");

if($Socket->Readable() != 0) {	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.	# The socket has become disconnected. We fail the transaction.

Line 949 sub QueueDelayed {	Line 1022 sub QueueDelayed {
my $Handle = IO::File->new($reqfile);	my $Handle = IO::File->new($reqfile);
my $cmd = <$Handle>;	my $cmd = <$Handle>;
chomp $cmd; # There may or may not be a newline...	chomp $cmd; # There may or may not be a newline...
$cmd = $cmd."\ny"; # now for sure there's exactly one newline.	$cmd = $cmd."\n"; # now for sure there's exactly one newline.
my $Transaction = LondTransaction->new($cmd);	my $Transaction = LondTransaction->new($cmd);
$Transaction->SetDeferred($reqfile);	$Transaction->SetDeferred($reqfile);
QueueTransaction($Transaction);	QueueTransaction($Transaction);
Line 978 sub MakeLondConnection {	Line 1051 sub MakeLondConnection {

if($Connection == undef) { # Needs to be more robust later.	if($Connection == undef) { # Needs to be more robust later.
Log("CRITICAL","Failed to make a connection with lond.");	Log("CRITICAL","Failed to make a connection with lond.");
	$ConnectionRetriesLeft--;
	return 0; # Failure.
} else {	} else {
	$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
# The connection needs to have writability	# The connection needs to have writability
# monitored in order to send the init sequence	# monitored in order to send the init sequence
# that starts the whole authentication/key	# that starts the whole authentication/key
Line 1006 sub MakeLondConnection {	Line 1082 sub MakeLondConnection {
}	}
Log("SUCESS", "Created connection ".$ConnectionCount	Log("SUCESS", "Created connection ".$ConnectionCount
." to host ".GetServerHost());	." to host ".GetServerHost());
	return 1; # Return success.
}	}

}	}
Line 1103 sub QueueTransaction {	Line 1180 sub QueueTransaction {
=pod	=pod

=head2 ClientRequest	=head2 ClientRequest

Callback that is called when data can be read from the UNIX domain	Callback that is called when data can be read from the UNIX domain
socket connecting us with an apache server process.	socket connecting us with an apache server process.

Line 1128 sub ClientRequest {	Line 1204 sub ClientRequest {
close($socket);	close($socket);
$watcher->cancel();	$watcher->cancel();
delete($ActiveClients{$socket});	delete($ActiveClients{$socket});
	return;
}	}
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 == "close_connection_exit\n") {	if($data eq "close_connection_exit\n") {
Log("CRITICAL",	Log("CRITICAL",
"Request Close Connection ... exiting");	"Request Close Connection ... exiting");
CloseAllLondConnections();	CloseAllLondConnections();
Line 1248 sub SetupLoncListener {	Line 1325 sub SetupLoncListener {
fd => $socket);	fd => $socket);
}	}

	=pod

	=head2 ChildStatus

	Child USR1 signal handler to report the most recent status
	into the status file.

	=cut
	sub ChildStatus {
	my $event = shift;
	my $watcher = $event->w;

	Debug(2, "Reporting child status because : ".$watcher->data);
	my $docdir = $perlvar{'lonDocRoot'};
	my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
	print $fh $$."\t".$RemoteHost."\t".$Status."\t".
	$RecentLogEntry."\n";
	}

=pod	=pod

	=head2 SignalledToDeath

	Called in response to a signal that causes a chid process to die.

	=cut


	sub SignalledToDeath {
	my $event = shift;
	my $watcher= $event->w;

	Debug(2,"Signalled to death! via ".$watcher->data);
	my ($signal) = @_;
	chomp($signal);
	Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
	."died through "."\"$signal\"");
	LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
	."\"$signal\"");
	die("Signal abnormal end");
	exit 0;

	}
=head2 ChildProcess	=head2 ChildProcess

This sub implements a child process for a single lonc daemon.	This sub implements a child process for a single lonc daemon.
Line 1259 This sub implements a child process for	Line 1377 This sub implements a child process for
sub ChildProcess {	sub ChildProcess {


# For now turn off signals.	#
	# Signals must be handled by the Event framework...
$SIG{QUIT} = IGNORE;	#
$SIG{HUP} = IGNORE;	# $SIG{QUIT} = \&SignalledToDeath;
$SIG{USR1} = IGNORE;	# $SIG{HUP} = \&ChildStatus;
$SIG{INT} = IGNORE;	# $SIG{USR1} = IGNORE;
$SIG{CHLD} = IGNORE;	# $SIG{INT} = DEFAULT;
$SIG{__DIE__} = IGNORE;	# $SIG{CHLD} = IGNORE;
	# $SIG{__DIE__} = \&SignalledToDeath;

	Event->signal(signal => "QUIT",
	cb => \&SignalledToDeath,
	data => "QUIT");
	Event->signal(signal => "HUP",
	cb => \&ChildStatus,
	data => "HUP");
	Event->signal(signal => "USR1",
	cb => \&ChildStatus,
	data => "USR1");

SetupTimer();	SetupTimer();

Line 1278 sub ChildProcess {	Line 1407 sub ChildProcess {

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

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


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 1294 sub ChildProcess {	Line 1420 sub ChildProcess {
# Create a new child for host passed in:	# Create a new child for host passed in:

sub CreateChild {	sub CreateChild {
	my $sigset = POSIX::SigSet->new(SIGINT);
	sigprocmask(SIG_BLOCK, $sigset);
my $host = shift;	my $host = shift;
$RemoteHost = $host;	$RemoteHost = $host;
Log("CRITICAL", "Forking server for ".$host);	Log("CRITICAL", "Forking server for ".$host);
$pid = fork;	$pid = fork;
if($pid) { # Parent	if($pid) { # Parent
$ChildHash{$pid} = $RemoteHost;	$ChildHash{$pid} = $RemoteHost;
	sigprocmask(SIG_UNBLOCK, $sigset);

} else { # child.	} else { # child.
ShowStatus("Connected to ".$RemoteHost);	ShowStatus("Connected to ".$RemoteHost);
ChildProcess;	$SIG{INT} = DEFAULT;
	sigprocmask(SIG_UNBLOCK, $sigset);
	ChildProcess; # Does not return.
}	}

}	}
Line 1358 while (! $HostIterator->end()) {	Line 1490 while (! $HostIterator->end()) {
CreateChild($hostentryref->[0]);	CreateChild($hostentryref->[0]);
$HostIterator->next();	$HostIterator->next();
}	}
	$RemoteHost = "Parent Server";

# Maintain the population:	# Maintain the population:

ShowStatus("Parent keeping the flock");	ShowStatus("Parent keeping the flock");

	#
	# Set up parent signals:
	#

	$SIG{INT} = \&Terminate;
	$SIG{TERM} = \&Terminate;
	$SIG{HUP} = \&Restart;
	$SIG{USR1} = \&CheckKids;

while(1) {	while(1) {
$deadchild = wait();	$deadchild = wait();
if(exists $ChildHash{$deadchild}) { # need to restart.	if(exists $ChildHash{$deadchild}) { # need to restart.
Line 1375 while(1) {	Line 1517 while(1) {
}	}
}	}



	=pod

	=head1 CheckKids

	Since kids do not die as easily in this implementation
	as the previous one, there is no need to restart the
	dead ones (all dead kids get restarted when they die!!)
	The only thing this function does is to pass USR1 to the
	kids so that they report their status.

	=cut

	sub CheckKids {
	Debug(2, "Checking status of children");
	my $docdir = $perlvar{'lonDocRoot'};
	my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
	my $now=time;
	my $local=localtime($now);
	print $fh "LONC status $local - parent $$ \n\n";
	foreach $pid (keys %ChildHash) {
	Debug(2, "Sending USR1 -> $pid");
	kill 'USR1' => $pid; # Tell Child to report status.
	sleep 1; # Wait so file doesn't intermix.
	}
	}

	=pod

	=head1 Restart

	Signal handler for HUP... all children are killed and
	we self restart. This is an el-cheapo way to re read
	the config file.

	=cut

	sub Restart {
	KillThemAll; # First kill all the children.
	Log("CRITICAL", "Restarting");
	my $execdir = $perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");
	exec("$execdir/lonc");
	}

	=pod

	=head1 KillThemAll

	Signal handler that kills all children by sending them a
	SIGINT. Responds to sigint and sigterm.

	=cut

	sub KillThemAll {
	Debug(2, "Kill them all!!");
	local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
	foreach $pid (keys %ChildHash) {
	my $serving = $ChildHash{$pid};
	Debug(2, "Killing lonc for $serving pid = $pid");
	ShowStatus("Killing lonc for $serving pid = $pid");
	Log("CRITICAL", "Killing lonc for $serving pid = $pid");
	kill('INT', $pid);
	delete($ChildeHash{$pid});
	}
	my $execdir = $perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");
	ShowStatus("Killing the master process");
	Log("CRITICAL", "Killing the master process.");
	}

	=pod

	=head1 Terminate

	Terminate the system.

	=cut

	sub Terminate {
	KillThemAll;
	exit;

	}
	=pod

=head1 Theory	=head1 Theory

The event class is used to build this as a single process with an	The event class is used to build this as a single process with an

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

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