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

Diff for /loncom/loncnew between versions 1.57.2.1 and 1.61

version 1.57.2.1, 2005/01/19 21:38:25 version 1.61, 2004/09/29 10:37:35
Line 61  use LONCAPA::LondConnection; Line 61  use LONCAPA::LondConnection;
 use LONCAPA::LondTransaction;  use LONCAPA::LondTransaction;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::HashIterator;  use LONCAPA::HashIterator;
 use Fcntl qw(:flock);  
   
   
 # Read the httpd configuration file to get perl variables  # Read the httpd configuration file to get perl variables
Line 107  my $LondVersion     = "unknown"; # Versi Line 106  my $LondVersion     = "unknown"; # Versi
 my $KeyMode         = "";       # e.g. ssl, local, insecure from last connect.  my $KeyMode         = "";       # e.g. ssl, local, insecure from last connect.
 my $LondConnecting  = 0;       # True when a connection is being built.  my $LondConnecting  = 0;       # True when a connection is being built.
   
   
   # 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.
   
 #  #
Line 384  sub Tick { Line 386  sub Tick {
  $KeyMode = "";    $KeyMode = ""; 
  $clock_watcher->cancel();   $clock_watcher->cancel();
     }      }
     &UpdateStatus();  
 }  }
   
 =pod  =pod
Line 1397  sub NewClient { Line 1398  sub NewClient {
 Returns the name of the UNIX socket on which to listen for client  Returns the name of the UNIX socket on which to listen for client
 connections.  connections.
   
   =head2 Parameters:
   
       host (optional)  - Name of the host socket to return.. defaults to
                          the return from GetServerHost().
   
 =cut  =cut
   
 sub GetLoncSocketPath {  sub GetLoncSocketPath {
     return $UnixSocketDir."/".GetServerHost();  
       my $host = GetServerHost(); # Default host.
       if (@_) {
    ($host)  = @_; # Override if supplied.
       }
       return $UnixSocketDir."/".$host;
 }  }
   
 =pod  =pod
Line 1437  connection.  The event handler establish Line 1448  connection.  The event handler establish
 (creating a communcations channel), that int turn will establish  (creating a communcations channel), that int turn will establish
 another event handler to subess requests.  another event handler to subess requests.
   
   =head2  Parameters:
   
      host (optional)   Name of the host to set up a unix socket to.
   
 =cut  =cut
   
 sub SetupLoncListener {  sub SetupLoncListener {
   
       my $host       = GetServerHost(); # Default host.
       if (@_) {
    ($host)    = @_ # Override host with parameter.
       }
   
     my $socket;      my $socket;
     my $SocketName = GetLoncSocketPath();      my $SocketName = GetLoncSocketPath($host);
     unlink($SocketName);      unlink($SocketName);
     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";   die "Failed to create a lonc listner socket";
     }      }
     Event->io(cb     => \&NewClient,      return $socket;
       poll   => 'r',  
       desc   => 'Lonc listener Unix Socket',  
       fd     => $socket);  
 }  }
   
 #  #
Line 1490  sub ChildStatus { Line 1507  sub ChildStatus {
   
     Debug(2, "Reporting child status because : ".$watcher->data);      Debug(2, "Reporting child status because : ".$watcher->data);
     my $docdir = $perlvar{'lonDocRoot'};      my $docdir = $perlvar{'lonDocRoot'};
           my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
     open(LOG,">>$docdir/lon-status/loncstatus.txt");      print $fh $$."\t".$RemoteHost."\t".$Status."\t".
     flock(LOG,LOCK_EX);  
     print LOG $$."\t".$RemoteHost."\t".$Status."\t".  
  $RecentLogEntry."\n";   $RecentLogEntry."\n";
     #      #
     #  Write out information about each of the connections:      #  Write out information about each of the connections:
     #      #
     if ($DebugLevel > 2) {      if ($DebugLevel > 2) {
  print LOG "Active connection statuses: \n";   print $fh "Active connection statuses: \n";
  my $i = 1;   my $i = 1;
  print STDERR  "================================= Socket Status Dump:\n";   print STDERR  "================================= Socket Status Dump:\n";
  foreach my $item (keys %ActiveConnections) {   foreach my $item (keys %ActiveConnections) {
     my $Socket = $ActiveConnections{$item}->data;      my $Socket = $ActiveConnections{$item}->data;
     my $state  = $Socket->GetState();      my $state  = $Socket->GetState();
     print LOG "Connection $i State: $state\n";      print $fh "Connection $i State: $state\n";
     print STDERR "---------------------- Connection $i \n";      print STDERR "---------------------- Connection $i \n";
     $Socket->Dump(-1); # Ensure it gets dumped..      $Socket->Dump(-1); # Ensure it gets dumped..
     $i++;      $i++;
  }   }
     }      }
     flock(LOG,LOCK_UN);  
     close(LOG);  
     $ConnectionRetriesLeft = $ConnectionRetries;      $ConnectionRetriesLeft = $ConnectionRetries;
 }  }
   
