loncom/loncnew - diff

Return to loncnew CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.98 and 1.109

version 1.98, 2011/06/17 10:26:26	version 1.109, 2020/01/12 01:21:33
Line 74 my %perlvar = %{$perlvarref};	Line 74 my %perlvar = %{$perlvarref};

my %ChildPid; # by pid -> host.	my %ChildPid; # by pid -> host.
my %ChildHost; # by host.	my %ChildHost; # by host.
	my %ChildKeyMode; # by pid -> keymode
my %listening_to; # Socket->host table for who the parent	my %listening_to; # Socket->host table for who the parent
# is listening to.	# is listening to.
my %parent_dispatchers; # host-> listener watcher events.	my %parent_dispatchers; # host-> listener watcher events.
Line 93 my $executable = $0; # Get the full	Line 94 my $executable = $0; # Get the full
#	#
# 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; # Hostname of host child is talking to.
my $RemoteHostId; # default lonid of host child is talking to.	my $RemoteHostId; # lonid of host child is talking to.
	my $RemoteDefHostId; # default lonhostID of host child is talking to.
	my $RemoteLoncapaRev; # LON-CAPA version of host child is talking to.
my @all_host_ids;	my @all_host_ids;
my $UnixSocketDir= $perlvar{'lonSockDir'};	my $UnixSocketDir= $perlvar{'lonSockDir'};
my $IdleConnections = Stack->new(); # Set of idle connections	my $IdleConnections = Stack->new(); # Set of idle connections
Line 669 Parameters:	Line 672 Parameters:
=item client	=item client

The LondTransaction we are failing.	The LondTransaction we are failing.


=cut	=cut

Line 741 Parameters:	Line 743 Parameters:

The socket to kill off.	The socket to kill off.

=item Restart	=item restart

non-zero if we are allowed to create a new connection.	non-zero if we are allowed to create a new connection.

Line 749 non-zero if we are allowed to create a n	Line 751 non-zero if we are allowed to create a n

sub KillSocket {	sub KillSocket {
my $Socket = shift;	my $Socket = shift;
	my $restart = shift;

Log("WARNING", "Shutting down a socket");	Log("WARNING", "Shutting down a socket");
$Socket->Shutdown();	$Socket->Shutdown();
Line 765 sub KillSocket {	Line 768 sub KillSocket {
if(exists($ActiveConnections{$Socket})) {	if(exists($ActiveConnections{$Socket})) {
$ActiveConnections{$Socket}->cancel;	$ActiveConnections{$Socket}->cancel;
delete($ActiveConnections{$Socket});	delete($ActiveConnections{$Socket});
$ConnectionCount--;	# Decrement ConnectionCount unless we will immediately
	# re-connect (i.e., $restart is true), because this was
	# a connection where the SSL channel for exchange of the
	# shared key failed, and we may use an insecure channel.
	unless ($restart) {
	$ConnectionCount--;
	}
if ($ConnectionCount < 0) { $ConnectionCount = 0; }	if ($ConnectionCount < 0) { $ConnectionCount = 0; }
}	}
# If the connection count has gone to zero and there is work in the	# If the connection count has gone to zero and there is work in the
# 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) {
$LondConnecting = 0; # No connections so also not connecting.	$LondConnecting = 0; # No connections so also not connecting.
EmptyQueue();	EmptyQueue();
CloseAllLondConnections; # Should all already be closed but...	CloseAllLondConnections(); # Should all already be closed but...
	&clear_childpid($$);
}	}
UpdateStatus();	UpdateStatus();
}	}
Line 788 is readable. The action is state depend	Line 799 is readable. The action is state depend

=head3 State=Initialized	=head3 State=Initialized

We're waiting for the challenge, this is a no-op until the	We are waiting for the challenge, this is a no-op until the
state changes.	state changes.

=head3 State=Challenged	=head3 State=Challenged
Line 825 The the key has been requested, now we a	Line 836 The the key has been requested, now we a

The encryption key has been negotiated or we have finished	The encryption key has been negotiated or we have finished
reading data from the a transaction. If the callback data have	reading data from the a transaction. If the callback data have
a client as well as the socket nformation, then we are	a client as well as the socket information, then we are
doing a transaction and the data received are relayed to the client	doing a transaction and the data received are relayed to the client
before the socket is put on the idle list.	before the socket is put on the idle list.

