Diff for /loncom/loncnew between versions 1.77 and 1.80

version 1.77, 2007/03/27 19:38:36 version 1.80, 2007/03/28 00:23:46
Line 74  my %perlvar    = %{$perlvarref}; Line 74  my %perlvar    = %{$perlvarref};
 #  parent and shared variables.  #  parent and shared variables.
   
 my %ChildHash; # by pid -> host.  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  my %listening_to; # Socket->host table for who the parent
                                 # is listening to.                                  # is listening to.
 my %parent_dispatchers;         # host-> listener watcher events.   my %parent_dispatchers;         # host-> listener watcher events. 
Line 114  my $LondConnecting  = 0;       # True wh Line 112  my $LondConnecting  = 0;       # True wh
   
   
   
 my $DieWhenIdle     = 1; # When true children die when trimmed -> 0.  my $hosts_tab       = 0;        # True if we are using a static hosts.tab
 my $hosts_tab       = 1;        # True if we are using a static hosts.tab  
 my $I_am_child      = 0; # True if this is the child process.  my $I_am_child      = 0; # True if this is the child process.
   
 #  #
Line 309  sub SocketTimeout { Line 306  sub SocketTimeout {
     }      }
   
 }  }
   
 #  #
 #   This function should be called by the child in all cases where it must  #   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  #   exit.  The child process must create a lock file for the AF_UNIX socket
 #   it must create a lock file for the AF_UNIX socket in order to prevent  #   in order to prevent connection requests from lonnet in the time between
 #   connection requests from lonnet in the time between process exit  #   process exit and the parent picking up the listen again.
 #   and the parent picking up the listen again.  #
 # Parameters:  # Parameters:
 #     exit_code           - Exit status value, however see the next parameter.  #     exit_code           - Exit status value, however see the next parameter.
 #     message             - If this optional parameter is supplied, the exit  #     message             - If this optional parameter is supplied, the exit
Line 325  sub child_exit { Line 323  sub child_exit {
   
     # Regardless of how we exit, we may need to do the lock thing:      # 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
  #  Create a lock file since there will be a time window      #  between our exit and the parent's picking up the listen
  #  between our exit and the parent's picking up the listen      #  during which no listens will be done on the
  #  during which no listens will be done on the      #  lonnet client socket.
  #  lonnet client socket.      #
  #      my $lock_file = &GetLoncSocketPath().".lock";
  my $lock_file = &GetLoncSocketPath().".lock";      open(LOCK,">$lock_file");
  open(LOCK,">$lock_file");      print LOCK "Contents not important";
  print LOCK "Contents not important";      close(LOCK);
  close(LOCK);      if ($hosts_tab) {
  if ($hosts_tab) {   unlink(&GetLoncSocketPath());
     unlink(&GetLoncSocketPath());  
  }  
  exit(0);  
     }      }
     #  Now figure out how we exit:  
   
     if($message) {      if ($message) {
  die $message;   die($message);
     } else {      } else {
  exit($exit_code);   exit($exit_code);
     }      }
Line 378  sub Tick { Line 372  sub Tick {
     KillSocket($Socket);      KillSocket($Socket);
     $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)) {
  &child_exit(0);   &child_exit(0);
   
     }      }
