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

Diff for /loncom/loncnew between versions 1.61 and 1.64

version 1.61, 2004/09/29 10:37:35 version 1.64, 2004/10/05 10:10:31
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 299  sub SocketTimeout { Line 302  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.
   # Parameters:
   #     exit_code           - Exit status value, however see the next parameter.
   #     message             - If this optional parameter is supplied, the exit
   #                           is via a die with this message.
   #
   sub child_exit {
       my ($exit_code, $message) = @_;
   
       # 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:
   
       if($message) {
    die $message;
       } else {
    exit($exit_code);
       }
   }
 #----------------------------- Timer management ------------------------  #----------------------------- Timer management ------------------------
   
 =pod  =pod
Line 329  sub Tick { Line 370  sub Tick {
     $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.      $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
     UpdateStatus();      UpdateStatus();
     if(($ConnectionCount == 0) && $DieWhenIdle) {      if(($ConnectionCount == 0) && $DieWhenIdle) {
  #   &child_exit(0);
  #  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);  
     }      }
  }   }
     } else {      } else {
Line 1174  sub MakeLondConnection { Line 1205  sub MakeLondConnection {
  #   #
  my $Socket = $Connection->GetSocket();   my $Socket = $Connection->GetSocket();
  if($Socket eq undef) {   if($Socket eq undef) {
     die "did not get a socket from the connection";      &child_exit(-1, "did not get a socket from the connection");
  } else {   } else {
     &Debug(9,"MakeLondConnection got socket: ".$Socket);      &Debug(9,"MakeLondConnection got socket: ".$Socket);
  }   }
Line 1356  sub ClientRequest { Line 1387  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 1439  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 1467  sub SetupLoncListener { Line 1519  sub SetupLoncListener {
     unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,      unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
     Listen => 250,       Listen => 250, 
     Type   => SOCK_STREAM)) {      Type   => SOCK_STREAM)) {
  die "Failed to create a lonc listner socket";   if($I_am_child) {
       &child_exit(-1, "Failed to create a lonc listener socket");
    } else {
       die "Failed to create a lonc listner socket";
    }
     }      }
     return $socket;      return $socket;
 }  }
Line 1578  Optional parameter: Line 1634  Optional parameter:
 =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 may still getting
                                   # parent event dispatches.. flag I'm a child.
   
   
     #      #
Line 1599  sub ChildProcess { Line 1676  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
       #  client requests.
   
     my ($socket) = @_;      my ($socket) = @_;
     if (!$socket) {      if (!$socket) {
   
  $socket =  SetupLoncListener();   $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 1616  sub ChildProcess { Line 1698  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.
           
           
     die "Main event loop exited!!!";      &child_exit (-1,"Main event loop exited!!!");
 }  }
   
 #  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 1646  sub CreateChild { Line 1734  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.
    }
     }      }
 }  }
   
Line 1656  sub CreateChild { Line 1748  sub CreateChild {
 #    a connection request arrives.  We must:  #    a connection request arrives.  We must:
 #     Start a child process to accept the connection request.  #     Start a child process to accept the connection request.
 #     Kill our listen on the socket.  #     Kill our listen on the socket.
 #     Setup an event to handle the child process exit. (SIGCHLD).  
 # Parameter:  # Parameter:
 #    event       - The event object that was created to monitor this socket.  #    event       - The event object that was created to monitor this socket.
 #                  event->w->fd is the socket.  #                  event->w->fd is the socket.
Line 1664  sub CreateChild { Line 1755  sub CreateChild {
 #    NONE  #    NONE
 #  #
 sub parent_client_connection {  sub parent_client_connection {
     die "DieWhenIdle processing not completely operational yet";      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:  # parent_listen:
Line 1688  sub parent_listen { Line 1807  sub parent_listen {
     Debug(5, "parent_listen: $loncapa_host");      Debug(5, "parent_listen: $loncapa_host");
   
     my $socket    = &SetupLoncListener($loncapa_host);      my $socket    = &SetupLoncListener($loncapa_host);
       $listening_to{$socket} = $loncapa_host;
     if (!$socket) {      if (!$socket) {
  die "Unable to create a listen socket for $loncapa_host";   die "Unable to create a listen socket for $loncapa_host";
     }      }
           
     my $lock_file = &GetLoncSocketPath().".lock";      my $lock_file = &GetLoncSocketPath($loncapa_host).".lock";
     unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]      unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
   
     Event->io(cb    => &parent_client_connection,      my $watcher = Event->io(cb    => \&parent_client_connection,
       poll  => 'r',        poll  => 'r',
       desc  => 'Parent listener unix socket',        desc  => "Parent listener unix socket ($loncapa_host)",
       fd    => $socket);        fd    => $socket);
       $parent_dispatchers{$loncapa_host} = $watcher;
   
 }  }
   
Line 1731  sub listen_on_all_unix_sockets { Line 1852  sub listen_on_all_unix_sockets {
     }      }
 }  }
   
   #   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 1803  ShowStatus("Parent keeping the flock"); Line 1957  ShowStatus("Parent keeping the flock");
   
   
 if ($DieWhenIdle) {  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");
   
   
     $Event::DebugLevel = $DebugLevel;      $Event::DebugLevel = $DebugLevel;
     Debug(9, "Parent entering event loop");      Debug(9, "Parent entering event loop");
     my $ret = Event::loop();      my $ret = Event::loop();
Removed from v.1.61  
changed lines
  Added in v.1.64

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