Line 871 sub LondReadable {	Line 882 sub LondReadable {

Log("WARNING",	Log("WARNING",
"Lond connection lost.");	"Lond connection lost.");
	my $state_on_exit = $Socket->GetState();
if(exists($ActiveTransactions{$Socket})) {	if(exists($ActiveTransactions{$Socket})) {
FailTransaction($ActiveTransactions{$Socket});	FailTransaction($ActiveTransactions{$Socket});
} else {	} else {
# Socket is connecting and failed... need to mark	# Socket is connecting and failed... need to mark
# no longer connecting.	# no longer connecting.

$LondConnecting = 0;	$LondConnecting = 0;
}	}
$Watcher->cancel();	$Watcher->cancel();
KillSocket($Socket);	if ($state_on_exit eq 'ReInitNoSSL') {
$ConnectionRetriesLeft--; # Counts as connection failure	# SSL certificate verification failed, and insecure connection
	# allowed. Send restart arg to KillSocket(), so EmptyQueue()
	# is not called, as we still hope to process queued request.

	KillSocket($Socket,1);

	# Re-initiate creation of Lond Connection for use with queued
	# request.

	ShowStatus("Connected to ".$RemoteHost);
	Log("WARNING","No SSL channel (verification failed), will try with insecure channel");
	&MakeLondConnection(1);

	} else {
	KillSocket($Socket);
	$ConnectionRetriesLeft--; # Counts as connection failure
	}
return;	return;
}	}
SocketDump(6,$Socket);	SocketDump(6,$Socket);
Line 892 sub LondReadable {	Line 919 sub LondReadable {
if($State eq "Initialized") {	if($State eq "Initialized") {


	} elsif ($State eq "ReInitNoSSL") {

} elsif ($State eq "ChallengeReceived") {	} elsif ($State eq "ChallengeReceived") {
# The challenge must be echoed back; The state machine	# The challenge must be echoed back; The state machine
# in the connection takes care of setting that up. Just	# in the connection takes care of setting that up. Just
Line 928 sub LondReadable {	Line 957 sub LondReadable {
} elsif ($State eq "ReceivingKey") {	} elsif ($State eq "ReceivingKey") {

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

	if ($ConnectionCount == 1) {
	# Write child Pid file to keep track of ssl and insecure
	# connections

	&record_childpid($Socket);
	}

# This is as good a spot as any to get the peer version	# This is as good a spot as any to get the peer version
# string:	# string:

Line 986 event. The action taken is very state d	Line 1022 event. The action taken is very state d
=head3 State = Connected	=head3 State = Connected

The connection is in the process of sending the 'init' hailing to the	The connection is in the process of sending the 'init' hailing to the
lond on the remote end. The connection object's Writable member is	lond on the remote end. The Writable member of the connection object
called. On error, ConnectionError is called to destroy the connection	is called. On error, call ConnectionError to destroy the connection
and remove it from the ActiveConnections hash	and remove it from the ActiveConnections hash.

=head3 Initialized	=head3 Initialized

Line 1093 sub LondWritable {	Line 1129 sub LondWritable {

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

	} elsif ($State eq "ReInitNoSSL") {

} elsif ($State eq "ChallengeReceived") {	} elsif ($State eq "ChallengeReceived") {
# We received the challenge, now we	# We received the challenge, now we
# are echoing it back. This is a no-op,	# are echoing it back. This is a no-op,
Line 1204 start off on it.	Line 1242 start off on it.

=cut	=cut

sub MakeLondConnection {	sub MakeLondConnection {
	my ($restart) = @_;
Debug(4,"MakeLondConnection to ".GetServerHost()." on port "	Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
.GetServerPort());	.GetServerPort());

my $Connection = LondConnection->new(&GetServerHost(),	my $Connection = LondConnection->new(&GetServerHost(),
&GetServerPort(),	&GetServerPort(),
&GetHostId());	&GetHostId(),
	&GetDefHostId(),
	&GetLoncapaRev());

if($Connection eq undef) {	if($Connection eq undef) {
Log("CRITICAL","Failed to make a connection with lond.");	Log("CRITICAL","Failed to make a connection with lond.");
$ConnectionRetriesLeft--;	$ConnectionRetriesLeft--;
return 0; # Failure.	return 0; # Failure.
} else {	} else {

$LondConnecting = 1; # Connection in progress.	$LondConnecting = 1; # Connection in progress.
# 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
Line 1242 sub MakeLondConnection {	Line 1282 sub MakeLondConnection {
if ($ConnectionCount == 0) {	if ($ConnectionCount == 0) {
&SetupTimer; # Need to handle timeouts with connections...	&SetupTimer; # Need to handle timeouts with connections...
}	}
$ConnectionCount++;	unless ($restart) {
	$ConnectionCount++;
	}
$Connection->SetClientData($ConnectionCount);	$Connection->SetClientData($ConnectionCount);
Debug(4, "Connection count = ".$ConnectionCount);	Debug(4, "Connection count = ".$ConnectionCount);
if($ConnectionCount == 1) { # First Connection:	if($ConnectionCount == 1) { # First Connection:
Line 1510 sub GetServerHost {	Line 1552 sub GetServerHost {

=pod	=pod

=head2 GetServerId	=head2 GetHostId

Returns the hostid whose lond we talk with.	Returns the hostid whose lond we talk with.

Line 1522 sub GetHostId {	Line 1564 sub GetHostId {

=pod	=pod

	=head2 GetDefHostId

	Returns the default hostid for the node whose lond we talk with.

	=cut

	sub GetDefHostId { # Setup by the fork.
	return $RemoteDefHostId;
	}

	=pod

	=head2 GetLoncapaRev

	Returns the LON-CAPA version for the node whose lond we talk with.

	=cut

	sub GetLoncapaRev {
	return $RemoteLoncapaRev; # Setup by the fork.
	}

	=pod

=head2 GetServerPort	=head2 GetServerPort

Returns the lond port number.	Returns the lond port number.
Line 1539 sub GetServerPort {	Line 1605 sub GetServerPort {
Setup a lonc listener event. The event is called when the socket	Setup a lonc listener event. The event is called when the socket
becomes readable.. that corresponds to the receipt of a new	becomes readable.. that corresponds to the receipt of a new
connection. The event handler established will accept the connection	connection. The event handler established will accept the connection
(creating a communcations channel), that in turn will establish	(creating a communications channel), that in turn will establish
another event handler to subess requests.	another event handler to subess requests.

=head2 Parameters:	=head2 Parameters:
Line 1652 sub SignalledToDeath {	Line 1718 sub SignalledToDeath {
."died through "."\"$signal\"");	."died through "."\"$signal\"");
#LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "	#LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
# ."\"$signal\"");	# ."\"$signal\"");
	&clear_childpid($$);
exit 0;	exit 0;

}	}
Line 1782 sub ChildProcess {	Line 1849 sub ChildProcess {
# Create a new child for host passed in:	# Create a new child for host passed in:

sub CreateChild {	sub CreateChild {
my ($host, $hostid) = @_;	my ($host, $hostid, $defhostid, $loncaparev) = @_;

my $sigset = POSIX::SigSet->new(SIGINT);	my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);	sigprocmask(SIG_BLOCK, $sigset);
Line 1797 sub CreateChild {	Line 1864 sub CreateChild {
undef(@all_host_ids);	undef(@all_host_ids);
} else { # child.	} else { # child.
$RemoteHostId = $hostid;	$RemoteHostId = $hostid;
	$RemoteDefHostId = $defhostid;
	$RemoteLoncapaRev = $loncaparev;
ShowStatus("Connected to ".$RemoteHost);	ShowStatus("Connected to ".$RemoteHost);
$SIG{INT} = 'DEFAULT';	$SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);	sigprocmask(SIG_UNBLOCK, $sigset);
Line 1864 sub get_remote_hostname {	Line 1933 sub get_remote_hostname {
(my $hostname,my $lonid,@all_host_ids) = split(':',$data);	(my $hostname,my $lonid,@all_host_ids) = split(':',$data);
$ChildHost{$hostname}++;	$ChildHost{$hostname}++;
if ($ChildHost{$hostname} == 1) {	if ($ChildHost{$hostname} == 1) {
&CreateChild($hostname,$lonid);	&CreateChild($hostname,$lonid,$all_host_ids[-1]);
} else {	} else {
&Log('WARNING',"Request for a second child on $hostname");	&Log('WARNING',"Request for a second child on $hostname");
}	}
Line 1972 sub server_died {	Line 2041 sub server_died {
my $host = $ChildPid{$pid};	my $host = $ChildPid{$pid};
if($host) { # It's for real...	if($host) { # It's for real...
&Debug(9, "Caught sigchild for $host");	&Debug(9, "Caught sigchild for $host");
	&clear_childpid($pid);
delete($ChildPid{$pid});	delete($ChildPid{$pid});
delete($ChildHost{$host});	delete($ChildHost{$host});
&parent_clean_up($host);	&parent_clean_up($host);
Line 2142 sub UpdateKids {	Line 2212 sub UpdateKids {
# (lost unless they are critical).	# (lost unless they are critical).

&KillThemAll();	&KillThemAll();
	LondConnection->ResetReadConfig();
	ShowStatus('Parent keeping the flock');
}	}


Line 2157 the config file.	Line 2229 the config file.

sub Restart {	sub Restart {
&KillThemAll; # First kill all the children.	&KillThemAll; # First kill all the children.
	LondConnection->ResetReadConfig();
Log("CRITICAL", "Restarting");	Log("CRITICAL", "Restarting");
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");	unlink("$execdir/logs/lonc.pid");
Line 2185 sub KillThemAll {	Line 2258 sub KillThemAll {
ShowStatus("Nicely Killing lonc for $serving pid = $pid");	ShowStatus("Nicely Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");	Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
kill 'QUIT' => $pid;	kill 'QUIT' => $pid;
	&clear_childpid($pid);
}	}
ShowStatus("Finished killing child processes off.");	ShowStatus("Finished killing child processes off.");
}	}
Line 2204 sub really_kill_them_all_dammit	Line 2278 sub really_kill_them_all_dammit
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");	Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
kill 'KILL' => $pid;	kill 'KILL' => $pid;
delete($ChildPid{$pid});	delete($ChildPid{$pid});
	delete($ChildKeyMode{$pid});
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");	unlink("$execdir/logs/lonc.pid");
}	}
Line 2232 sub Terminate {	Line 2307 sub Terminate {

}	}

	=pod

	=cut

sub my_hostname {	sub my_hostname {
use Sys::Hostname;	use Sys::Hostname::FQDN();
my $name = &hostname();	my $name = Sys::Hostname::FQDN::fqdn();
&Debug(9,"Name is $name");	&Debug(9,"Name is $name");
return $name;	return $name;
}	}

	sub record_childpid {
	my ($Socket) = @_;
	my $docdir = $perlvar{'lonDocRoot'};
	my $authmode = $Socket->GetKeyMode();
	my $peer = $Socket->PeerLoncapaHim();
	if (($authmode eq 'ssl') \|\| ($authmode eq 'insecure')) {
	my $childpid = $$;
	if ($childpid) {
	unless (exists($ChildKeyMode{$childpid})) {
	$ChildKeyMode{$childpid} = $authmode;
	}
	if (-d "$docdir/lon-status/loncchld") {
	unless (-e "$docdir/lon-status/loncchld/$childpid") {
	if (open (my $pidfh,'>',"$docdir/lon-status/loncchld/$childpid")) {
	print $pidfh "$peer:$authmode\n";
	close($pidfh);
	}
	}
	}
	}
	}
	return;
	}

	sub clear_childpid {
	my ($childpid) = @_;
	my $docdir = $perlvar{'lonDocRoot'};
	if (-d "$docdir/lon-status/loncchld") {
	if ($childpid =~ /^\d+$/) {
	if (($ChildKeyMode{$childpid} eq 'insecure') \|\|
	($ChildKeyMode{$childpid} eq 'ssl')) {
	if (-e "$docdir/lon-status/loncchld/$childpid") {
	unlink("$docdir/lon-status/loncchld/$childpid");
	}
	}
	}
	}
	if (exists($ChildKeyMode{$childpid})) {
	delete($ChildKeyMode{$childpid});
	}
	return;
	}

=pod	=pod

=head1 Theory	=head1 Theory
Line 2343 connection or died. This should be foll	Line 2465 connection or died. This should be foll

"WARNING Failing transaction..." msgs for each in-flight or queued transaction.	"WARNING Failing transaction..." msgs for each in-flight or queued transaction.

	=item WARNING No SSL channel (verification failed), will try with insecure channel.

	Called when promotion of a socket to SSL failed because SSL certificate verification failed.
	Domain configuration must also permit insecure channel use for key exchange. Connection
	negotiation will start again from the beginning, but with Authentication Mode not set to ssl.

=item INFO Connected to lond version: <version>	=item INFO Connected to lond version: <version>

When connection negotiation is complete, the lond version is requested and logged here.	When connection negotiation is complete, the lond version is requested and logged here.

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

Removed from v.1.98
changed lines
	Added in v.1.109