version 1.102, 2017/10/20 20:20:20
|
version 1.107, 2018/12/10 17:34:22
|
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 @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 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 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 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()); |
|
|
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 1281 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 1551 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 1563 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 GetServerPort |
=head2 GetServerPort |
|
|
Returns the lond port number. |
Returns the lond port number. |
Line 1652 sub SignalledToDeath {
|
Line 1705 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 1836 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) = @_; |
|
|
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 1851 sub CreateChild {
|
undef(@all_host_ids); |
undef(@all_host_ids); |
} else { # child. |
} else { # child. |
$RemoteHostId = $hostid; |
$RemoteHostId = $hostid; |
|
$RemoteDefHostId = $defhostid; |
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 1919 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 2027 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 2143 sub UpdateKids {
|
Line 2199 sub UpdateKids {
|
|
|
&KillThemAll(); |
&KillThemAll(); |
LondConnection->ResetReadConfig(); |
LondConnection->ResetReadConfig(); |
|
ShowStatus('Parent keeping the flock'); |
} |
} |
|
|
|
|
Line 2187 sub KillThemAll {
|
Line 2244 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 2206 sub really_kill_them_all_dammit
|
Line 2264 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 2234 sub Terminate {
|
Line 2293 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 2345 connection or died. This should be foll
|
Line 2451 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. |