loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.10 and 1.23

version 1.10, 2003/06/24 02:46:04	version 1.23, 2003/09/15 09:24:49
Line 7	Line 7
# Copyright Michigan State University Board of Trustees	# Copyright Michigan State University Board of Trustees
#	#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#	## LON-CAPA is free software; you can redistribute it and/or modify
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by	# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or	# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.	# (at your option) any later version.
Line 27	Line 26
# 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 45

# Change log:	# Change log:
# $Log$	# $Log$
	# Revision 1.23 2003/09/15 09:24:49 foxr
	# Add use strict and fix all the fallout from that.
	#
	# Revision 1.22 2003/09/02 10:34:47 foxr
	# - Fix errors in host dead detection logic (too many cases where the
	# retries left were not getting incremented or just not checked).
	# - Added some additional status to the ps axuww display:
	# o Remaining retries on a host.
	# o >>> DEAD <<< indicator if I've given up on a host.
	# - Tested the SIGHUP will reset the retries remaining count (thanks to
	# the above status stuff, and get allow the loncnew to re-try again
	# on the host (thanks to the log).
	#
	# Revision 1.21 2003/08/26 09:19:51 foxr
	# How embarrassing... put in the SocketTimeout function in loncnew and forgot
	# to actually hook it into the LondTransaction. Added this to MakeLondConnection
	# where it belongs... hopefully transactions (not just connection attempts) will
	# timeout more speedily than the socket errors will catch it.
	#
	# Revision 1.20 2003/08/25 18:48:11 albertel
	# - fixing a forgotten ;
	#
	# Revision 1.19 2003/08/19 09:31:46 foxr
	# Get socket directory from configuration rather than the old hard coded test
	# way that I forgot to un-hard code.
	#
	# Revision 1.18 2003/08/06 09:52:29 foxr
	# Also needed to remember to fail in-flight transactions if their sends fail.
	#
	# Revision 1.17 2003/08/03 00:44:31 foxr
	# 1. Correct handling of connection failure: Assume it means the host is
	# unreachable and fail all of the queued transactions. Note that the
	# inflight transactions should fail on their own time due either to timeout
	# or send/receive failures.
	# 2. Correct handling of logs for forced death signals. Pull the signal
	# from the event watcher.
	#
	# Revision 1.16 2003/07/29 02:33:05 foxr
	# Add SIGINT processing to child processes to toggle annoying trace mode
	# on/off.. will try to use this to isolate the compute boud process issue.
	#
	# 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	# Revision 1.10 2003/06/24 02:46:04 foxr
# Put a limit on the number of times we'll retry a connection.	# 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	# 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.	# going or else the 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	Line 117
# complete coding to support deferred transactions.	# complete coding to support deferred transactions.
#	#
#	#
	use strict;
use lib "/home/httpd/lib/perl/";	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 86 use LONCAPA::HashIterator;	Line 141 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 110 my $MaxConnectionCount = 10; # Will get	Line 165 my $MaxConnectionCount = 10; # Will get
my $ClientConnection = 0; # Uniquifier for client events.	my $ClientConnection = 0; # Uniquifier for client events.

my $DebugLevel = 0;	my $DebugLevel = 0;
	my $NextDebugLevel= 10; # So Sigint can toggle this.
my $IdleTimeout= 3600; # Wait an hour before pruning connections.	my $IdleTimeout= 3600; # Wait an hour before pruning connections.

#	#
# The variables below are only used by the child processes.	# The variables below are only used by the child processes.
#	#
my $RemoteHost; # Name of host child is talking to.	my $RemoteHost; # Name of host child is talking to.
my $UnixSocketDir= "/home/httpd/sockets";	my $UnixSocketDir= $perlvar{'lonSockDir'};
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; # LondTransactions in flight.	my %ActiveTransactions; # LondTransactions in flight.
Line 125 my $WorkQueue = Queue->new(); # Qu	Line 181 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 $ConnectionRetries=5; # Number of connection retries allowed.
my $ConnectionRetriesLeft=5; # Number of connection retries remaining.	my $ConnectionRetriesLeft=5; # Number of connection retries remaining.

