[BACK]Return to loncnew CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/loncnew between versions 1.60 and 1.63

version 1.60, 2004/09/22 11:11:54 version 1.63, 2004/10/04 11:30:45
Line 75  my %perlvar    = %{$perlvarref}; Line 75  my %perlvar    = %{$perlvarref};
 my %ChildHash; # by pid -> host.  my %ChildHash; # by pid -> host.
 my %HostToPid; # By host -> pid.  my %HostToPid; # By host -> pid.
 my %HostHash; # by loncapaname -> IP.  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. 
   
 my $MaxConnectionCount = 10; # Will get from config later.  my $MaxConnectionCount = 10; # Will get from config later.
 my $ClientConnection = 0; # Uniquifier for client events.  my $ClientConnection = 0; # Uniquifier for client events.
Line 110  my $LondConnecting  = 0;       # True wh Line 112  my $LondConnecting  = 0;       # True wh
 # DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!!  # DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!!
   
 my $DieWhenIdle     = 0; # When true children die when trimmed -> 0.  my $DieWhenIdle     = 0; # When true children die when trimmed -> 0.
   my $I_am_child      = 0; # True if this is the child process.
   
 #  #
 #   The hash below gives the HTML format for log messages  #   The hash below gives the HTML format for log messages
Line 1356  sub ClientRequest { Line 1359  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.
   # Parameters:
   #    $socket       - The listener socket.
   # Returns:
   #   NONE
   # Side Effects:
   #    An event is made to watch the accepted connection.
   #    Active clients hash is updated to reflect the new connection.
   #    The client connection count is incremented.
   #
   sub accept_client {
       my ($socket) = @_;
   
       Debug(8, "Entering accept for lonc UNIX socket\n");
       my $connection = $socket->accept(); # Accept the client connection.
       Debug(8,"Connection request accepted from "
     .GetPeername($connection, AF_UNIX));
   
   
       my $description = sprintf("Connection to lonc client %d",
         $ClientConnection);
       Debug(9, "Creating event named: ".$description);
       Event->io(cb      => \&ClientRequest,
         poll    => 'r',
         desc    => $description,
         data    => "",
         fd      => $connection);
       $ActiveClients{$connection} = $ClientConnection;
       $ClientConnection++;
   }
   
 =pod  =pod
   
Line 1374  sub NewClient { Line 1411  sub NewClient {
     my $event      = shift; # Get the event parameters.      my $event      = shift; # Get the event parameters.
     my $watcher    = $event->w;       my $watcher    = $event->w; 
     my $socket     = $watcher->fd; # Get the event' socket.      my $socket     = $watcher->fd; # Get the event' socket.
     my $connection = $socket->accept(); # Accept the client connection.  
     Debug(8,"Connection request accepted from "  
   .GetPeername($connection, AF_UNIX));  
   
   
     my $description = sprintf("Connection to lonc client %d",      &accept_client($socket);
       $ClientConnection);  
     Debug(9, "Creating event named: ".$description);  
     Event->io(cb      => \&ClientRequest,  
       poll    => 'r',  
       desc    => $description,  
       data    => "",  
       fd      => $connection);  
     $ActiveClients{$connection} = $ClientConnection;  
     $ClientConnection++;  
 }  }
   
 =pod  =pod
Line 1571  sub ToggleDebug { Line 1595  sub ToggleDebug {
 =head2 ChildProcess  =head2 ChildProcess
   
 This sub implements a child process for a single lonc daemon.  This sub implements a child process for a single lonc daemon.
   Optional parameter:
      $socket  - if provided, this is a socket already open for listen
                 on the client socket. Otherwise, a new listen is set up.
   
 =cut  =cut
   
 sub ChildProcess {  sub ChildProcess {
       #  If we are in DieWhenIdle mode, 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.
   
       my $host = GetServerHost();
       foreach my $listener (keys %parent_dispatchers) {
    my $watcher = $parent_dispatchers{$listener};
    my $s       = $watcher->fd;
    if ($listener ne $host) { # Close everyone but me.
       Debug(5, "Closing listen socket for $listener");
       $s->close();
    }
    Debug(5, "Killing watcher for $listener");
   
    $watcher->cancel();
    undef         $parent_dispatchers{$listener};
   
       }
       $I_am_child    = 1; # Seems like in spite of it all I'm still getting
                                   # parent event dispatches. 
   
   
     #      #
     #  Signals must be handled by the Event framework...      #  Signals must be handled by the Event framework...
 #      #
   
     Event->signal(signal   => "QUIT",      Event->signal(signal   => "QUIT",
   cb       => \&SignalledToDeath,    cb       => \&SignalledToDeath,
Line 1596  sub ChildProcess { Line 1644  sub ChildProcess {
   cb       => \&ToggleDebug,    cb       => \&ToggleDebug,
   data     => "INT");    data     => "INT");
   
           #  Figure out if we got passed a socket or need to open one to listen for
     my $socket =  SetupLoncListener();      #  client requests.
   
       my ($socket) = @_;
       if (!$socket) {
   
    $socket =  SetupLoncListener();
       }
       #  Establish an event to listen for client connection requests.
   
   
     Event->io(cb   => \&NewClient,      Event->io(cb   => \&NewClient,
       poll => 'r',        poll => 'r',
       desc => 'Lonc Listener Unix Socket',        desc => 'Lonc Listener Unix Socket',
Line 1609  sub ChildProcess { Line 1666  sub ChildProcess {
   
 # Setup the initial server connection:  # Setup the initial server connection:
           
      # &MakeLondConnection(); // let first work requirest do it.       # &MakeLondConnection(); // let first work request do it.
   
       #  If We are in diwhenidle, need to accept the connection since the
       #  event may  not fire.
   
       if ($DieWhenIdle) {
    &accept_client($socket);
       }
   
     Debug(9,"Entering event loop");      Debug(9,"Entering event loop");
     my $ret = Event::loop(); #  Start the main event loop.      my $ret = Event::loop(); #  Start the main event loop.
Line 1622  sub ChildProcess { Line 1685  sub ChildProcess {
 #  Create a new child for host passed in:  #  Create a new child for host passed in:
   
 sub CreateChild {  sub CreateChild {
     my $host = shift;      my ($host, $socket) = @_;
   
     my $sigset = POSIX::SigSet->new(SIGINT);      my $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset);      sigprocmask(SIG_BLOCK, $sigset);
Line 1639  sub CreateChild { Line 1702  sub CreateChild {
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  $SIG{INT} = 'DEFAULT';   $SIG{INT} = 'DEFAULT';
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
  ChildProcess; # Does not return.   if(defined $socket) {
       &ChildProcess($socket);
    } else {
       ChildProcess; # Does not return.
    }
       }
   }
   
   # parent_client_connection:
   #    Event handler that processes client connections for the parent process.
   #    This sub is called when the parent is listening on a socket and
   #    a connection request arrives.  We must:
   #     Start a child process to accept the connection request.
   #     Kill our listen on the socket.
   # Parameter:
   #    event       - The event object that was created to monitor this socket.
   #                  event->w->fd is the socket.
   # Returns:
   #    NONE
   #
   sub parent_client_connection {
       if ($I_am_child) {
    #  Should not get here, but seem to anyway:
    &Debug(5," Child caught parent client connection event!!");
    my ($event) = @_;
    my $watcher = $event->w;
    $watcher->cancel(); # Try to kill it off again!!
       } else {
    &Debug(9, "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();
       }
   }
   
   # parent_listen:
   #    Opens a socket and starts a listen for the parent process on a client UNIX
   #    domain socket.
   #
   #    This involves:
   #       Creating a socket for listen.
   #       Removing any socket lock file
   #       Adding an event handler for this socket becoming readable
   #         To the parent's event dispatcher.
   # Parameters:
   #    loncapa_host    - LonCAPA cluster name of the host represented by the client
   #                      socket.
   # Returns:
   #    NONE
   #
   sub parent_listen {
       my ($loncapa_host) = @_;
       Debug(5, "parent_listen: $loncapa_host");
   
       my $socket    = &SetupLoncListener($loncapa_host);
       $listening_to{$socket} = $loncapa_host;
       if (!$socket) {
    die "Unable to create a listen socket for $loncapa_host";
       }
       
       my $lock_file = &GetLoncSocketPath($loncapa_host).".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);
       $parent_dispatchers{$loncapa_host} = $watcher;
   
   }
   
   
   # listen_on_all_unix_sockets:
   #    This sub initiates a listen on all unix domain lonc client sockets.
   #    This will be called in the case where we are trimming idle processes.
   #    When idle processes are trimmed, loncnew starts up with no children,
   #    and only spawns off children when a connection request occurs on the
   #    client unix socket.  The spawned child continues to run until it has
   #    been idle a while at which point it eventually exits and once more
   #    the parent picks up the listen.
   #
   #  Parameters:
   #      NONE
   #  Implicit Inputs:
   #    The configuration file that has been read in by LondConnection.
   #  Returns:
   #     NONE
   #
   sub listen_on_all_unix_sockets {
       Debug(5, "listen_on_all_unix_sockets");
       my $host_iterator      =   &LondConnection::GetHostIterator();
       while (!$host_iterator->end()) {
    my $host_entry_ref =   $host_iterator->get();
    my $host_name      = $host_entry_ref->[0];
    Debug(9, "Listen for $host_name");
    &parent_listen($host_name);
    $host_iterator->next();
       }
   }
   
   #   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
   #   is to:
   #      - Remove the child from the bookeeping hashes
   #      - Re-establish a listen on the unix domain socket associated
   #        with that host.
   # Parameters:
   #    The event, but we don't actually care about it.
   sub server_died {
       &Debug(9, "server_died called...");
       
       while(1) { # Loop until waitpid nowait fails.
    my $pid = waitpid(-1, WNOHANG);
    if($pid <= 0) {
       return; # Nothing left to wait for.
    }
    # need the host to restart:
   
    my $host = $ChildHash{$pid};
    if($host) { # It's for real...
       &Debug(9, "Caught sigchild for $host");
       delete($ChildHash{$pid});
       delete($HostToPid{$host});
       &parent_listen($host);
   
    } else {
       &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
    }
     }      }
   
 }  }
   
 #  #
 #  Parent process logic pass 1:  #  Parent process logic pass 1:
 #   For each entry in the hosts table, we will  #   For each entry in the hosts table, we will
Line 1694  LondConnection::ReadConfig; Line 1904  LondConnection::ReadConfig;
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
   
 if ($DieWhenIdle) {  if ($DieWhenIdle) {
     print "Die when idle socket monitoring is not yet implemented\n";      $RemoteHost = "[parent]";
     exit(-1);      &listen_on_all_unix_sockets();
 } else {  } else {
           
     while (! $HostIterator->end()) {      while (! $HostIterator->end()) {
Line 1713  $RemoteHost = "Parent Server"; Line 1923  $RemoteHost = "Parent Server";
   
 ShowStatus("Parent keeping the flock");  ShowStatus("Parent keeping the flock");
   
 #  
 #   Set up parent signals:  
 #  
   
 if ($DieWhenIdle) {  if ($DieWhenIdle) {
     print "Die when idle main processing not yet implemented";      # We need to setup a SIGChild event to handle the exit (natural or otherwise)
     exit (-1);      # of the children.
   
       Event->signal(cb       => \&server_died,
      desc     => "Child exit handler",
      signal   => "CHLD");
   
   
       $Event::DebugLevel = $DebugLevel;
       Debug(9, "Parent entering event loop");
       my $ret = Event::loop();
       die "Main Event loop exited: $ret";
   
   
 } else {  } else {
       #
       #   Set up parent signals:
       #
           
     $SIG{INT}  = \&Terminate;      $SIG{INT}  = \&Terminate;
     $SIG{TERM} = \&Terminate;       $SIG{TERM} = \&Terminate; 
Removed from v.1.60  
changed lines
  Added in v.1.63

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>