Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.47 and 1.53

version 1.47, 2004/06/01 10:02:13	version 1.53, 2004/09/20 09:34:31
Line 82 my $ClientConnection = 0; # Uniquifier f	Line 82 my $ClientConnection = 0; # Uniquifier f

my $DebugLevel = 0;	my $DebugLevel = 0;
my $NextDebugLevel= 2; # So Sigint can toggle this.	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.	my $LogTransactions = 0; # When True, all transactions/replies get logged.

Line 103 my $RecentLogEntry = "";	Line 103 my $RecentLogEntry = "";
my $ConnectionRetries=2; # Number of connection retries allowed.	my $ConnectionRetries=2; # Number of connection retries allowed.
my $ConnectionRetriesLeft=2; # Number of connection retries remaining.	my $ConnectionRetriesLeft=2; # Number of connection retries remaining.
my $LondVersion = "unknown"; # Version of lond we talk with.	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	# The hash below gives the HTML format for log messages
Line 232 sub SocketDump {	Line 233 sub SocketDump {
my ($level, $socket) = @_;	my ($level, $socket) = @_;

if($level <= $DebugLevel) {	if($level <= $DebugLevel) {
$socket->Dump();	$socket->Dump(-1); # Ensure it will get dumped.
}	}
}	}

Line 264 sub ShowStatus {	Line 265 sub ShowStatus {
sub SocketTimeout {	sub SocketTimeout {
my $Socket = shift;	my $Socket = shift;
Log("WARNING", "A socket timeout was detected");	Log("WARNING", "A socket timeout was detected");
Debug(0, " SocketTimeout called: ");	Debug(5, " SocketTimeout called: ");
$Socket->Dump();	$Socket->Dump(0);
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
FailTransaction($ActiveTransactions{$Socket});	FailTransaction($ActiveTransactions{$Socket});
}	}
Line 273 sub SocketTimeout {	Line 274 sub SocketTimeout {
# a connection failure:	# a connection failure:
$ConnectionRetriesLeft--;	$ConnectionRetriesLeft--;
if($ConnectionRetriesLeft <= 0) {	if($ConnectionRetriesLeft <= 0) {
Log("CRITICAL", "Host marked dead: ".GetServerHost());	Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
}	}

}	}
Line 289 Invoked each timer tick.	Line 290 Invoked each timer tick.


sub Tick {	sub Tick {
	my ($Event) = @_;
	my $clock_watcher = $Event->w;

my $client;	my $client;
if($ConnectionRetriesLeft > 0) {	if($ConnectionRetriesLeft > 0) {
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
." Retries remaining: ".$ConnectionRetriesLeft);	." Retries remaining: ".$ConnectionRetriesLeft
	." ($KeyMode)");
} else {	} else {
ShowStatus(GetServerHost()." >> DEAD <<");	ShowStatus(GetServerHost()." >> DEAD <<");
}	}
Line 305 sub Tick {	Line 310 sub Tick {
if($IdleSeconds > $IdleTimeout) { # Prune a connection...	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
my $Socket = $IdleConnections->pop();	my $Socket = $IdleConnections->pop();
KillSocket($Socket);	KillSocket($Socket);
	IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
}	}
} else {	} else {
$IdleSeconds = 0; # Reset idle count if not idle.	$IdleSeconds = 0; # Reset idle count if not idle.
Line 347 sub Tick {	Line 353 sub Tick {
}	}

}	}
	if ($ConnectionCount == 0) {
	$KeyMode = "";
	$clock_watcher->cancel();
	}
}	}

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

