--- loncom/loncnew 2006/08/25 21:12:19 1.76 +++ loncom/loncnew 2007/03/28 21:44:05 1.82 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.76 2006/08/25 21:12:19 albertel Exp $ +# $Id: loncnew,v 1.82 2007/03/28 21:44:05 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,7 +60,6 @@ use LONCAPA::Stack; use LONCAPA::LondConnection; use LONCAPA::LondTransaction; use LONCAPA::Configuration; -use LONCAPA::HashIterator; use Fcntl qw(:flock); @@ -74,8 +73,6 @@ my %perlvar = %{$perlvarref}; # parent and shared variables. my %ChildHash; # by pid -> host. -my %HostToPid; # By host -> pid. -my %HostHash; # by loncapaname -> IP. my %listening_to; # Socket->host table for who the parent # is listening to. my %parent_dispatchers; # host-> listener watcher events. @@ -96,6 +93,8 @@ my $executable = $0; # Get the full # The variables below are only used by the child processes. # my $RemoteHost; # Name of host child is talking to. +my $RemoteHostId; # default lonid of host child is talking to. +my @all_host_ids; my $UnixSocketDir= $perlvar{'lonSockDir'}; my $IdleConnections = Stack->new(); # Set of idle connections my %ActiveConnections; # Connections to the remote lond. @@ -114,7 +113,6 @@ my $LondConnecting = 0; # True wh -my $DieWhenIdle = 1; # When true children die when trimmed -> 0. my $I_am_child = 0; # True if this is the child process. # @@ -308,12 +306,13 @@ sub SocketTimeout { } } + # # This function should be called by the child in all cases where it must -# exit. If the child process is running with the DieWhenIdle turned on -# it must create a lock file for the AF_UNIX socket in order to prevent -# connection requests from lonnet in the time between process exit -# and the parent picking up the listen again. +# exit. The child process must create a lock file for the AF_UNIX socket +# in order to prevent connection requests from lonnet in the time between +# process exit and the parent picking up the listen again. +# # Parameters: # exit_code - Exit status value, however see the next parameter. # message - If this optional parameter is supplied, the exit @@ -324,24 +323,20 @@ sub child_exit { # Regardless of how we exit, we may need to do the lock thing: - if($DieWhenIdle) { - # - # Create a lock file since there will be a time window - # between our exit and the parent's picking up the listen - # during which no listens will be done on the - # lonnet client socket. - # - my $lock_file = GetLoncSocketPath().".lock"; - open(LOCK,">$lock_file"); - print LOCK "Contents not important"; - close(LOCK); - - exit(0); - } - # Now figure out how we exit: + # + # Create a lock file since there will be a time window + # between our exit and the parent's picking up the listen + # during which no listens will be done on the + # lonnet client socket. + # + my $lock_file = &GetLoncSocketPath().".lock"; + open(LOCK,">$lock_file"); + print LOCK "Contents not important"; + close(LOCK); + unlink(&GetLoncSocketPath()); - if($message) { - die $message; + if ($message) { + die($message); } else { exit($exit_code); } @@ -375,7 +370,7 @@ sub Tick { KillSocket($Socket); $IdleSeconds = 0; # Otherwise all connections get trimmed to fast. UpdateStatus(); - if(($ConnectionCount == 0) && $DieWhenIdle) { + if(($ConnectionCount == 0)) { &child_exit(0); } @@ -1153,10 +1148,12 @@ sub LondWritable { } } + =pod =cut + sub QueueDelayed { Debug(3,"QueueDelayed called"); @@ -1165,16 +1162,7 @@ sub QueueDelayed { Debug(4, "Delayed path: ".$path); opendir(DIRHANDLE, $path); - my @all_host_ids; - my $host_iterator = &LondConnection::GetHostIterator(); - while (!$host_iterator->end()) { - my ($host_id,$host_name) = @{$host_iterator->get()}[0,3]; - if ($host_name eq $RemoteHost) { - push(@all_host_ids, $host_id); - } - $host_iterator->next(); - } - my $host_id_re = '(?:'.join('|',@all_host_ids).')'; + my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@all_host_ids)).')'; my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE)); closedir(DIRHANDLE); foreach my $dfname (sort(@alldelayed)) { @@ -1209,7 +1197,8 @@ sub MakeLondConnection { .GetServerPort()); my $Connection = LondConnection->new(&GetServerHost(), - &GetServerPort()); + &GetServerPort(), + &GetHostId()); if($Connection eq undef) { # Needs to be more robust later. Log("CRITICAL","Failed to make a connection with lond."); @@ -1217,6 +1206,7 @@ sub MakeLondConnection { return 0; # Failure. } else { + $LondConnecting = 1; # Connection in progress. # The connection needs to have writability # monitored in order to send the init sequence # that starts the whole authentication/key @@ -1247,7 +1237,6 @@ sub MakeLondConnection { } Log("SUCESS", "Created connection ".$ConnectionCount ." to host ".GetServerHost()); - $LondConnecting = 1; # Connection in progress. return 1; # Return success. } @@ -1410,7 +1399,7 @@ sub ClientRequest { # Accept a connection request for a client (lonc child) and # start up an event watcher to keep an eye on input from that # Event. This can be called both from NewClient and from -# ChildProcess if we are started in DieWhenIdle mode. +# ChildProcess. # Parameters: # $socket - The listener socket. # Returns: @@ -1499,6 +1488,18 @@ sub GetServerHost { =pod +=head2 GetServerId + +Returns the hostid whose lond we talk with. + +=cut + +sub GetHostId { + return $RemoteHostId; # Setup by the fork. +} + +=pod + =head2 GetServerPort Returns the lond port number. @@ -1526,15 +1527,14 @@ another event handler to subess requests =cut sub SetupLoncListener { + my ($host,$SocketName) = @_; + if (!$host) { $host = &GetServerHost(); } + if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); } - my $host = GetServerHost(); # Default host. - if (@_) { - ($host) = @_ # Override host with parameter. - } - my $socket; - my $SocketName = GetLoncSocketPath($host); unlink($SocketName); + + my $socket; unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, Listen => 250, Type => SOCK_STREAM)) { @@ -1663,7 +1663,7 @@ Optional parameter: =cut sub ChildProcess { - # If we are in DieWhenIdle mode, we've inherited all the + # We've inherited all the # events of our parent and those have to be cancelled or else # all holy bloody chaos will result.. trust me, I already made # >that< mistake. @@ -1739,12 +1739,9 @@ sub ChildProcess { # &MakeLondConnection(); // let first work request do it. - # If We are in diwhenidle, need to accept the connection since the - # event may not fire. + # need to accept the connection since the event may not fire. - if ($DieWhenIdle) { - &accept_client($socket); - } + &accept_client($socket); Debug(9,"Entering event loop"); my $ret = Event::loop(); # Start the main event loop. @@ -1756,7 +1753,7 @@ sub ChildProcess { # Create a new child for host passed in: sub CreateChild { - my ($host, $socket) = @_; + my ($host, $hostid) = @_; my $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset); @@ -1766,18 +1763,14 @@ sub CreateChild { if($pid) { # Parent $RemoteHost = "Parent"; $ChildHash{$pid} = $host; - $HostToPid{$host}= $pid; sigprocmask(SIG_UNBLOCK, $sigset); - + undef(@all_host_ids); } else { # child. + $RemoteHostId = $hostid; ShowStatus("Connected to ".$RemoteHost); $SIG{INT} = 'DEFAULT'; sigprocmask(SIG_UNBLOCK, $sigset); - if(defined $socket) { - &ChildProcess($socket); - } else { - ChildProcess; # Does not return. - } + &ChildProcess(); # Does not return. } } @@ -1805,25 +1798,46 @@ sub parent_client_connection { my ($event) = @_; my $watcher = $event->w; my $socket = $watcher->fd; - - # Lookup the host associated with this socket: - - my $host = $listening_to{$socket}; - - # Start the child: - - - - &Debug(9,"Creating child for $host (parent_client_connection)"); - &CreateChild($host, $socket); - - # Clean up the listen since now the child takes over until it exits. - - $watcher->cancel(); # Nolonger listening to this event - delete($listening_to{$socket}); - delete($parent_dispatchers{$host}); - $socket->close(); + my $connection = $socket->accept(); # Accept the client connection. + Event->io(cb => \&get_remote_hostname, + poll => 'r', + data => "", + fd => $connection); + } +} + +sub get_remote_hostname { + my ($event) = @_; + my $watcher = $event->w; + my $socket = $watcher->fd; + + my $thisread; + my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0); + Debug(8, "rcv: data length = ".length($thisread)." read =".$thisread); + if (!defined($rv) || length($thisread) == 0) { + # Likely eof on socket. + Debug(5,"Client Socket closed on lonc for p_c_c"); + close($socket); + $watcher->cancel(); + return; + } + + my $data = $watcher->data().$thisread; + $watcher->data($data); + if($data =~ /\n$/) { # Request entirely read. + chomp($data); + } else { + return; } + + &Debug(5,"Creating child for $data (parent_client_connection)"); + (my $hostname,my $lonid,@all_host_ids) = split(':',$data); + &CreateChild($hostname,$lonid); + + # Clean up the listen since now the child takes over until it exits. + $watcher->cancel(); # Nolonger listening to this event + $socket->send("done\n"); + $socket->close(); } # parent_listen: @@ -1845,23 +1859,43 @@ sub parent_listen { my ($loncapa_host) = @_; Debug(5, "parent_listen: $loncapa_host"); - my $socket = &SetupLoncListener($loncapa_host); + my ($socket,$file); + if (!$loncapa_host) { + $loncapa_host = 'common_parent'; + $file = $perlvar{'lonSockCreate'}; + } else { + $file = &GetLoncSocketPath($loncapa_host); + } + $socket = &SetupLoncListener($loncapa_host,$file); + $listening_to{$socket} = $loncapa_host; if (!$socket) { die "Unable to create a listen socket for $loncapa_host"; } - my $lock_file = &GetLoncSocketPath($loncapa_host).".lock"; + my $lock_file = $file.".lock"; unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] - my $watcher = Event->io(cb => \&parent_client_connection, - poll => 'r', - desc => "Parent listener unix socket ($loncapa_host)", - fd => $socket); + my $watcher = + Event->io(cb => \&parent_client_connection, + poll => 'r', + desc => "Parent listener unix socket ($loncapa_host)", + data => "", + fd => $socket); $parent_dispatchers{$loncapa_host} = $watcher; } +sub parent_clean_up { + my ($loncapa_host) = @_; + Debug(5, "parent_clean_up: $loncapa_host"); + + my $socket_file = &GetLoncSocketPath($loncapa_host); + unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.] + my $lock_file = $socket_file.".lock"; + unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] +} + # listen_on_all_unix_sockets: # This sub initiates a listen on all unix domain lonc client sockets. @@ -1891,6 +1925,11 @@ sub listen_on_all_unix_sockets { } } +sub listen_on_common_socket { + Debug(5, "listen_on_common_socket"); + &parent_listen(); +} + # server_died is called whenever a child process exits. # Since this is dispatched via a signal, we must process all # dead children until there are no more left. The action @@ -1914,8 +1953,7 @@ sub server_died { if($host) { # It's for real... &Debug(9, "Caught sigchild for $host"); delete($ChildHash{$pid}); - delete($HostToPid{$host}); - &parent_listen($host); + &parent_clean_up($host); } else { &Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); @@ -1972,21 +2010,9 @@ ShowStatus("Forking node servers"); Log("CRITICAL", "--------------- Starting children ---------------"); LondConnection::ReadConfig; # Read standard config files. -my $HostIterator = LondConnection::GetHostIterator; -if ($DieWhenIdle) { - $RemoteHost = "[parent]"; - &listen_on_all_unix_sockets(); -} else { - - while (! $HostIterator->end()) { - - my $hostentryref = $HostIterator->get(); - CreateChild($hostentryref->[0]); - $HostHash{$hostentryref->[0]} = $hostentryref->[4]; - $HostIterator->next(); - } -} +$RemoteHost = "[parent]"; +&listen_on_common_socket(); $RemoteHost = "Parent Server"; @@ -1995,68 +2021,38 @@ $RemoteHost = "Parent Server"; ShowStatus("Parent keeping the flock"); -if ($DieWhenIdle) { - # We need to setup a SIGChild event to handle the exit (natural or otherwise) - # of the children. - - Event->signal(cb => \&server_died, - desc => "Child exit handler", - signal => "CHLD"); - - - # Set up all the other signals we set up. We'll vector them off to the - # same subs as we would for DieWhenIdle false and, if necessary, conditionalize - # the code there. - - $parent_handlers{INT} = Event->signal(cb => \&Terminate, - desc => "Parent INT handler", - signal => "INT"); - $parent_handlers{TERM} = Event->signal(cb => \&Terminate, - desc => "Parent TERM handler", - signal => "TERM"); - $parent_handlers{HUP} = Event->signal(cb => \&Restart, - desc => "Parent HUP handler.", - signal => "HUP"); - $parent_handlers{USR1} = Event->signal(cb => \&CheckKids, - desc => "Parent USR1 handler", - signal => "USR1"); - $parent_handlers{USR2} = Event->signal(cb => \&UpdateKids, - desc => "Parent USR2 handler.", - signal => "USR2"); - - # Start procdesing events. - - $Event::DebugLevel = $DebugLevel; - Debug(9, "Parent entering event loop"); - my $ret = Event::loop(); - die "Main Event loop exited: $ret"; - - -} else { - # - # Set up parent signals: - # - - $SIG{INT} = \&Terminate; - $SIG{TERM} = \&Terminate; - $SIG{HUP} = \&Restart; - $SIG{USR1} = \&CheckKids; - $SIG{USR2} = \&UpdateKids; # LonManage update request. - - while(1) { - my $deadchild = wait(); - if(exists $ChildHash{$deadchild}) { # need to restart. - my $deadhost = $ChildHash{$deadchild}; - delete($HostToPid{$deadhost}); - delete($ChildHash{$deadchild}); - Log("WARNING","Lost child pid= ".$deadchild. - "Connected to host ".$deadhost); - Log("INFO", "Restarting child procesing ".$deadhost); - CreateChild($deadhost); - } - } -} +# We need to setup a SIGChild event to handle the exit (natural or otherwise) +# of the children. +Event->signal(cb => \&server_died, + desc => "Child exit handler", + signal => "CHLD"); + + +# Set up all the other signals we set up. + +$parent_handlers{INT} = Event->signal(cb => \&Terminate, + desc => "Parent INT handler", + signal => "INT"); +$parent_handlers{TERM} = Event->signal(cb => \&Terminate, + desc => "Parent TERM handler", + signal => "TERM"); +$parent_handlers{HUP} = Event->signal(cb => \&KillThemAll, + desc => "Parent HUP handler.", + signal => "HUP"); +$parent_handlers{USR1} = Event->signal(cb => \&CheckKids, + desc => "Parent USR1 handler", + signal => "USR1"); +$parent_handlers{USR2} = Event->signal(cb => \&UpdateKids, + desc => "Parent USR2 handler.", + signal => "USR2"); + +# Start procdesing events. + +$Event::DebugLevel = $DebugLevel; +Debug(9, "Parent entering event loop"); +my $ret = Event::loop(); +die "Main Event loop exited: $ret"; =pod @@ -2124,8 +2120,7 @@ sub UpdateKids { # The down side is transactions that are in flight will get timed out # (lost unless they are critical). - &Restart(); - + &KillThemAll(); } @@ -2165,8 +2160,6 @@ sub KillThemAll { Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); kill 'QUIT' => $pid; } - - } @@ -2211,6 +2204,14 @@ sub Terminate { exit 0; } + +sub my_hostname { + use Sys::Hostname; + my $name = &hostname(); + &Debug(9,"Name is $name"); + return $name; +} + =pod =head1 Theory