Diff for /loncom/loncnew between versions 1.78 and 1.82

version 1.78, 2007/03/28 00:05:38 version 1.82, 2007/03/28 21:44:05
Line 60  use LONCAPA::Stack; Line 60  use LONCAPA::Stack;
 use LONCAPA::LondConnection;  use LONCAPA::LondConnection;
 use LONCAPA::LondTransaction;  use LONCAPA::LondTransaction;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::HashIterator;  
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   
   
Line 74  my %perlvar    = %{$perlvarref}; Line 73  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 96  my $executable      = $0; # Get the full Line 93  my $executable      = $0; # Get the full
 #  The variables below are only used by the child processes.  #  The variables below are only used by the child processes.
 #  #
 my $RemoteHost; # Name of host child is talking to.  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 $UnixSocketDir= $perlvar{'lonSockDir'};
 my $IdleConnections = Stack->new(); # Set of idle connections  my $IdleConnections = Stack->new(); # Set of idle connections
 my %ActiveConnections; # Connections to the remote lond.  my %ActiveConnections; # Connections to the remote lond.
Line 114  my $LondConnecting  = 0;       # True wh Line 113  my $LondConnecting  = 0;       # True wh
   
   
   
 my $DieWhenIdle     = 1; # When true children die when trimmed -> 0.  
 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);      unlink(&GetLoncSocketPath());
  if ($hosts_tab) {  
     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 370  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 1156  sub LondWritable { Line 1148  sub LondWritable {
     }      }
           
 }  }
   
 =pod  =pod
           
 =cut  =cut
   
   
 sub QueueDelayed {  sub QueueDelayed {
     Debug(3,"QueueDelayed called");      Debug(3,"QueueDelayed called");
   
Line 1168  sub QueueDelayed { Line 1162  sub QueueDelayed {
     Debug(4, "Delayed path: ".$path);      Debug(4, "Delayed path: ".$path);
     opendir(DIRHANDLE, $path);      opendir(DIRHANDLE, $path);
   
     my @all_host_ids;      my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@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 @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE));      my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE));
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     foreach my $dfname (sort(@alldelayed)) {      foreach my $dfname (sort(@alldelayed)) {
Line 1212  sub MakeLondConnection { Line 1197  sub MakeLondConnection {
   .GetServerPort());    .GetServerPort());
   
     my $Connection = LondConnection->new(&GetServerHost(),      my $Connection = LondConnection->new(&GetServerHost(),
  &GetServerPort());   &GetServerPort(),
    &GetHostId());
   
     if($Connection eq undef) { # Needs to be more robust later.      if($Connection eq undef) { # Needs to be more robust later.
  Log("CRITICAL","Failed to make a connection with lond.");   Log("CRITICAL","Failed to make a connection with lond.");
Line 1220  sub MakeLondConnection { Line 1206  sub MakeLondConnection {
  return 0; # Failure.   return 0; # Failure.
     }  else {      }  else {
   
    $LondConnecting = 1; # Connection in progress.
  # The connection needs to have writability    # The connection needs to have writability 
  # monitored in order to send the init sequence   # monitored in order to send the init sequence
  # that starts the whole authentication/key   # that starts the whole authentication/key
Line 1250  sub MakeLondConnection { Line 1237  sub MakeLondConnection {
  }   }
  Log("SUCESS", "Created connection ".$ConnectionCount   Log("SUCESS", "Created connection ".$ConnectionCount
     ." to host ".GetServerHost());      ." to host ".GetServerHost());
  $LondConnecting = 1; # Connection in progress.  
  return 1; # Return success.   return 1; # Return success.
     }      }
           
Line 1413  sub ClientRequest { Line 1399  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 1502  sub GetServerHost { Line 1488  sub GetServerHost {
   
 =pod  =pod
   
   =head2 GetServerId
   
   Returns the hostid whose lond we talk with.
   
   =cut
   
   sub GetHostId {
       return $RemoteHostId; # Setup by the fork.
   }
   
   =pod
   
 =head2 GetServerPort  =head2 GetServerPort
   
 Returns the lond port number.  Returns the lond port number.
Line 1665  Optional parameter: Line 1663  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 1741  sub ChildProcess { Line 1739  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 1758  sub ChildProcess { Line 1753  sub ChildProcess {
 #  Create a new child for host passed in:  #  Create a new child for host passed in:
   
 sub CreateChild {  sub CreateChild {
     my ($host, $socket) = @_;      my ($host, $hostid) = @_;
   
     my $sigset = POSIX::SigSet->new(SIGINT);      my $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset);      sigprocmask(SIG_BLOCK, $sigset);
Line 1768  sub CreateChild { Line 1763  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);
    undef(@all_host_ids);
     } else { # child.      } else { # child.
    $RemoteHostId = $hostid;
  ShowStatus("Connected to ".$RemoteHost);   ShowStatus("Connected to ".$RemoteHost);
  $SIG{INT} = 'DEFAULT';   $SIG{INT} = 'DEFAULT';
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
  if(defined $socket) {   &ChildProcess(); # Does not return.
     &ChildProcess($socket);  
  } else {  
     ChildProcess; # Does not return.  
  }  
     }      }
 }  }
   
Line 1807  sub parent_client_connection { Line 1798  sub parent_client_connection {
  my ($event)   = @_;   my ($event)   = @_;
  my $watcher   = $event->w;   my $watcher   = $event->w;
  my $socket    = $watcher->fd;   my $socket    = $watcher->fd;
  if ($hosts_tab) {   my $connection = $socket->accept(); # Accept the client connection.
    Event->io(cb      => \&get_remote_hostname,
     # Lookup the host associated with this socket:    poll    => 'r',
     data    => "",
     my $host = $listening_to{$socket};    fd      => $connection);
   
     # 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();  
   
  } else {  
     my $connection = $socket->accept(); # Accept the client connection.  
     Event->io(cb      => \&get_remote_hostname,  
       poll    => 'r',  
       data    => "",  
       fd      => $connection);  
  }  
     }      }
 }  }
   
 sub get_remote_hostname {  sub get_remote_hostname {
  my ($event)   = @_;      my ($event)   = @_;
  my $watcher   = $event->w;      my $watcher   = $event->w;
  my $socket    = $watcher->fd;      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;      my $thisread;
  $watcher->data($data);      my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
  if($data =~ /\n$/) { # Request entirely read.      Debug(8, "rcv:  data length = ".length($thisread)." read =".$thisread);
     chomp($data);      if (!defined($rv) || length($thisread) == 0) {
  } else {   # Likely eof on socket.
     return;   Debug(5,"Client Socket closed on lonc for p_c_c");
  }   close($socket);
    $watcher->cancel();
  &Debug(5,"Creating child for $data (parent_client_connection)");   return;
  &CreateChild($data);      }
   
  # Clean up the listen since now the child takes over until it exits.      my $data    = $watcher->data().$thisread;
  $watcher->cancel(); # Nolonger listening to this event      $watcher->data($data);
  $socket->send("done\n");      if($data =~ /\n$/) { # Request entirely read.
  $socket->close();   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:  # parent_listen:
Line 1983  sub server_died { Line 1953  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});      &parent_clean_up($host);
     if ($hosts_tab) {  
  &parent_listen($host);  
     } else {  
  &parent_clean_up($host);  
     }  
       
  } else {   } else {
     &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");      &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
  }   }
Line 2045  ShowStatus("Forking node servers"); Line 2010  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]";  &listen_on_common_socket();
     if ($hosts_tab) {  
  &listen_on_all_unix_sockets();  
     } else {  
  &listen_on_common_socket();  
     }  
 } else {  
       
     while (! $HostIterator->end()) {  
   
  my $hostentryref = $HostIterator->get();  
  CreateChild($hostentryref->[0]);  
  $HostHash{$hostentryref->[0]} = $hostentryref->[4];  
  $HostIterator->next();  
     }  
 }  
   
 $RemoteHost = "Parent Server";  $RemoteHost = "Parent Server";
   
Line 2072  $RemoteHost = "Parent Server"; Line 2021  $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";  
   
   
 } else {  
     #  
     #   Set up parent signals:  
     #  
       
     $SIG{INT}  = \&Terminate;  
     $SIG{TERM} = \&Terminate;   
     if ($hosts_tab) {  
  $SIG{HUP}  = \&Restart;  
     } else {  
  $SIG{HUP}  = \&KillThemAll;  
     }  
     $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);  
  }  
     }  
 }  
   
   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  =pod
   
Line 2211  sub UpdateKids { Line 2120  sub UpdateKids {
     # The down side is transactions that are in flight will get timed out      # The down side is transactions that are in flight will get timed out
     # (lost unless they are critical).      # (lost unless they are critical).
   
     if ($hosts_tab) {      &KillThemAll();
  &Restart();  
     } else {  
  &KillThemAll();  
     }  
 }  }
   
   
Line 2299  sub Terminate { Line 2204  sub Terminate {
     exit 0;      exit 0;
   
 }  }
   
   sub my_hostname {
       use Sys::Hostname;
       my $name = &hostname();
       &Debug(9,"Name is $name");
       return $name;
   }
   
 =pod  =pod
   
 =head1 Theory  =head1 Theory

Removed from v.1.78  
changed lines
  Added in v.1.82


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