Line 1558  sub ToggleDebug { Line 1571  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
   
Line 1566  sub ChildProcess { Line 1582  sub ChildProcess {
   
     #      #
     #  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 1584  sub ChildProcess { Line 1600  sub ChildProcess {
   data     => "INT");    data     => "INT");
   
           
     SetupLoncListener();      my ($socket) = @_;
       if (!$socket) {
   
    $socket =  SetupLoncListener();
       }
       Event->io(cb   => \&NewClient,
         poll => 'r',
         desc => 'Lonc Listener Unix Socket',
         fd   => $socket);
           
     $Event::Debuglevel = $DebugLevel;      $Event::Debuglevel = $DebugLevel;
           
Line 1592  sub ChildProcess { Line 1616  sub ChildProcess {
   
 # Setup the initial server connection:  # Setup the initial server connection:
           
      # &MakeLondConnection(); // let first work requirest do it.       # &MakeLondConnection(); // let first work requirest do it.
   
   
     Debug(9,"Entering event loop");      Debug(9,"Entering event loop");
Line 1624  sub CreateChild { Line 1648  sub CreateChild {
  sigprocmask(SIG_UNBLOCK, $sigset);   sigprocmask(SIG_UNBLOCK, $sigset);
  ChildProcess; # Does not return.   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.
   #     Setup an event to handle the child process exit. (SIGCHLD).
   # Parameter:
   #    event       - The event object that was created to monitor this socket.
   #                  event->w->fd is the socket.
   # Returns:
   #    NONE
   #
   sub parent_client_connection {
       die "DieWhenIdle processing not completely operational yet";
   
 }  }
   
   # 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);
       if (!$socket) {
    die "Unable to create a listen socket for $loncapa_host";
       }
       
       my $lock_file = &GetLoncSocketPath().".lock";
       unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
   
       Event->io(cb    => &parent_client_connection,
         poll  => 'r',
         desc  => 'Parent listener unix socket',
         fd    => $socket);
   
   }
   
   
   # 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();
       }
   }
   
 #  #
 #  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 1675  Log("CRITICAL", "--------------- Startin Line 1780  Log("CRITICAL", "--------------- Startin
   
 LondConnection::ReadConfig;               # Read standard config files.  LondConnection::ReadConfig;               # Read standard config files.
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
 while (! $HostIterator->end()) {  
   
     my $hostentryref = $HostIterator->get();  if ($DieWhenIdle) {
     CreateChild($hostentryref->[0]);      $RemoteHost = "[parent]";
     $HostHash{$hostentryref->[0]} = $hostentryref->[4];      &listen_on_all_unix_sockets();
     $HostIterator->next();  } else {
       
       while (! $HostIterator->end()) {
   
    my $hostentryref = $HostIterator->get();
    CreateChild($hostentryref->[0]);
    $HostHash{$hostentryref->[0]} = $hostentryref->[4];
    $HostIterator->next();
       }
 }  }
   
 $RemoteHost = "Parent Server";  $RemoteHost = "Parent Server";
   
 # Maintain the population:  # Maintain the population:
   
 ShowStatus("Parent keeping the flock");  ShowStatus("Parent keeping the flock");
   
 #  
 #   Set up parent signals:  
 #  
   
 $SIG{INT}  = \&Terminate;  if ($DieWhenIdle) {
 $SIG{TERM} = \&Terminate;       $Event::DebugLevel = $DebugLevel;
 $SIG{HUP}  = \&Restart;      Debug(9, "Parent entering event loop");
 $SIG{USR1} = \&CheckKids;       my $ret = Event::loop();
 $SIG{USR2} = \&UpdateKids; # LonManage update request.      die "Main Event loop exited: $ret";
   
 while(1) {  
     my $deadchild = wait();  } else {
     if(exists $ChildHash{$deadchild}) { # need to restart.      #
  my $deadhost = $ChildHash{$deadchild};      #   Set up parent signals:
  delete($HostToPid{$deadhost});      #
  delete($ChildHash{$deadchild});      
  Log("WARNING","Lost child pid= ".$deadchild.      $SIG{INT}  = \&Terminate;
       "Connected to host ".$deadhost);      $SIG{TERM} = \&Terminate; 
  Log("INFO", "Restarting child procesing ".$deadhost);      $SIG{HUP}  = \&Restart;
  CreateChild($deadhost);      $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);
    }
     }      }
 }  }
   
   
   
 =pod  =pod
   
 =head1 CheckKids  =head1 CheckKids
Line 1735  sub CheckKids { Line 1857  sub CheckKids {
     foreach my $pid (keys %ChildHash) {      foreach my $pid (keys %ChildHash) {
  Debug(2, "Sending USR1 -> $pid");   Debug(2, "Sending USR1 -> $pid");
  kill 'USR1' => $pid; # Tell Child to report status.   kill 'USR1' => $pid; # Tell Child to report status.
    sleep 1; # Wait so file doesn't intermix.
     }      }
 }  }
   
Removed from v.1.57.2.1  
changed lines
  Added in v.1.61

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