&Debug(5, "Server to idle");	&Debug(5, "Server to idle");
Line 466 sub ClientWritable {	Line 477 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!!	if($result == 0) { # client hung up on us!!
Log("INFO", "lonc pipe client hung up on us!");	# Log("INFO", "lonc pipe client hung up on us!");
$Watcher->cancel;	$Watcher->cancel;
$Socket->shutdown(2);	$Socket->shutdown(2);
$Socket->close();	$Socket->close();
Line 594 Parameters:	Line 605 Parameters:

sub FailTransaction {	sub FailTransaction {
my $transaction = shift;	my $transaction = shift;
Log("WARNING", "Failing transaction ".$transaction->getRequest());
	# If the socket is dead, that's already logged.

	if ($ConnectionRetriesLeft > 0) {
	Log("WARNING", "Failing transaction "
	.$transaction->getRequest());
	}
Debug(1, "Failing transaction: ".$transaction->getRequest());	Debug(1, "Failing transaction: ".$transaction->getRequest());
if (!$transaction->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 = $transaction->getClient();	my $client = $transaction->getClient();
Line 1128 sub MakeLondConnection {	Line 1145 sub MakeLondConnection {
data => $Connection,	data => $Connection,
desc => 'Connection to lond server');	desc => 'Connection to lond server');
$ActiveConnections{$Connection} = $event;	$ActiveConnections{$Connection} = $event;
	if ($ConnectionCount == 0) {
	&SetupTimer; # Need to handle timeouts with connections...
	}
$ConnectionCount++;	$ConnectionCount++;
Debug(4, "Connection count = ".$ConnectionCount);	Debug(4, "Connection count = ".$ConnectionCount);
if($ConnectionCount == 1) { # First Connection:	if($ConnectionCount == 1) { # First Connection:
Line 1441 sub ChildStatus {	Line 1460 sub ChildStatus {
my $state = $Socket->GetState();	my $state = $Socket->GetState();
print $fh "Connection $i State: $state\n";	print $fh "Connection $i State: $state\n";
print STDERR "---------------------- Connection $i \n";	print STDERR "---------------------- Connection $i \n";
$Socket->Dump();	$Socket->Dump(-1); # Ensure it gets dumped..
$i++;	$i++;
}	}
}	}
Line 1515 sub ChildProcess {	Line 1534 sub ChildProcess {
cb => \&ToggleDebug,	cb => \&ToggleDebug,
data => "INT");	data => "INT");

SetupTimer();

SetupLoncListener();	SetupLoncListener();

Line 1538 sub ChildProcess {	Line 1556 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 $sigset = POSIX::SigSet->new(SIGINT);	my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);	sigprocmask(SIG_BLOCK, $sigset);
my $host = shift;
$RemoteHost = $host;	$RemoteHost = $host;
Log("CRITICAL", "Forking server for ".$host);	Log("CRITICAL", "Forking server for ".$host);
my $pid = fork;	my $pid = fork;
Line 1811 sub KillThemAll {	Line 1830 sub KillThemAll {
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.	local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
foreach my $pid (keys %ChildHash) {	foreach my $pid (keys %ChildHash) {
my $serving = $ChildHash{$pid};	my $serving = $ChildHash{$pid};
Debug(2, "Killing lonc for $serving pid = $pid");	ShowStatus("Nicely Killing lonc for $serving pid = $pid");
ShowStatus("Killing lonc for $serving pid = $pid");	Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Killing lonc for $serving pid = $pid");
kill 'QUIT' => $pid;	kill 'QUIT' => $pid;
delete($ChildHash{$pid});
}	}
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");

}	}


	#
	# Kill all children via KILL. Just in case the
	# first shot didn't get them.

	sub really_kill_them_all_dammit
	{
	Debug(2, "Kill them all Dammit");
	local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them.
	foreach my $pid (keys %ChildHash) {
	my $serving = $ChildHash{$pid};
	&ShowStatus("Nastily killing lonc for $serving pid = $pid");
	Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
	kill 'KILL' => $pid;
	delete($ChildHash{$pid});
	my $execdir = $perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");
	}
	}
=pod	=pod

=head1 Terminate	=head1 Terminate
Line 1831 Terminate the system.	Line 1866 Terminate the system.
=cut	=cut

sub Terminate {	sub Terminate {
KillThemAll;	&Log("CRITICAL", "Asked to kill children.. first be nice...");
	&KillThemAll;
	#
	# By now they really should all be dead.. but just in case
	# send them all SIGKILL's after a bit of waiting:

	sleep(4);
	&Log("CRITICAL", "Now kill children nasty");
	&really_kill_them_all_dammit;
Log("CRITICAL","Master process exiting");	Log("CRITICAL","Master process exiting");
exit 0;	exit 0;

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

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.47
changed lines
	Added in v.1.53