|
version 1.89, 2010/06/14 13:29:27
|
version 1.110, 2024/06/14 18:49:41
|
|
Line 26
|
Line 26
|
| # http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
| # |
# |
| # |
# |
| # new lonc handles n request out bver m connections to londs. |
# new lonc handles n request out over 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 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 85 my $ClientConnection = 0; # Uniquifier f
|
Line 86 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= 7200; # Wait two hours before pruning connections. |
my $IdleTimeout= 5*60; # Seconds to wait prior to pruning connections. |
| |
|
| my $LogTransactions = 0; # When True, all transactions/replies get logged. |
my $LogTransactions = 0; # When True, all transactions/replies get logged. |
| my $executable = $0; # Get the full path to me. |
my $executable = $0; # Get the full path to me. |
|
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, |
| |
# if 2.12.0 or newer, format: X.Y.Z |
| 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 349 sub child_exit {
|
Line 353 sub child_exit {
|
| |
|
| =head2 Tick |
=head2 Tick |
| |
|
| Invoked each timer tick. |
Invoked each timer tick. |
| |
|
| =cut |
=cut |
| |
|
|
Line 441 Trigger disconnections of idle sockets.
|
Line 445 Trigger disconnections of idle sockets.
|
| |
|
| sub SetupTimer { |
sub SetupTimer { |
| Debug(6, "SetupTimer"); |
Debug(6, "SetupTimer"); |
| Event->timer(interval => 1, cb => \&Tick ); |
Event->timer(interval => 1, cb => \&Tick, |
| |
hard => 1); |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 487 sub ServerToIdle {
|
Line 492 sub ServerToIdle {
|
| |
|
| Event callback for when a client socket is writable. |
Event callback for when a client socket is writable. |
| |
|
| This callback is established when a transaction reponse is |
This callback is established when a transaction response is |
| avaiable from lond. The response is forwarded to the unix socket |
available from lond. The response is forwarded to the unix socket |
| as it becomes writable in this sub. |
as it becomes writable in this sub. |
| |
|
| Parameters: |
Parameters: |
|
Line 558 sub ClientWritable {
|
Line 563 sub ClientWritable {
|
| if($errno == POSIX::EWOULDBLOCK || |
if($errno == POSIX::EWOULDBLOCK || |
| $errno == POSIX::EAGAIN || |
$errno == POSIX::EAGAIN || |
| $errno == POSIX::EINTR) { |
$errno == POSIX::EINTR) { |
| # No action taken? |
# No action taken...the socket will be writable firing the event again |
| |
# which will result in a retry of the write. |
| } else { # Unanticipated errno. |
} else { # Unanticipated errno. |
| &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); |
&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); |
| $Watcher->cancel; # Stop the watcher. |
$Watcher->cancel; # Stop the watcher. |
|
Line 587 Parameters:
|
Line 593 Parameters:
|
| |
|
| =item Socket |
=item Socket |
| |
|
| Socket on which the lond transaction occured. This is a |
Socket on which the lond transaction occurred. This is a |
| LondConnection. The data received is in the TransactionReply member. |
LondConnection. The data received are in the TransactionReply member. |
| |
|
| =item Transaction |
=item Transaction |
| |
|
|
Line 628 sub CompleteTransaction {
|
Line 634 sub CompleteTransaction {
|
| |
|
| =item data |
=item data |
| |
|
| The data to send to apached client. |
The data to send to apache client. |
| |
|
| =cut |
=cut |
| |
|
|
Line 667 Parameters:
|
Line 673 Parameters:
|
| =item client |
=item client |
| |
|
| The LondTransaction we are failing. |
The LondTransaction we are failing. |
| |
|
| |
|
| =cut |
=cut |
| |
|
|
Line 739 Parameters:
|
Line 744 Parameters:
|
| |
|
| The socket to kill off. |
The socket to kill off. |
| |
|
| =item Restart |
=item restart |
| |
|
| nonzero if we are allowed to create a new connection. |
non-zero if we are allowed to create a new connection. |
| |
|
| =cut |
=cut |
| |
|
| 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 761 sub KillSocket {
|
Line 767 sub KillSocket {
|
| delete ($ActiveTransactions{$Socket}); |
delete ($ActiveTransactions{$Socket}); |
| } |
} |
| if(exists($ActiveConnections{$Socket})) { |
if(exists($ActiveConnections{$Socket})) { |
| |
$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. |
| EmptyQueue(); |
EmptyQueue(); |
| CloseAllLondConnections; # Should all already be closed but... |
CloseAllLondConnections(); # Should all already be closed but... |
| |
&clear_childpid($$); |
| } |
} |
| |
UpdateStatus(); |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 783 is readable. The action is state depend
|
Line 800 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 793 The connection must echo the challenge b
|
Line 810 The connection must echo the challenge b
|
| |
|
| =head3 State=ChallengeReplied |
=head3 State=ChallengeReplied |
| |
|
| The challenge has been replied to. The we are receiveing the |
The challenge has been replied to. Then we are receiving the |
| 'ok' from the partner. |
'ok' from the partner. |
| |
|
| =head3 State=ReadingVersionString |
=head3 State=ReadingVersionString |
|
Line 819 The the key has been requested, now we a
|
Line 836 The the key has been requested, now we a
|
| =head3 State=Idle |
=head3 State=Idle |
| |
|
| 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 has |
reading data from the a transaction. If the callback data have |
| a client as well as the socket iformation, then we are |
a client as well as the socket information, then we are |
| doing a transaction and the data received is 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. |
| |
|
| =head3 State=SendingRequest |
=head3 State=SendingRequest |
|
Line 838 to readable to receive the reply.
|
Line 855 to readable to receive the reply.
|
| The parameter to this function are: |
The parameter to this function are: |
| |
|
| The event. Implicit in this is the watcher and its data. The data |
The event. Implicit in this is the watcher and its data. The data |
| contains at least the lond connection object and, if a |
contain at least the lond connection object and, if a |
| transaction is in progress, the socket attached to the local client. |
transaction is in progress, the socket attached to the local client. |
| |
|
| =cut |
=cut |
|
Line 866 sub LondReadable {
|
Line 883 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 887 sub LondReadable {
|
Line 920 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 923 sub LondReadable {
|
Line 958 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 943 sub LondReadable {
|
Line 985 sub LondReadable {
|
| CompleteTransaction($Socket, |
CompleteTransaction($Socket, |
| $ActiveTransactions{$Socket}); |
$ActiveTransactions{$Socket}); |
| } else { |
} else { |
| Log("SUCCESS", "Connection ".$ConnectionCount." to " |
my $count = $Socket->GetClientData(); |
| |
Log("SUCCESS", "Connection ".$count." to " |
| .$RemoteHost." now ready for action"); |
.$RemoteHost." now ready for action"); |
| } |
} |
| ServerToIdle($Socket); # Next work unit or idle. |
ServerToIdle($Socket); # Next work unit or idle. |
|
Line 980 event. The action taken is very state d
|
Line 1023 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 1087 sub LondWritable {
|
Line 1130 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 1191 sub QueueDelayed {
|
Line 1236 sub QueueDelayed {
|
| =head2 MakeLondConnection |
=head2 MakeLondConnection |
| |
|
| Create a new lond connection object, and start it towards its initial |
Create a new lond connection object, and start it towards its initial |
| idleness. Once idle, it becomes elligible to receive transactions |
idleness. Once idle, it becomes eligible to receive transactions |
| from the work queue. If the work queue is not empty when the |
from the work queue. If the work queue is not empty when the |
| connection is completed and becomes idle, it will dequeue an entry and |
connection is completed and becomes idle, it will dequeue an entry and |
| start off on it. |
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) { # Needs to be more robust later. |
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 1236 sub MakeLondConnection {
|
Line 1283 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); |
| Debug(4, "Connection count = ".$ConnectionCount); |
Debug(4, "Connection count = ".$ConnectionCount); |
| if($ConnectionCount == 1) { # First Connection: |
if($ConnectionCount == 1) { # First Connection: |
| QueueDelayed; |
QueueDelayed; |
| } |
} |
| Log("SUCESS", "Created connection ".$ConnectionCount |
Log("SUCCESS", "Created connection ".$ConnectionCount |
| ." to host ".GetServerHost()); |
." to host ".GetServerHost()); |
| return 1; # Return success. |
return 1; # Return success. |
| } |
} |
|
Line 1262 reply.
|
Line 1312 reply.
|
| |
|
| =item $Client |
=item $Client |
| |
|
| Connection to the client that is making this request We got the |
Connection to the client that is making this request. We got the |
| request from this socket, and when the request has been relayed to |
request from this socket, and when the request has been relayed to |
| lond and we get a reply back from lond it will get sent to this |
lond and we get a reply back from lond it will get sent to this |
| socket. |
socket. |
|
Line 1348 sub QueueTransaction {
|
Line 1398 sub QueueTransaction {
|
| } |
} |
| } |
} |
| |
|
| #-------------------------- Lonc UNIX socket handling --------------------- |
#-------------------------- Lonc UNIX socket handling ------------------- |
| |
|
| =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 1452 sub accept_client {
|
Line 1502 sub accept_client {
|
| Callback that is called when a connection is received on the unix |
Callback that is called when a connection is received on the unix |
| socket for a new client of lonc. The callback is parameterized by the |
socket for a new client of lonc. The callback is parameterized by the |
| event.. which is a-priori assumed to be an io event, and therefore has |
event.. which is a-priori assumed to be an io event, and therefore has |
| an fd member that is the Listener socket. We Accept the connection |
an fd member that is the Listener socket. We accept the connection |
| and register a new event on the readability of that socket: |
and register a new event on the readability of that socket: |
| |
|
| =cut |
=cut |
|
Line 1503 sub GetServerHost {
|
Line 1553 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 1515 sub GetHostId {
|
Line 1565 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 1532 sub GetServerPort {
|
Line 1606 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 int 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 1645 sub SignalledToDeath {
|
Line 1719 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 1672 sub ToggleDebug {
|
Line 1747 sub ToggleDebug {
|
| |
|
| This sub implements a child process for a single lonc daemon. |
This sub implements a child process for a single lonc daemon. |
| Optional parameter: |
Optional parameter: |
| $socket - if provided, this is a socket already open for listen |
$socket - if provided, this is a socket already open for listening |
| on the client socket. Otherwise, a new listen is set up. |
on the client socket. Otherwise, a new listener is set up. |
| |
|
| =cut |
=cut |
| |
|
|
Line 1730 sub ChildProcess {
|
Line 1805 sub ChildProcess {
|
| cb => \&ToggleDebug, |
cb => \&ToggleDebug, |
| data => "INT"); |
data => "INT"); |
| |
|
| |
# Block the pipe signal we'll get when the socket disconnects. We detect |
| |
# socket disconnection via send/receive failures. On disconnect, the |
| |
# socket becomes readable .. which will force the disconnect detection. |
| |
|
| |
my $set = POSIX::SigSet->new(SIGPIPE); |
| |
sigprocmask(SIG_BLOCK, $set); |
| |
|
| # Figure out if we got passed a socket or need to open one to listen for |
# Figure out if we got passed a socket or need to open one to listen for |
| # client requests. |
# client requests. |
| |
|
|
Line 1768 sub ChildProcess {
|
Line 1850 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); |
| $RemoteHost = $host; |
$RemoteHost = $host; |
| |
ShowStatus('Parent keeping the flock'); # Update time in status message. |
| Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
| my $pid = fork; |
my $pid = fork; |
| if($pid) { # Parent |
if($pid) { # Parent |
|
Line 1782 sub CreateChild {
|
Line 1865 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 1847 sub get_remote_hostname {
|
Line 1932 sub get_remote_hostname {
|
| |
|
| &Debug(5,"Creating child for $data (parent_client_connection)"); |
&Debug(5,"Creating child for $data (parent_client_connection)"); |
| (my $hostname,my $lonid,@all_host_ids) = split(':',$data); |
(my $hostname,my $lonid,@all_host_ids) = split(':',$data); |
| |
my $remotelcrev; |
| |
if ((scalar(@all_host_ids) > 1) && ($all_host_ids[0] =~ /^\d+\.\d+\.[\w.]+$/)) { |
| |
$remotelcrev = shift(@all_host_ids); |
| |
} |
| $ChildHost{$hostname}++; |
$ChildHost{$hostname}++; |
| if ($ChildHost{$hostname} == 1) { |
if ($ChildHost{$hostname} == 1) { |
| &CreateChild($hostname,$lonid); |
&CreateChild($hostname,$lonid,$all_host_ids[-1],$remotelcrev); |
| } else { |
} else { |
| &Log('WARNING',"Request for a second child on $hostname"); |
&Log('WARNING',"Request for a second child on $hostname"); |
| } |
} |
|
Line 1957 sub server_died {
|
Line 2046 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 2065 die "Main Event loop exited: $ret";
|
Line 2155 die "Main Event loop exited: $ret";
|
| =head1 CheckKids |
=head1 CheckKids |
| |
|
| Since kids do not die as easily in this implementation |
Since kids do not die as easily in this implementation |
| as the previous one, there is no need to restart the |
as the previous one, there is no need to restart the |
| dead ones (all dead kids get restarted when they die!!) |
dead ones (all dead kids get restarted when they die!!) |
| The only thing this function does is to pass USR1 to the |
The only thing this function does is to pass USR1 to the |
| kids so that they report their status. |
kids so that they report their status. |
|
Line 2127 sub UpdateKids {
|
Line 2217 sub UpdateKids {
|
| # (lost unless they are critical). |
# (lost unless they are critical). |
| |
|
| &KillThemAll(); |
&KillThemAll(); |
| |
LondConnection->ResetReadConfig(); |
| |
ShowStatus('Parent keeping the flock'); |
| } |
} |
| |
|
| |
|
|
Line 2135 sub UpdateKids {
|
Line 2227 sub UpdateKids {
|
| =head1 Restart |
=head1 Restart |
| |
|
| Signal handler for HUP... all children are killed and |
Signal handler for HUP... all children are killed and |
| we self restart. This is an el-cheapo way to re read |
we self restart. This is an el-cheapo way to re-read |
| the config file. |
the config file. |
| |
|
| =cut |
=cut |
| |
|
| 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 2170 sub KillThemAll {
|
Line 2263 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 2189 sub really_kill_them_all_dammit
|
Line 2283 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 2217 sub Terminate {
|
Line 2312 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 2281 If there are pending transactions in the
|
Line 2423 If there are pending transactions in the
|
| they are failed (saved if critical). If the connection |
they are failed (saved if critical). If the connection |
| retry count gets exceeded by this, the |
retry count gets exceeded by this, the |
| remote host is marked as dead. |
remote host is marked as dead. |
| Called when timeouts occured during the connection and |
Called when timeouts occurred during the connection and |
| connection dialog with a remote host. |
connection dialog with a remote host. |
| |
|
| =item Critical Host makred DEAD <hostname> |
=item Critical Host makred DEAD <hostname> |
|
Line 2328 connection or died. This should be foll
|
Line 2470 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. |
|
Line 2408 the event processing loop is entered.
|
Line 2556 the event processing loop is entered.
|
| =item INFO Updating connections via SIGUSR2 |
=item INFO Updating connections via SIGUSR2 |
| |
|
| SIGUSR2 received. The original code would kill all clients, re-read the host file, |
SIGUSR2 received. The original code would kill all clients, re-read the host file, |
| then restart children for each host. Now that childrean aree started on demand, this |
then restart children for each host. Now that children are started on demand, this |
| just kills all child processes and lets requests start them as needed again. |
just kills all child processes and lets requests start them as needed again. |
| |
|
| |
|
|
Line 2419 SigHUP received. all the children are k
|
Line 2567 SigHUP received. all the children are k
|
| =item CRITICAL Nicely killing lonc for host pid = <pid> |
=item CRITICAL Nicely killing lonc for host pid = <pid> |
| |
|
| Attempting to kill the child that is serving the specified host (pid given) cleanly via |
Attempting to kill the child that is serving the specified host (pid given) cleanly via |
| SIGQUIT The child should handle that, clean up nicely and exit. |
SIGQUIT. The child should handle that, clean up nicely and exit. |
| |
|
| =item CRITICAL Nastily killing lonc for host pid = <pid> |
=item CRITICAL Nastily killing lonc for host pid = <pid> |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to loncnew CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom