--- loncom/loncnew 2003/04/24 10:56:55 1.4 +++ loncom/loncnew 2003/07/02 01:12:35 1.12 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.4 2003/04/24 10:56:55 foxr Exp $ +# $Id: loncnew,v 1.12 2003/07/02 01:12:35 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -34,30 +34,63 @@ # - Add timer dispatch. (done) # - Add ability to accept lonc UNIX domain sockets. (done) # - Add ability to create/negotiate lond connections (done). -# - Add general logic for dispatching requests and timeouts. -# - Add support for the lonc/lond requests. +# - Add general logic for dispatching requests and timeouts. (done). +# - Add support for the lonc/lond requests. (done). # - Add logging/status monitoring. # - Add Signal handling - HUP restarts. USR1 status report. -# - Add Configuration file I/O -# - Add Pending request processing on startup. +# - Add Configuration file I/O (done). # - Add management/status request interface. +# - Add deferred request capability. (done) +# - Detect transmission timeouts. +# + +# Change log: +# $Log: loncnew,v $ +# Revision 1.12 2003/07/02 01:12:35 foxr +# - Add some debugging to killthemall +# - Add better error handling to LondReadable +# - Remove tick logging in the timer handler. +# +# 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 +# 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 +# going or else 6the client will permanently give up on dead servers. +# +# Revision 1.9 2003/06/13 02:38:43 foxr +# Add logging in 'expected format' +# +# Revision 1.8 2003/06/11 02:04:35 foxr +# Support delayed transactions... this is done uniformly by encapsulating +# transactions in an object ... a LondTransaction that is implemented by +# LondTransaction.pm +# +# Revision 1.7 2003/06/03 01:59:39 foxr +# complete coding to support deferred transactions. +# +# use lib "/home/httpd/lib/perl/"; use lib "/home/foxr/newloncapa/types"; use Event qw(:DEFAULT ); use POSIX qw(:signal_h); +use POSIX; use IO::Socket; use IO::Socket::INET; use IO::Socket::UNIX; +use IO::File; +use IO::Handle; use Socket; use Crypt::IDEA; use LONCAPA::Queue; use LONCAPA::Stack; use LONCAPA::LondConnection; +use LONCAPA::LondTransaction; use LONCAPA::Configuration; use LONCAPA::HashIterator; -print "Loncnew starting\n"; # # Disable all signals we might receive from outside for now. @@ -82,10 +115,10 @@ my %perlvar = %{$perlvarref}; my %ChildHash; # by pid -> host. -my $MaxConnectionCount = 5; # Will get from config later. +my $MaxConnectionCount = 10; # Will get from config later. my $ClientConnection = 0; # Uniquifier for client events. -my $DebugLevel = 5; +my $DebugLevel = 0; my $IdleTimeout= 3600; # Wait an hour before pruning connections. # @@ -95,14 +128,93 @@ my $RemoteHost; # Name of host child i my $UnixSocketDir= "/home/httpd/sockets"; my $IdleConnections = Stack->new(); # Set of idle connections my %ActiveConnections; # Connections to the remote lond. -my %ActiveTransactions; # Transactions in flight. +my %ActiveTransactions; # LondTransactions in flight. my %ActiveClients; # Serial numbers of active clients by socket. my $WorkQueue = Queue->new(); # Queue of pending transactions. -my $ClientQueue = Queue->new(); # Queue of clients causing xactinos. my $ConnectionCount = 0; my $IdleSeconds = 0; # Number of seconds idle. +my $Status = ""; # Current status string. +my $ConnectionRetries=5; # Number of connection retries allowed. +my $ConnectionRetriesLeft=5; # Number of connection retries remaining. # +# The hash below gives the HTML format for log messages +# given a severity. +# +my %LogFormats; + +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"DEFAULT"} = " %s "; + + + +=pod + +=head2 LogPerm + +Makes an entry into the permanent log file. + +=cut +sub LogPerm { + my $message=shift; + my $execdir=$perlvar{'lonDaemons'}; + my $now=time; + my $local=localtime($now); + my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); + print $fh "$now:$message:$local\n"; +} + +=pod + +=head2 Log + +Logs a message to the log file. +Parameters: + +=item severity + +One of CRITICAL, WARNING, INFO, SUCCESS used to select the +format string used to format the message. if the severity is +not a defined severity the Default format string is used. + +=item message + +The base message. In addtion to the format string, the message +will be appended to a string containing the name of our remote +host and the time will be formatted into the message. + +=cut + +sub Log { + my $severity = shift; + my $message = shift; + + if(!$LogFormats{$severity}) { + $severity = "DEFAULT"; + } + + my $format = $LogFormats{$severity}; + + # Put the window dressing in in front of the message format: + + my $now = time; + my $local = localtime($now); + my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; + my $finalformat = $finalformat.$format."\n"; + + # open the file and put the result. + + my $execdir = $perlvar{'lonDaemons'}; + my $fh = IO::File->new(">>$execdir/logs/lonc.log"); + my $msg = sprintf($finalformat, $message); + print $fh $msg; + + +} + =pod @@ -155,20 +267,33 @@ sub SocketDump { =pod +=head2 ShowStatus + + Place some text as our pid status. + and as what we return in a SIGUSR1 + +=cut +sub ShowStatus { + my $state = shift; + my $now = time; + my $local = localtime($now); + $Status = $local.": ".$state; + $0='lonc: '.$state.' '.$local; +} + +=pod + =head2 Tick Invoked each timer tick. =cut + sub Tick { my $client; - $0 = 'lonc: '.GetServerHost()." Connection count: ".$ConnectionCount; - Debug(6, "Tick"); - Debug(6, " Current connection count: ".$ConnectionCount); - foreach $client (keys %ActiveClients) { - Debug(7, " Have client: with id: ".$ActiveClients{$client}); - } + ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); + # Is it time to prune connection count: @@ -177,11 +302,31 @@ sub Tick { $IdleSeconds++; if($IdleSeconds > $IdleTimeout) { # Prune a connection... $Socket = $IdleConnections->pop(); - KillSocket($Socket, 0); + KillSocket($Socket); } } else { $IdleSeconds = 0; # Reset idle count if not idle. } + + # 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. + # + + my $Requests = $WorkQueue->Count(); + if (($ConnectionCount == 0) && ($Requests > 0)) { + if ($ConnectionRetriesLeft > 0) { + my $Connections = ($Requests <= $MaxConnectionCount) ? + $Requests : $MaxConnectionCount; + Debug(1,"Work but no connections, start ".$Connections." of them"); + for ($i =0; $i < $Connections; $i++) { + MakeLondConnection(); + } + } else { + Debug(1,"Work in queue, but gave up on connections..flushing\n"); + EmptyQueue(); # Connections can't be established. + } + + } } =pod @@ -222,24 +367,21 @@ long enough, it will be shut down and re sub ServerToIdle { my $Socket = shift; # Get the socket. + delete($ActiveTransactions{$Socket}); # Server has no transaction &Debug(6, "Server to idle"); # If there's work to do, start the transaction: - $reqdata = $WorkQueue->dequeue(); - Debug(9, "Queue gave request data: ".$reqdata); + $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction unless($reqdata eq undef) { - my $unixSocket = $ClientQueue->dequeue(); - &Debug(6, "Starting new work request"); - &Debug(7, "Request: ".$reqdata); - - &StartRequest($Socket, $unixSocket, $reqdata); + Debug(9, "Queue gave request data: ".$reqdata->getRequest()); + &StartRequest($Socket, $reqdata); + } else { # There's no work waiting, so push the server to idle list. &Debug(8, "No new work requests, server connection going idle"); - delete($ActiveTransactions{$Socket}); $IdleConnections->push($Socket); } } @@ -274,51 +416,55 @@ sub ClientWritable { &Debug(6, "ClientWritable writing".$Data); &Debug(9, "Socket is: ".$Socket); - my $result = $Socket->send($Data, 0); - - # $result undefined: the write failed. - # otherwise $result is the number of bytes written. - # Remove that preceding string from the data. - # If the resulting data is empty, destroy the watcher - # and set up a read event handler to accept the next - # request. - - &Debug(9,"Send result is ".$result." Defined: ".defined($result)); - if(defined($result)) { - &Debug(9, "send result was defined"); - if($result == length($Data)) { # Entire string sent. - &Debug(9, "ClientWritable data all written"); - $Watcher->cancel(); - # - # Set up to read next request from socket: - - my $descr = sprintf("Connection to lonc client %d", - $ActiveClients{$Socket}); - Event->io(cb => \&ClientRequest, - poll => 'r', - desc => $descr, - data => "", - fd => $Socket); - - } else { # Partial string sent. - $Watcher->data(substr($Data, $result)); - } + if($Socket->connected) { + my $result = $Socket->send($Data, 0); - } else { # Error of some sort... - - # Some errnos are possible: - my $errno = $!; - if($errno == POSIX::EWOULDBLOCK || - $errno == POSIX::EAGAIN || - $errno == POSIX::EINTR) { - # No action taken? - } else { # Unanticipated errno. - &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); - $Watcher->cancel; # Stop the watcher. - $Socket->shutdown(2); # Kill connection - $Socket->close(); # Close the socket. - } + # $result undefined: the write failed. + # otherwise $result is the number of bytes written. + # Remove that preceding string from the data. + # If the resulting data is empty, destroy the watcher + # and set up a read event handler to accept the next + # request. + &Debug(9,"Send result is ".$result." Defined: ".defined($result)); + if(defined($result)) { + &Debug(9, "send result was defined"); + if($result == length($Data)) { # Entire string sent. + &Debug(9, "ClientWritable data all written"); + $Watcher->cancel(); + # + # Set up to read next request from socket: + + my $descr = sprintf("Connection to lonc client %d", + $ActiveClients{$Socket}); + Event->io(cb => \&ClientRequest, + poll => 'r', + desc => $descr, + data => "", + fd => $Socket); + + } else { # Partial string sent. + $Watcher->data(substr($Data, $result)); + } + + } else { # Error of some sort... + + # Some errnos are possible: + my $errno = $!; + if($errno == POSIX::EWOULDBLOCK || + $errno == POSIX::EAGAIN || + $errno == POSIX::EINTR) { + # No action taken? + } else { # Unanticipated errno. + &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost); + $Watcher->cancel; # Stop the watcher. + $Socket->shutdown(2); # Kill connection + $Socket->close(); # Close the socket. + } + + } + } else { + $Watcher->cancel(); # A delayed request...just cancel. } } @@ -339,22 +485,53 @@ Parameters: Socket on which the lond transaction occured. This is a LondConnection. The data received is in the TransactionReply member. -=item Client +=item Transaction -Unix domain socket open on the ultimate client. +The transaction that is being completed. =cut sub CompleteTransaction { &Debug(6,"Complete transaction"); my $Socket = shift; - my $Client = shift; + my $Transaction = shift; + + if (!$Transaction->isDeferred()) { # Normal transaction + my $data = $Socket->GetReply(); # Data to send. + StartClientReply($Transaction, $data); + } else { # Delete deferred transaction file. + Log("SUCCESS", "A delayed transaction was completed"); + LogPerm("S:$Client:".$Transaction->getRequest()); + unlink $Transaction->getFile(); + } +} +=pod +=head1 StartClientReply - my $data = $Socket->GetReply(); # Data to send. + Initiates a reply to a client where the reply data is a parameter. + +=head2 parameters: + +=item Transaction + + The transaction for which we are responding to the client. + +=item data + + The data to send to apached client. + +=cut +sub StartClientReply { + my $Transaction = shift; + my $data = shift; + + + my $Client = $Transaction->getClient(); &Debug(8," Reply was: ".$data); my $Serial = $ActiveClients{$Client}; my $desc = sprintf("Connection to lonc client %d", + $Serial); Event->io(fd => $Client, poll => "w", @@ -366,34 +543,64 @@ sub CompleteTransaction { =head2 FailTransaction Finishes a transaction with failure because the associated lond socket - disconnected. It is up to our client to retry if desired. + disconnected. There are two possibilities: + - The transaction is deferred: in which case we just quietly + delete the transaction since there is no client connection. + - The transaction is 'live' in which case we initiate the sending + of "con_lost" to the client. + +Deleting the transaction means killing it from the +%ActiveTransactions hash. Parameters: =item client - The UNIX domain socket open on our client. - + The LondTransaction we are failing. + =cut sub FailTransaction { - my $client = shift; + my $transaction = shift; + Debug(1, "Failing transaction: ".$transaction->getRequest()); + if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. + my $client = $transaction->getClient(); + Debug(1," Replying con_lost to ".$transaction->getRequest()); + StartClientReply($transaction, "con_lost\n"); + } - &Debug(8, "Failing transaction due to disconnect"); - my $Serial = $ActiveClients{$client}; - my $desc = sprintf("Connection to lonc client %d", $Serial); - my $data = "error: Connection to lond lost\n"; - - Event->io(fd => $client, - poll => "w", - desc => $desc, - cb => \&ClientWritable, - data => $data); +} + +=pod +=head1 EmptyQueue + + Fails all items in the work queue with con_lost. + Note that each item in the work queue is a transaction. +=cut +sub EmptyQueue { + while($WorkQueue->Count()) { + my $request = $WorkQueue->dequeue(); # This is a transaction + FailTransaction($request); + } } =pod +=head2 CloseAllLondConnections + +Close all connections open on lond prior to exit e.g. + +=cut +sub CloseAllLondConnections { + foreach $Socket (keys %ActiveConnections) { + KillSocket($Socket); + } +} +=cut + +=pod + =head2 KillSocket Destroys a socket. This function can be called either when a socket @@ -416,10 +623,14 @@ nonzero if we are allowed to create a ne =cut sub KillSocket { my $Socket = shift; - my $Restart= shift; - # If the socket came from the active connection set, delete it. - # otherwise it came from the idle set and has already been destroyed: + $Socket->Shutdown(); + + # If the socket came from the active connection set, + # delete its transaction... note that FailTransaction should + # already have been called!!! + # otherwise it came from the idle set. + # if(exists($ActiveTransactions{$Socket})) { delete ($ActiveTransactions{$Socket}); @@ -428,10 +639,13 @@ sub KillSocket { delete($ActiveConnections{$Socket}); } $ConnectionCount--; - if( ($ConnectionCount = 0) && ($Restart)) { - MakeLondConnection(); - } + # If the connection count has gone to zero and there is work in the + # work queue, the work all gets failed with con_lost. + # + if($ConnectionCount == 0) { + EmptyQueue; + } } =pod @@ -493,18 +707,22 @@ transaction is in progress, the socket a =cut sub LondReadable { + my $Event = shift; my $Watcher = $Event->w; my $Socket = $Watcher->data; my $client = undef; + &Debug(6,"LondReadable called state = ".$State); + my $State = $Socket->GetState(); # All action depends on the state. - &Debug(6,"LondReadable called state = ".$State); 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 # The socket has become disconnected. We fail the transaction. @@ -513,7 +731,7 @@ sub LondReadable { FailTransaction($ActiveTransactions{$Socket}); } $Watcher->cancel(); - KillSocket($Socket, 1); + KillSocket($Socket); return; } SocketDump(6,$Socket); @@ -529,8 +747,8 @@ sub LondReadable { # in the connection takes care of setting that up. Just # need to transition to writable: - $Watcher->poll("w"); $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); } elsif ($State eq "ChallengeReplied") { @@ -539,22 +757,25 @@ sub LondReadable { # The ok was received. Now we need to request the key # That requires us to be writable: - $Watcher->poll("w"); $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); } elsif ($State eq "ReceivingKey") { } elsif ($State eq "Idle") { # If necessary, complete a transaction and then go into the # idle queue. + $Watcher->cancel(); if(exists($ActiveTransactions{$Socket})) { Debug(8,"Completing transaction!!"); CompleteTransaction($Socket, $ActiveTransactions{$Socket}); + } else { + Log("SUCCESS", "Connection ".$ConnectionCount." to " + .$RemoteHost." now ready for action"); } - $Watcher->cancel(); ServerToIdle($Socket); # Next work unit or idle. - + } elsif ($State eq "SendingRequest") { # We need to be writable for this and probably don't belong # here inthe first place. @@ -636,15 +857,15 @@ is the socket on which to return a reply sub LondWritable { my $Event = shift; my $Watcher = $Event->w; - my @data = $Watcher->data; - Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n"); + my $Socket = $Watcher->data; + my $State = $Socket->GetState(); - my $Socket = $data[0]; # I know there's at least a socket. + Debug(6,"LondWritable State = ".$State."\n"); + # Figure out what to do depending on the state of the socket: - my $State = $Socket->GetState(); SocketDump(6,$Socket); @@ -654,12 +875,10 @@ sub LondWritable { if ($Socket->Writable() != 0) { # The write resulted in an error. # We'll treat this as if the socket got disconnected: - if(exists($ActiveTransactions{$Socket})) { - Debug(3, "Lond connection lost, failing transactions"); - FailTransaction($ActiveTransactions{$Socket}); - } + Log("WARNING", "Connection to ".$RemoteHost. + " has been disconnected"); $Watcher->cancel(); - KillSocket($Socket, 1); + KillSocket($Socket); return; } # "init" is being sent... @@ -670,8 +889,8 @@ sub LondWritable { # Now that init was sent, we switch # to watching for readability: - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "ChallengeReceived") { # We received the challenge, now we @@ -679,15 +898,18 @@ sub LondWritable { # we're waiting for the state to change if($Socket->Writable() != 0) { - # Write of the next chunk resulted in an error. + + $Watcher->cancel(); + KillSocket($Socket); + return; } } elsif ($State eq "ChallengeReplied") { # The echo was sent back, so we switch # to watching readability. - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "RequestingKey") { # At this time we're requesting the key. @@ -697,30 +919,41 @@ sub LondWritable { if($Socket->Writable() != 0) { # Write resulted in an error. - } + $Watcher->cancel(); + KillSocket($Socket); + return; + + } } elsif ($State eq "ReceivingKey") { # Now we need to wait for the key # to come back from the peer: - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "SendingRequest") { # At this time we are sending a request to the # peer... write the next chunk: if($Socket->Writable() != 0) { - # Write resulted in an error. + if(exists($ActiveTransactions{$Socket})) { + Debug(3, "Lond connection lost, failing transactions"); + FailTransaction($ActiveTransactions{$Socket}); + } + $Watcher->cancel(); + KillSocket($Socket); + return; + } } elsif ($State eq "ReceivingReply") { # The send has completed. Wait for the # data to come in for a reply. Debug(8,"Writable sent request/receiving reply"); - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } else { # Control only passes here on an error: @@ -732,6 +965,35 @@ sub LondWritable { } } +=pod + +=cut +sub QueueDelayed { + Debug(3,"QueueDelayed called"); + + my $path = "$perlvar{'lonSockDir'}/delayed"; + + Debug(4, "Delayed path: ".$path); + opendir(DIRHANDLE, $path); + + @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; + Debug(4, "Got ".$alldelayed." delayed files"); + closedir(DIRHANDLE); + my $dfname; + my $reqfile; + foreach $dfname (sort @alldelayed) { + $reqfile = "$path/$dfname"; + Debug(4, "queueing ".$reqfile); + my $Handle = IO::File->new($reqfile); + my $cmd = <$Handle>; + chomp $cmd; # There may or may not be a newline... + $cmd = $cmd."\n"; # now for sure there's exactly one newline. + my $Transaction = LondTransaction->new($cmd); + $Transaction->SetDeferred($reqfile); + QueueTransaction($Transaction); + } + +} =pod @@ -753,31 +1015,40 @@ sub MakeLondConnection { &GetServerPort()); if($Connection == undef) { # Needs to be more robust later. - die "Failed to make a connection!!".$!."\n"; + Log("CRITICAL","Failed to make a connection with lond."); + $ConnectionRetriesLeft--; + return 0; # Failure. + } else { + $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count + # The connection needs to have writability + # monitored in order to send the init sequence + # that starts the whole authentication/key + # exchange underway. + # + my $Socket = $Connection->GetSocket(); + if($Socket == undef) { + die "did not get a socket from the connection"; + } else { + &Debug(9,"MakeLondConnection got socket: ".$Socket); + } - } - # The connection needs to have writability - # monitored in order to send the init sequence - # that starts the whole authentication/key - # exchange underway. - # - my $Socket = $Connection->GetSocket(); - if($Socket == undef) { - die "did not get a socket from the connection"; - } else { - &Debug(9,"MakeLondConnection got socket: ".$Socket); + + $event = Event->io(fd => $Socket, + poll => 'w', + cb => \&LondWritable, + data => $Connection, + desc => 'Connection to lond server'); + $ActiveConnections{$Connection} = $event; + + $ConnectionCount++; + Debug(4, "Connection count = ".$ConnectionCount); + if($ConnectionCount == 1) { # First Connection: + QueueDelayed; + } + Log("SUCESS", "Created connection ".$ConnectionCount + ." to host ".GetServerHost()); + return 1; # Return success. } - - - $event = Event->io(fd => $Socket, - poll => 'w', - cb => \&LondWritable, - data => ($Connection, undef), - desc => 'Connection to lond server'); - $ActiveConnections{$Connection} = $event; - - $ConnectionCount++; - } @@ -808,17 +1079,17 @@ The text of the request to send. sub StartRequest { my $Lond = shift; - my $Client = shift; - my $Request = shift; + my $Request = shift; # This is a LondTransaction. - Debug(6, "StartRequest: ".$Request); + Debug(6, "StartRequest: ".$Request->getRequest()); my $Socket = $Lond->GetSocket(); - $ActiveTransactions{$Lond} = $Client; # Socket to relay to client. + $Request->Activate($Lond); + $ActiveTransactions{$Lond} = $Request; - $Lond->InitiateTransaction($Request); - $event = Event->io(fd => $Lond->GetSocket(), + $Lond->InitiateTransaction($Request->getRequest()); + $event = Event->io(fd => $Socket, poll => "w", cb => \&LondWritable, data => $Lond, @@ -849,15 +1120,15 @@ data to send to the lond. =cut sub QueueTransaction { - my $requestSocket = shift; - my $requestData = shift; - Debug(6,"QueueTransaction: ".$requestData); + my $requestData = shift; # This is a LondTransaction. + my $cmd = $requestData->getRequest(); + + Debug(6,"QueueTransaction: ".$cmd); my $LondSocket = $IdleConnections->pop(); if(!defined $LondSocket) { # Need to queue request. Debug(8,"Must queue..."); - $ClientQueue->enqueue($requestSocket); $WorkQueue->enqueue($requestData); if($ConnectionCount < $MaxConnectionCount) { Debug(4,"Starting additional lond connection"); @@ -865,7 +1136,7 @@ sub QueueTransaction { } } else { # Can start the request: Debug(8,"Can start..."); - StartRequest($LondSocket, $requestSocket, $requestData); + StartRequest($LondSocket, $requestData); } } @@ -874,7 +1145,6 @@ sub QueueTransaction { =pod =head2 ClientRequest - Callback that is called when data can be read from the UNIX domain socket connecting us with an apache server process. @@ -899,13 +1169,22 @@ sub ClientRequest { close($socket); $watcher->cancel(); delete($ActiveClients{$socket}); + return; } Debug(8,"Data: ".$data." this read: ".$thisread); $data = $data.$thisread; # Append new data. $watcher->data($data); if($data =~ /(.*\n)/) { # Request entirely read. + if($data eq "close_connection_exit\n") { + Log("CRITICAL", + "Request Close Connection ... exiting"); + CloseAllLondConnections(); + exit; + } Debug(8, "Complete transaction received: ".$data); - QueueTransaction($socket, $data); + my $Transaction = LondTransaction->new($data); + $Transaction->SetClient($socket); + QueueTransaction($Transaction); $watcher->cancel(); # Done looking for input data. } @@ -967,7 +1246,7 @@ Returns the host whose lond we talk with =cut -sub GetServerHost { # Stub - get this from config. +sub GetServerHost { return $RemoteHost; # Setup by the fork. } @@ -979,7 +1258,7 @@ Returns the lond port number. =cut -sub GetServerPort { # Stub - get this from config. +sub GetServerPort { return $perlvar{londPort}; } @@ -1000,7 +1279,7 @@ sub SetupLoncListener { my $socket; my $SocketName = GetLoncSocketPath(); unlink($SocketName); - unless ($socket = IO::Socket::UNIX->new(Local => $SocketName, + unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, Listen => 10, Type => SOCK_STREAM)) { die "Failed to create a lonc listner socket"; @@ -1013,6 +1292,25 @@ sub SetupLoncListener { =pod +=head2 SignalledToDeath + +Called in response to a signal that causes a chid process to die. + +=cut + + +sub SignalledToDeath { + Debug(2,"Signalled to death!"); + my ($signal) = @_; + chomp($signal); + Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " + ."died through "."\"$signal\""); + LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " + ."\"$signal\""); + die("Signal abnormal end"); + exit 0; + +} =head2 ChildProcess This sub implements a child process for a single lonc daemon. @@ -1021,16 +1319,15 @@ This sub implements a child process for sub ChildProcess { - print "Loncnew\n"; # For now turn off signals. - $SIG{QUIT} = IGNORE; + $SIG{QUIT} = \&SignalledToDeath; $SIG{HUP} = IGNORE; $SIG{USR1} = IGNORE; - $SIG{INT} = IGNORE; + $SIG{INT} = DEFAULT; $SIG{CHLD} = IGNORE; - $SIG{__DIE__} = IGNORE; + $SIG{__DIE__} = \&SignalledToDeath; SetupTimer(); @@ -1042,8 +1339,9 @@ sub ChildProcess { # Setup the initial server connection: - &MakeLondConnection(); - + # &MakeLondConnection(); // let first work requirest do it. + + Debug(9,"Entering event loop"); my $ret = Event::loop(); # Start the main event loop. @@ -1054,15 +1352,21 @@ sub ChildProcess { # Create a new child for host passed in: sub CreateChild { + my $sigset = POSIX::SigSet->new(SIGINT); + sigprocmask(SIG_BLOCK, $sigset); my $host = shift; $RemoteHost = $host; - Debug(3, "Forking off child for ".$RemoteHost); - sleep(5); + Log("CRITICAL", "Forking server for ".$host); $pid = fork; if($pid) { # Parent $ChildHash{$pid} = $RemoteHost; + sigprocmask(SIG_UNBLOCK, $sigset); + } else { # child. - ChildProcess; + ShowStatus("Connected to ".$RemoteHost); + $SIG{INT} = DEFAULT; + sigprocmask(SIG_UNBLOCK, $sigset); + ChildProcess; # Does not return. } } @@ -1076,6 +1380,41 @@ sub CreateChild { # Each exit gets logged and the child gets restarted. # +# +# Fork and start in new session so hang-up isn't going to +# happen without intent. +# + + + + + + +ShowStatus("Forming new session"); +my $childpid = fork; +if ($childpid != 0) { + sleep 4; # Give child a chacne to break to + exit 0; # a new sesion. +} +# +# Write my pid into the pid file so I can be located +# + +ShowStatus("Parent writing pid file:"); +$execdir = $perlvar{'lonDaemons'}; +open (PIDSAVE, ">$execdir/logs/lonc.pid"); +print PIDSAVE "$$\n"; +close(PIDSAVE); + +if (POSIX::setsid() < 0) { + print "Could not create new session\n"; + exit -1; +} + +ShowStatus("Forking node servers"); + +Log("CRITICAL", "--------------- Starting children ---------------"); + my $HostIterator = LondConnection::GetHostIterator; while (! $HostIterator->end()) { @@ -1083,20 +1422,57 @@ while (! $HostIterator->end()) { CreateChild($hostentryref->[0]); $HostIterator->next(); } +$RemoteHost = "Parent Server"; # Maintain the population: +ShowStatus("Parent keeping the flock"); + +# +# Set up parent signals: +# + +$SIG{INT} = \&KillThemAll; +$SIG{TERM} = \&KillThemAll; + + while(1) { $deadchild = wait(); if(exists $ChildHash{$deadchild}) { # need to restart. $deadhost = $ChildHash{$deadchild}; delete($ChildHash{$deadchild}); - Debug(4,"Lost child pid= ".$deadchild. + Log("WARNING","Lost child pid= ".$deadchild. "Connected to host ".$deadhost); + Log("INFO", "Restarting child procesing ".$deadhost); CreateChild($deadhost); } } +=pod + +=head1 KillThemAll + +Signal handler that kills all children by sending them a +SIGINT. Responds to sigint and sigterm. + +=cut + +sub KillThemAll { + Debug(2, "Kill them all!!"); + local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. + foreach $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('INT', $pid); + } + Log("CRITICAL", "Killing the master process."); + exit +} + +=pod + =head1 Theory The event class is used to build this as a single process with an 500 Internal Server Error

Internal Server Error

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

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

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