Line 201 sub Log {	Line 258 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 223 sub GetPeername {	Line 281 sub GetPeername {
my $peerip;	my $peerip;
if($AdrFamily == AF_INET) {	if($AdrFamily == AF_INET) {
($peerport, $peerip) = sockaddr_in($peer);	($peerport, $peerip) = sockaddr_in($peer);
my $peername = gethostbyaddr($iaddr, $AdrFamily);	my $peername = gethostbyaddr($peerip, $AdrFamily);
return $peername;	return $peername;
} elsif ($AdrFamily == AF_UNIX) {	} elsif ($AdrFamily == AF_UNIX) {
my $peerfile;	my $peerfile;
Line 244 sub Debug {	Line 302 sub Debug {
my $level = shift;	my $level = shift;
my $message = shift;	my $message = shift;
if ($level <= $DebugLevel) {	if ($level <= $DebugLevel) {
print $message." host = ".$RemoteHost."\n";	Log("INFO", "-Debug- $message host = $RemoteHost");
}	}
}	}

Line 274 sub ShowStatus {	Line 332 sub ShowStatus {

=pod	=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); # A transaction timeout also counts as
	# a connection failure:
	$ConnectionRetriesLeft--;
	}

	=pod

=head2 Tick	=head2 Tick

Invoked each timer tick.	Invoked each timer tick.
Line 283 Invoked each timer tick.	Line 358 Invoked each timer tick.

sub Tick {	sub Tick {
my $client;	my $client;
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);	if($ConnectionRetriesLeft > 0) {
Debug(6, "Tick");	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
Debug(6, " Current connection count: ".$ConnectionCount);	." Retries remaining: ".$ConnectionRetriesLeft);
foreach $client (keys %ActiveClients) {	} else {
Debug(7, " Have client: with id: ".$ActiveClients{$client});	ShowStatus(GetServerHost()." >> DEAD <<");
}	}
# Is it time to prune connection count:	# Is it time to prune connection count:

Line 296 sub Tick {	Line 371 sub Tick {
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?	($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
$IdleSeconds++;	$IdleSeconds++;
if($IdleSeconds > $IdleTimeout) { # Prune a connection...	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
$Socket = $IdleConnections->pop();	my $Socket = $IdleConnections->pop();
KillSocket($Socket);	KillSocket($Socket);
}	}
} 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 my $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.
#	#
Line 313 sub Tick {	Line 394 sub Tick {
my $Connections = ($Requests <= $MaxConnectionCount) ?	my $Connections = ($Requests <= $MaxConnectionCount) ?
$Requests : $MaxConnectionCount;	$Requests : $MaxConnectionCount;
Debug(1,"Work but no connections, start ".$Connections." of them");	Debug(1,"Work but no connections, start ".$Connections." of them");
for ($i =0; $i < $Connections; $i++) {	my $successCount = 0;
MakeLondConnection();	for (my $i =0; $i < $Connections; $i++) {
	$successCount += MakeLondConnection();
	}
	if($successCount == 0) { # All connections failed:
	Debug(1,"Work in queue failed to make any connectiouns\n");
	EmptyQueue(); # Fail pending transactions with con_lost.
}	}
} else {	} else {
	ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
Debug(1,"Work in queue, but gave up on connections..flushing\n");	Debug(1,"Work in queue, but gave up on connections..flushing\n");
EmptyQueue(); # Connections can't be established.	EmptyQueue(); # Connections can't be established.
}	}
Line 368 sub ServerToIdle {	Line 455 sub ServerToIdle {

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

$reqdata = $WorkQueue->dequeue(); # This is a LondTransaction	my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
unless($reqdata eq undef) {	unless($reqdata eq undef) {
Debug(9, "Queue gave request data: ".$reqdata->getRequest());	Debug(9, "Queue gave request data: ".$reqdata->getRequest());
&StartRequest($Socket, $reqdata);	&StartRequest($Socket, $reqdata);
Line 440 sub ClientWritable {	Line 527 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 496 sub CompleteTransaction {	Line 589 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());	LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
unlink $Transaction->getFile();	unlink $Transaction->getFile();
}	}
}	}
Line 520 sub StartClientReply {	Line 613 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 556 Parameters:	Line 650 Parameters:

sub FailTransaction {	sub FailTransaction {
my $transaction = shift;	my $transaction = shift;
	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 = $transcation->getClient();	my $client = $transaction->getClient();
Debug(1," Replying con_lost to ".$transaction->getRequest());	Debug(1," Replying con_lost to ".$transaction->getRequest());
StartClientReply($client, "con_lost\n");	StartClientReply($transaction, "con_lost\n");
	}
	if($ConnectionRetriesLeft <= 0) {
	Log("CRITICAL", "Host marked dead: ".GetServerHost());
}	}

}	}
Line 573 sub FailTransaction {	Line 671 sub FailTransaction {

=cut	=cut
sub EmptyQueue {	sub EmptyQueue {
	$ConnectionRetriesLeft--; # Counts as connection failure too.
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 587 Close all connections open on lond prior	Line 686 Close all connections open on lond prior

=cut	=cut
sub CloseAllLondConnections {	sub CloseAllLondConnections {
foreach $Socket (keys %ActiveConnections) {	foreach my $Socket (keys %ActiveConnections) {
KillSocket($Socket);	KillSocket($Socket);
}	}
}	}
Line 618 nonzero if we are allowed to create a ne	Line 717 nonzero if we are allowed to create a ne
sub KillSocket {	sub KillSocket {
my $Socket = shift;	my $Socket = shift;

	Log("WARNING", "Shutting down a socket");
$Socket->Shutdown();	$Socket->Shutdown();

# If the socket came from the active connection set,	# If the socket came from the active connection set,
Line 638 sub KillSocket {	Line 738 sub KillSocket {
# work queue, the work all gets failed with con_lost.	# work queue, the work all gets failed with con_lost.
#	#
if($ConnectionCount == 0) {	if($ConnectionCount == 0) {
EmptyQueue;	EmptyQueue();
}	}
}	}

Line 707 sub LondReadable {	Line 807 sub LondReadable {
my $Socket = $Watcher->data;	my $Socket = $Watcher->data;
my $client = undef;	my $client = undef;

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


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.

	Log("WARNING",
	"Lond connection lost.");
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
Debug(3,"Lond connection lost failing transaction");
FailTransaction($ActiveTransactions{$Socket});	FailTransaction($ActiveTransactions{$Socket});
}	}
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket);	KillSocket($Socket);
	$ConnectionRetriesLeft--; # Counts as connection failure
return;	return;
}	}
SocketDump(6,$Socket);	SocketDump(6,$Socket);
Line 757 sub LondReadable {	Line 862 sub LondReadable {
} 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.
	# Note that a trasition to idle indicates a live lond
	# on the other end so reset the connection retries.
	#
	$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
$Watcher->cancel();	$Watcher->cancel();
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
Debug(8,"Completing transaction!!");	Debug(8,"Completing transaction!!");
Line 869 sub LondWritable {	Line 978 sub LondWritable {
# We'll treat this as if the socket got disconnected:	# We'll treat this as if the socket got disconnected:
Log("WARNING", "Connection to ".$RemoteHost.	Log("WARNING", "Connection to ".$RemoteHost.
" has been disconnected");	" has been disconnected");
	FailTransaction($ActiveTransactions{$Socket});
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket);	KillSocket($Socket);
return;	return;
Line 968 sub QueueDelayed {	Line 1078 sub QueueDelayed {
Debug(4, "Delayed path: ".$path);	Debug(4, "Delayed path: ".$path);
opendir(DIRHANDLE, $path);	opendir(DIRHANDLE, $path);

@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;	my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
Debug(4, "Got ".$alldelayed." delayed files");
closedir(DIRHANDLE);	closedir(DIRHANDLE);
my $dfname;	my $dfname;
my $reqfile;	my $reqfile;
Line 979 sub QueueDelayed {	Line 1088 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 1011 sub MakeLondConnection {	Line 1120 sub MakeLondConnection {
$ConnectionRetriesLeft--;	$ConnectionRetriesLeft--;
return 0; # Failure.	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 1024 sub MakeLondConnection {	Line 1133 sub MakeLondConnection {
&Debug(9,"MakeLondConnection got socket: ".$Socket);	&Debug(9,"MakeLondConnection got socket: ".$Socket);
}	}

	$Connection->SetTimeoutCallback(\&SocketTimeout);
$event = Event->io(fd => $Socket,
	my $event = Event->io(fd => $Socket,
poll => 'w',	poll => 'w',
cb => \&LondWritable,	cb => \&LondWritable,
data => $Connection,	data => $Connection,
Line 1081 sub StartRequest {	Line 1191 sub StartRequest {
$ActiveTransactions{$Lond} = $Request;	$ActiveTransactions{$Lond} = $Request;

$Lond->InitiateTransaction($Request->getRequest());	$Lond->InitiateTransaction($Request->getRequest());
$event = Event->io(fd => $Socket,	my $event = Event->io(fd => $Socket,
poll => "w",	poll => "w",
cb => \&LondWritable,	cb => \&LondWritable,
data => $Lond,	data => $Lond,
Line 1123 sub QueueTransaction {	Line 1233 sub QueueTransaction {
Debug(8,"Must queue...");	Debug(8,"Must queue...");
$WorkQueue->enqueue($requestData);	$WorkQueue->enqueue($requestData);
if($ConnectionCount < $MaxConnectionCount) {	if($ConnectionCount < $MaxConnectionCount) {
Debug(4,"Starting additional lond connection");	if($ConnectionRetriesLeft > 0) {
MakeLondConnection();	Debug(4,"Starting additional lond connection");
	if(MakeLondConnection() == 0) {
	EmptyQueue(); # Fail transactions, can't make connection.
	}
	} else {
	ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
	EmptyQueue(); # It's worse than that ... he's dead Jim.
	}
}	}
} else { # Can start the request:	} else { # Can start the request:
Debug(8,"Can start...");	Debug(8,"Can start...");
Line 1282 sub SetupLoncListener {	Line 1399 sub SetupLoncListener {
fd => $socket);	fd => $socket);
}	}

	=pod

	=head2 ChildStatus

	Child USR1 signal handler to report the most recent status
	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;

	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";
	$ConnectionRetriesLeft = $ConnectionRetries;
	}

=pod	=pod

=head2 SignalledToDeath	=head2 SignalledToDeath
Line 1290 Called in response to a signal that caus	Line 1429 Called in response to a signal that caus

=cut	=cut

=pod

sub SignalledToDeath {	sub SignalledToDeath {
my ($signal) = @_;	my $event = shift;
	my $watcher= $event->w;

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

	}

	=head2 ToggleDebug

	This sub toggles trace debugging on and off.

	=cut

	sub ToggleDebug {
	my $Current = $DebugLevel;
	$DebugLevel = $NextDebugLevel;
	$NextDebugLevel = $Current;

	Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");

}	}

=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 1311 This sub implements a child process for	Line 1469 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} = \&SignalledToDeath;	#
$SIG{HUP} = IGNORE;
$SIG{USR1} = IGNORE;	Event->signal(signal => "QUIT",
$SIG{INT} = IGNORE;	cb => \&SignalledToDeath,
$SIG{CHLD} = IGNORE;	data => "QUIT");
$SIG{__DIE__} = \&SignalledToDeath;	Event->signal(signal => "HUP",
	cb => \&ChildStatus,
	data => "HUP");
	Event->signal(signal => "USR1",
	cb => \&ChildStatus,
	data => "USR1");
	Event->signal(signal => "INT",
	cb => \&ToggleDebug,
	data => "INT");

SetupTimer();	SetupTimer();

Line 1330 sub ChildProcess {	Line 1496 sub ChildProcess {

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

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


Debug(9,"Entering event loop");	Debug(9,"Entering event loop");
Line 1343 sub ChildProcess {	Line 1509 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;	my $pid = fork;
if($pid) { # Parent	if($pid) { # Parent
	$RemoteHost = "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 1386 if ($childpid != 0) {	Line 1559 if ($childpid != 0) {
#	#

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



if (POSIX::setsid() < 0) {	if (POSIX::setsid() < 0) {
print "Could not create new session\n";	print "Could not create new session\n";
exit -1;	exit -1;
Line 1403 Log("CRITICAL", "--------------- Startin	Line 1578 Log("CRITICAL", "--------------- Startin
my $HostIterator = LondConnection::GetHostIterator;	my $HostIterator = LondConnection::GetHostIterator;
while (! $HostIterator->end()) {	while (! $HostIterator->end()) {

$hostentryref = $HostIterator->get();	my $hostentryref = $HostIterator->get();
CreateChild($hostentryref->[0]);	CreateChild($hostentryref->[0]);
$HostIterator->next();	$HostIterator->next();
}	}
	$RemoteHost = "Parent Server";

# Maintain the population:	# Maintain the population:

Line 1415 ShowStatus("Parent keeping the flock");	Line 1591 ShowStatus("Parent keeping the flock");
#	#
# Set up parent signals:	# Set up parent signals:
#	#
$SIG{INT} = &KillThemAll;
$SIG{TERM} = &KillThemAll;	$SIG{INT} = \&Terminate;
	$SIG{TERM} = \&Terminate;
	$SIG{HUP} = \&Restart;
	$SIG{USR1} = \&CheckKids;

while(1) {	while(1) {
$deadchild = wait();	my $deadchild = wait();
if(exists $ChildHash{$deadchild}) { # need to restart.	if(exists $ChildHash{$deadchild}) { # need to restart.
$deadhost = $ChildHash{$deadchild};	my $deadhost = $ChildHash{$deadchild};
delete($ChildHash{$deadchild});	delete($ChildHash{$deadchild});
Log("WARNING","Lost child pid= ".$deadchild.	Log("WARNING","Lost child pid= ".$deadchild.
"Connected to host ".$deadhost);	"Connected to host ".$deadhost);
Line 1429 while(1) {	Line 1608 while(1) {
CreateChild($deadhost);	CreateChild($deadhost);
}	}
}	}



	=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 my $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
	SIGHUP. Responds to sigint and sigterm.

	=cut

sub KillThemAll {	sub KillThemAll {
	Debug(2, "Kill them all!!");
	local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
	foreach my $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 'QUIT' => $pid;
	delete($ChildHash{$pid});
	}
	my $execdir = $perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");

	}

	=pod

	=head1 Terminate

	Terminate the system.

	=cut

	sub Terminate {
	KillThemAll;
	Log("CRITICAL","Master process exiting");
	exit 0;

}	}
	=pod

=head1 Theory	=head1 Theory

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

Removed from v.1.10
changed lines
	Added in v.1.23