Line 1413  sub ClientRequest { Line 1407  sub ClientRequest {
 #     Accept a connection request for a client (lonc child) and  #     Accept a connection request for a client (lonc child) and
 #    start up an event watcher to keep an eye on input from that   #    start up an event watcher to keep an eye on input from that 
 #    Event.  This can be called both from NewClient and from  #    Event.  This can be called both from NewClient and from
 #    ChildProcess if we are started in DieWhenIdle mode.  #    ChildProcess.
 # Parameters:  # Parameters:
 #    $socket       - The listener socket.  #    $socket       - The listener socket.
 # Returns:  # Returns:
Line 1529  another event handler to subess requests Line 1523  another event handler to subess requests
 =cut  =cut
   
 sub SetupLoncListener {  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);      unlink($SocketName);
   
       my $socket;
     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)) {
Line 1666  Optional parameter: Line 1659  Optional parameter:
 =cut  =cut
   
 sub ChildProcess {  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      #  events of our parent and those have to be cancelled or else
     #  all holy bloody chaos will result.. trust me, I already made      #  all holy bloody chaos will result.. trust me, I already made
     #  >that< mistake.      #  >that< mistake.
Line 1742  sub ChildProcess { Line 1735  sub ChildProcess {
           
      # &MakeLondConnection(); // let first work request do it.       # &MakeLondConnection(); // let first work request do it.
   
     #  If We are in diwhenidle, need to accept the connection since the      #  need to accept the connection since the event may  not fire.
     #  event may  not fire.  
   
     if ($DieWhenIdle) {      &accept_client($socket);
  &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 1769  sub CreateChild { Line 1759  sub CreateChild {
     if($pid) { # Parent      if($pid) { # Parent
  $RemoteHost = "Parent";   $RemoteHost = "Parent";
  $ChildHash{$pid} = $host;   $ChildHash{$pid} = $host;
  $HostToPid{$host}= $pid;  
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
   
     } else { # child.      } else { # child.
Line 1844  sub get_remote_hostname { Line 1833  sub get_remote_hostname {
  my $socket    = $watcher->fd;   my $socket    = $watcher->fd;
   
  my $thisread;   my $thisread;
  my $rv = $socket->recv($thisread, 1, 0);   my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
  Debug(8, "rcv:  data length = ".length($thisread)." read =".$thisread);   Debug(8, "rcv:  data length = ".length($thisread)." read =".$thisread);
  if (!defined($rv) || length($thisread) == 0) {   if (!defined($rv) || length($thisread) == 0) {
     # Likely eof on socket.      # Likely eof on socket.
Line 1890  sub parent_listen { Line 1879  sub parent_listen {
     my ($loncapa_host) = @_;      my ($loncapa_host) = @_;
     Debug(5, "parent_listen: $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;      $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($loncapa_host).".lock";      my $lock_file = $file.".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.]
   
     my $watcher =       my $watcher = 
Line 1950  sub listen_on_all_unix_sockets { Line 1947  sub listen_on_all_unix_sockets {
   
 sub listen_on_common_socket {  sub listen_on_common_socket {
     Debug(5, "listen_on_common_socket");      Debug(5, "listen_on_common_socket");
     &parent_listen('common');      &parent_listen();
 }  }
   
 #   server_died is called whenever a child process exits.  #   server_died is called whenever a child process exits.
Line 1976  sub server_died { Line 1973  sub server_died {
  if($host) { # It's for real...   if($host) { # It's for real...
     &Debug(9, "Caught sigchild for $host");      &Debug(9, "Caught sigchild for $host");
     delete($ChildHash{$pid});      delete($ChildHash{$pid});
     delete($HostToPid{$host});  
     if ($hosts_tab) {      if ($hosts_tab) {
  &parent_listen($host);   &parent_listen($host);
     } else {      } else {
Line 2038  ShowStatus("Forking node servers"); Line 2034  ShowStatus("Forking node servers");
 Log("CRITICAL", "--------------- Starting children ---------------");  Log("CRITICAL", "--------------- Starting children ---------------");
   
 LondConnection::ReadConfig;               # Read standard config files.  LondConnection::ReadConfig;               # Read standard config files.
 my $HostIterator = LondConnection::GetHostIterator;  
   
 if ($DieWhenIdle) {  $RemoteHost = "[parent]";
     $RemoteHost = "[parent]";  if ($hosts_tab) {
     if ($hosts_tab) {      &listen_on_all_unix_sockets();
  &listen_on_all_unix_sockets();  
     } else {  
  &listen_on_common_socket();  
     }  
 } else {  } else {
           &listen_on_common_socket();
     while (! $HostIterator->end()) {  
   
  my $hostentryref = $HostIterator->get();  
  CreateChild($hostentryref->[0]);  
  $HostHash{$hostentryref->[0]} = $hostentryref->[4];  
  $HostIterator->next();  
     }  
 }  }
   
 $RemoteHost = "Parent Server";  $RemoteHost = "Parent Server";
Line 2065  $RemoteHost = "Parent Server"; Line 2049  $RemoteHost = "Parent Server";
 ShowStatus("Parent keeping the flock");  ShowStatus("Parent keeping the flock");
   
   
 if ($DieWhenIdle) {  # We need to setup a SIGChild event to handle the exit (natural or otherwise)
     # We need to setup a SIGChild event to handle the exit (natural or otherwise)  # of the children.
     # 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");  
     if ($hosts_tab) {  
  $parent_handlers{HUP}  = Event->signal(cb       => \&Restart,  
        desc     => "Parent HUP handler.",  
        signal   => "HUP");  
     } else {  
  $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";  
   
   
   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");
   if ($hosts_tab) {
       $parent_handlers{HUP}  = Event->signal(cb       => \&Restart,
      desc     => "Parent HUP handler.",
      signal   => "HUP");
 } else {  } else {
     #      $parent_handlers{HUP}  = Event->signal(cb       => \&KillThemAll,
     #   Set up parent signals:     desc     => "Parent HUP handler.",
     #     signal   => "HUP");
       }
     $SIG{INT}  = \&Terminate;  $parent_handlers{USR1} = Event->signal(cb       => \&CheckKids,
     $SIG{TERM} = \&Terminate;          desc     => "Parent USR1 handler",
     if ($hosts_tab) {         signal   => "USR1");
  $SIG{HUP}  = \&Restart;  $parent_handlers{USR2} = Event->signal(cb       => \&UpdateKids,
     } else {         desc     => "Parent USR2 handler.",
  $SIG{HUP}  = \&KillThemAll;         signal   => "USR2");
     }  
     $SIG{USR1} = \&CheckKids;   #  Start procdesing events.
     $SIG{USR2} = \&UpdateKids; # LonManage update request.  
       $Event::DebugLevel = $DebugLevel;
     while(1) {  Debug(9, "Parent entering event loop");
  my $deadchild = wait();  my $ret = Event::loop();
  if(exists $ChildHash{$deadchild}) { # need to restart.  die "Main Event loop exited: $ret";
     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);  
  }  
     }  
 }  
   
   
 =pod  =pod
   

Removed from v.1.77  
changed lines
  Added in v.1.80


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