--- loncom/loncnew 2003/06/03 01:59:39 1.7 +++ loncom/loncnew 2003/06/13 02:38:43 1.9 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.7 2003/06/03 01:59:39 foxr Exp $ +# $Id: loncnew,v 1.9 2003/06/13 02:38:43 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,13 +39,21 @@ # - Add logging/status monitoring. # - Add Signal handling - HUP restarts. USR1 status report. # - Add Configuration file I/O (done). -# - Add Pending request processing on startup. # - Add management/status request interface. -# - Add deferred request capability. +# - Add deferred request capability. (done) +# - Detect transmission timeouts. # # Change log: # $Log: loncnew,v $ +# 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. # @@ -58,6 +66,7 @@ use POSIX qw(:signal_h); use IO::Socket; use IO::Socket::INET; use IO::Socket::UNIX; +use IO::File; use IO::Handle; use Socket; use Crypt::IDEA; @@ -68,7 +77,6 @@ use LONCAPA::LondTransaction; use LONCAPA::Configuration; use LONCAPA::HashIterator; -print "Loncnew starting\n"; # # Disable all signals we might receive from outside for now. @@ -93,10 +101,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. # @@ -109,17 +117,72 @@ my %ActiveConnections; # Connections to 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. -# -# This disconnected socket makes posible a bit more regular -# code when processing delayed requests: -# -my $NullSocket = IO::Socket->new(); # +# 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 "; + +my $lastlog = ''; # Used for status reporting. + +=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 @@ -180,6 +243,8 @@ sub SocketDump { sub ShowStatus { my $status = shift; $0 = "lonc: ".$status; + $Status = $status; # Make available for logging. + } =pod @@ -277,6 +342,7 @@ sub ServerToIdle { unless($reqdata eq undef) { Debug(9, "Queue gave request data: ".$reqdata->getRequest()); &StartRequest($Socket, $reqdata); + } else { # There's no work waiting, so push the server to idle list. @@ -399,6 +465,7 @@ sub CompleteTransaction { my $data = $Socket->GetReply(); # Data to send. StartClientReply($Transaction, $data); } else { # Delete deferred transaction file. + Log("SUCCESS", "A delayed transaction was completed"); unlink $Transaction->getFile(); } } @@ -484,6 +551,20 @@ sub EmptyQueue { =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 @@ -507,6 +588,8 @@ nonzero if we are allowed to create a ne sub KillSocket { my $Socket = shift; + $Socket->Shutdown(); + # If the socket came from the active connection set, # delete its transaction... note that FailTransaction should # already have been called!!! @@ -588,15 +671,17 @@ 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); if($Socket->Readable() != 0) { @@ -624,8 +709,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") { @@ -634,20 +719,23 @@ 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") { @@ -731,15 +819,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; # 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); @@ -749,7 +837,8 @@ sub LondWritable { if ($Socket->Writable() != 0) { # The write resulted in an error. # We'll treat this as if the socket got disconnected: - + Log("WARNING", "Connection to ".$RemoteHost. + " has been disconnected"); $Watcher->cancel(); KillSocket($Socket); return; @@ -762,8 +851,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 @@ -781,8 +870,8 @@ sub LondWritable { # 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. @@ -802,8 +891,8 @@ sub LondWritable { # 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 @@ -825,8 +914,8 @@ sub LondWritable { # 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: @@ -842,17 +931,25 @@ sub LondWritable { =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 $reqfile (sort @alldelayed) { - $reqfile = $path/$reqfile; + my $reqfile; + foreach $dfname (sort @alldelayed) { + $reqfile = "$path/$dfname"; + Debug(4, "queueing ".$reqfile); my $Handle = IO::File->new($reqfile); my $cmd = <$Handle>; - chomp($cmd); + chomp $cmd; # There may or may not be a newline... + $cmd = $cmd."\ny"; # now for sure there's exactly one newline. my $Transaction = LondTransaction->new($cmd); $Transaction->SetDeferred($reqfile); QueueTransaction($Transaction); @@ -880,7 +977,7 @@ sub MakeLondConnection { &GetServerPort()); if($Connection == undef) { # Needs to be more robust later. - Debug(0,"Failed to make a connection with lond."); + Log("CRITICAL","Failed to make a connection with lond."); } else { # The connection needs to have writability # monitored in order to send the init sequence @@ -898,14 +995,17 @@ sub MakeLondConnection { $event = Event->io(fd => $Socket, poll => 'w', cb => \&LondWritable, - data => \$Connection, + 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()); } } @@ -947,7 +1047,7 @@ sub StartRequest { $ActiveTransactions{$Lond} = $Request; $Lond->InitiateTransaction($Request->getRequest()); - $event = Event->io(fd => $Lond->GetSocket(), + $event = Event->io(fd => $Socket, poll => "w", cb => \&LondWritable, data => $Lond, @@ -1033,8 +1133,14 @@ sub ClientRequest { $data = $data.$thisread; # Append new data. $watcher->data($data); if($data =~ /(.*\n)/) { # Request entirely read. + if($data == "close_connection_exit\n") { + Log("CRITICAL", + "Request Close Connection ... exiting"); + CloseAllLondConnections(); + exit; + } Debug(8, "Complete transaction received: ".$data); - my $Transaction = new LondTransaction->new($data); + my $Transaction = LondTransaction->new($data); $Transaction->SetClient($socket); QueueTransaction($Transaction); $watcher->cancel(); # Done looking for input data. @@ -1152,7 +1258,6 @@ This sub implements a child process for sub ChildProcess { - print "Loncnew\n"; # For now turn off signals. @@ -1191,8 +1296,7 @@ sub ChildProcess { sub CreateChild { 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; @@ -1220,11 +1324,7 @@ sub CreateChild { -ShowStatus("Parent writing pid file:"); -$execdir = $perlvar{'lonDaemons'}; -open (PIDSAVE, ">$execdir/logs/lonc.pid"); -print PIDSAVE "$$\n"; -close(PIDSAVE); + ShowStatus("Forming new session"); my $childpid = fork; @@ -1232,6 +1332,15 @@ 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"; @@ -1240,6 +1349,8 @@ if (POSIX::setsid() < 0) { ShowStatus("Forking node servers"); +Log("CRITICAL", "--------------- Starting children ---------------"); + my $HostIterator = LondConnection::GetHostIterator; while (! $HostIterator->end()) { @@ -1257,8 +1368,9 @@ while(1) { 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); } }