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

Diff for /loncom/Attic/lonc between versions 1.30 and 1.32

version 1.30, 2002/02/25 20:43:15 version 1.32, 2002/03/08 03:56:19
Line 57  use Socket; Line 57  use Socket;
 use Fcntl;  use Fcntl;
 use Tie::RefHash;  use Tie::RefHash;
 use Crypt::IDEA;  use Crypt::IDEA;
 use Net::Ping;  #use Net::Ping;
 use LWP::UserAgent();  use LWP::UserAgent();
   
 $status='';  $status='';
 $lastlog='';  $lastlog='';
 $conserver='SHELL';  $conserver='SHELL';
   $DEBUG = 0; # Set to 1 for annoyingly complete logs.
   
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
Line 158  $SIG{HUP}=$SIG{USR1}='IGNORE'; Line 159  $SIG{HUP}=$SIG{USR1}='IGNORE';
 &status("Forking ...");  &status("Forking ...");
   
 foreach $thisserver (keys %hostip) {  foreach $thisserver (keys %hostip) {
     if (&online($hostname{$thisserver})) {      #if (&online($hostname{$thisserver})) {
        make_new_child($thisserver);         make_new_child($thisserver);
     }      #}
 }  }
   
 &logthis("Done starting initial servers");  &logthis("Done starting initial servers");
 # ----------------------------------------------------- Install signal handlers  # ----------------------------------------------------- Install signal handlers
   
 $SIG{CHLD} = \&REAPER;  
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;  $SIG{HUP}  = \&HUPSMAN;
 $SIG{USR1} = \&USRMAN;  $SIG{USR1} = \&USRMAN;
   
 # And maintain the population.  # And maintain the population.
 while (1) {  while (1) {
     &status("Sleeping");      my $deadpid = wait; # Wait for the next child to die.
     sleep;                          # wait for a signal (i.e., child's death)  
                                     # See who died and start new one                                      # See who died and start new one
     &status("Woke up");      &status("Woke up");
     my $skipping='';      my $skipping='';
     foreach $thisserver (keys %hostip) {  
         if (!$childpid{$thisserver}) {      if(exists($children{$deadpid})) {
     if (($childatt{$thisserver}<$childmaxattempts) &&  
                 (&online($hostname{$thisserver}))) {   $thisserver = $children{$deadpid}; # Look name of dead guy's peer.
        $childatt{$thisserver}++;  
                &logthis(   delete($children{$deadpid}); # Get rid of dead hash entry.
    "<font color=yellow>INFO: Trying to reconnect for $thisserver "  
   ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");    if($childatt{$thisserver} < $childmaxattempts) {
                make_new_child($thisserver);      $childatt{$thisserver}++;
    } else {      &logthis(
                $skipping.=$thisserver.' ';         "<font color=yellow>INFO: Trying to reconnect for $thisserver "
            }               ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
                      make_new_child($thisserver);
         }         
     }   }
     if ($skipping) {    else {
        &logthis("<font color=blue>WARNING: Skipped $skipping</font>");      $skipping .= $thisserver.' ';
    }
    if($skipping) {
       &logthis("<font color=blue>WARNING: Skipped $skipping</font>");
     
    }
     }      }
   
 }  }
   
   
   
 sub make_new_child {  sub make_new_child {
         
     $newserver=shift;      $newserver=shift;
Line 217  sub make_new_child { Line 224  sub make_new_child {
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $newserver;          $children{$pid} = $newserver;
         $childpid{$conserver} = $pid;          $childpid{$newserver} = $pid;
         return;          return;
     } else {      } else {
         $conserver=$newserver;          $conserver=$newserver;
Line 238  unlink($port); Line 245  unlink($port);
 # -------------------------------------------------------------- Open other end  # -------------------------------------------------------------- Open other end
   
 &openremote($conserver);  &openremote($conserver);
    &logthis("<font color=green> Connection to $conserver open </font>");
 # ----------------------------------------- We're online, send delayed messages  # ----------------------------------------- We're online, send delayed messages
     &status("Checking for delayed messages");      &status("Checking for delayed messages");
   
     my @allbuffered;      my @allbuffered;
     my $path="$perlvar{'lonSockDir'}/delayed";      my $path="$perlvar{'lonSockDir'}/delayed";
     opendir(DIRHANDLE,$path);      opendir(DIRHANDLE,$path);
Line 250  unlink($port); Line 258  unlink($port);
     foreach (@allbuffered) {      foreach (@allbuffered) {
         &status("Sending delayed: $_");          &status("Sending delayed: $_");
         $dfname="$path/$_";          $dfname="$path/$_";
         &logthis('Sending '.$dfname);          if($DEBUG) { &logthis('Sending '.$dfname); }
         my $wcmd;          my $wcmd;
         {          {
          my $dfh=IO::File->new($dfname);           my $dfh=IO::File->new($dfname);
Line 289  unlink($port); Line 297  unlink($port);
             &logperm("S:$conserver:$bcmd");              &logperm("S:$conserver:$bcmd");
         }                  }        
     }      }
    if($DEBUG) { &logthis("<font color=green> Delayed transactions sent"); }
   
 # ------------------------------------------------------- Listen to UNIX socket  # ------------------------------------------------------- Listen to UNIX socket
 &status("Opening socket");  &status("Opening socket");
Line 300  unless ( Line 309  unless (
        my $st=120+int(rand(240));         my $st=120+int(rand(240));
        &logthis(         &logthis(
          "<font color=blue>WARNING: ".           "<font color=blue>WARNING: ".
          "Can't make server socket ($st secs): $@</font>");           "Can't make server socket ($st secs): $@ .. exiting</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
      
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
   
 &logthis("<font color=green>$conserver online</font>");  &logthis("<font color=green>$conserver online</font>");
Line 329  while (1) { Line 338  while (1) {
     # check for new information on the connections we have      # check for new information on the connections we have
   
     # anything to read or accept?      # anything to read or accept?
     foreach $client ($select->can_read(0.1)) {  
   
       foreach $client ($select->can_read(100.0)) {
         if ($client == $server) {          if ($client == $server) {
             # accept a new connection              # accept a new connection
             &status("Accept new connection: $conserver");              &status("Accept new connection: $conserver");
Line 356  while (1) { Line 365  while (1) {
   
             $inbuffer{$client} .= $data;              $inbuffer{$client} .= $data;
   
   
             # test whether the data in the buffer or the data we              # test whether the data in the buffer or the data we
             # just read means there is a complete request waiting              # just read means there is a complete request waiting
             # to be fulfilled.  If there is, set $ready{$client}              # to be fulfilled.  If there is, set $ready{$client}
Line 365  while (1) { Line 375  while (1) {
             }              }
         }          }
     }      }
       
     # Any complete requests to process?      # Any complete requests to process?
     foreach $client (keys %ready) {      foreach $client (keys %ready) {
         handle($client);          handle($client);
     }      }
    
     # Buffers to flush?      # Buffers to flush?
     foreach $client ($select->can_write(1)) {      foreach $client ($select->can_write(1)) {
         # Skip this client if we have nothing to say          # Skip this client if we have nothing to say
Line 426  sub handle { Line 436  sub handle {
     # send output to $outbuffer{$client}      # send output to $outbuffer{$client}
     my $client = shift;      my $client = shift;
     my $request;      my $request;
   
     foreach $request (@{$ready{$client}}) {      foreach $request (@{$ready{$client}}) {
 # ============================================================= Process request  # ============================================================= Process request
         # $request is the text of the request          # $request is the text of the request
         # put text of reply into $outbuffer{$client}          # put text of reply into $outbuffer{$client}
 # ------------------------------------------------------------ Is this the end?  # ------------------------------------------------------------ Is this the end?
    if($DEBUG) {
        &logthis("<font color=green> Request $request processing starts</font>");
           }
         if ($request eq "close_connection_exit\n") {          if ($request eq "close_connection_exit\n") {
     &status("Request close connection");      &status("Request close connection");
            &logthis(             &logthis(
      "<font color=red>CRITICAL: Request Close Connection</font>");       "<font color=red>CRITICAL: Request Close Connection ... exiting</font>");
            $remotesock->shutdown(2);             $remotesock->shutdown(2);
            $server->close();             $server->close();
            exit;             exit;
Line 466  sub handle { Line 478  sub handle {
         &status("Received reply: $request");          &status("Received reply: $request");
         alarm(0);          alarm(0);
     };      };
       if($DEBUG) { 
    &logthis("<font color=green> Request data exchange complete");
       }
     if ($@=~/timeout/) {       if ($@=~/timeout/) { 
        $answer='';         $answer='';
        &logthis(         &logthis(
Line 494  sub handle { Line 509  sub handle {
         }          }
   
      &status("Completed: $request");       &status("Completed: $request");
    if($DEBUG) {
       &logthis("<font color=green> Request processing complete</font>");
    }
 # ===================================================== Done processing request  # ===================================================== Done processing request
     }      }
     delete $ready{$client};      delete $ready{$client};
 # -------------------------------------------------------------- End non-forker  # -------------------------------------------------------------- End non-forker
       if($DEBUG) {
    &logthis("<font color=green> requests for child handled</font>");
       }
 }  }
 # ---------------------------------------------------------- End make_new_child  # ---------------------------------------------------------- End make_new_child
 }  }
Line 522  sub openremote { Line 542  sub openremote {
     my $conserver=shift;      my $conserver=shift;
   
 &status("Opening TCP");  &status("Opening TCP");
       my $st=120+int(rand(240)); # Sleep before opening:
   
 unless (  unless (
   $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},    $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
Line 529  unless ( Line 550  unless (
                                       Proto    => "tcp",                                        Proto    => "tcp",
                                       Type     => SOCK_STREAM)                                        Type     => SOCK_STREAM)
    ) {      ) { 
        my $st=120+int(rand(240));  
        &logthis(         &logthis(
 "<font color=blue>WARNING: Couldn't connect ($st secs): $@</font>");  "<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): $@</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
 # ----------------------------------------------------------------- Init dialog  # ----------------------------------------------------------------- Init dialog
   
   &logthis("<font color=green>INFO Connected to $conserver, initing </font>");
 &status("Init dialogue: $conserver");  &status("Init dialogue: $conserver");
   
      $SIG{ALRM}=sub { die "timeout" };       $SIG{ALRM}=sub { die "timeout" };
Line 554  chomp($answer); Line 576  chomp($answer);
      $SIG{__DIE__}=\&catchexception;       $SIG{__DIE__}=\&catchexception;
     
      if ($@=~/timeout/) {       if ($@=~/timeout/) {
  &logthis("Timed out during init");   &logthis("Timed out during init.. exiting");
          exit;           exit;
      }       }
   
Line 597  if ($cipher=new IDEA $cipherkey) { Line 619  if ($cipher=new IDEA $cipherkey) {
    sleep($st);     sleep($st);
    exit;     exit;
 }  }
       &logthis("<font color=green> Remote open success </font>");
 }  }
   
   
Line 616  sub catchexception { Line 638  sub catchexception {
   
 # -------------------------------------- Routines to see if other box available  # -------------------------------------- Routines to see if other box available
   
 sub online {  #sub online {
     my $host=shift;  #    my $host=shift;
     &status("Pinging ".$host);  #    &status("Pinging ".$host);
     my $p=Net::Ping->new("tcp",20);  #    my $p=Net::Ping->new("tcp",20);
     my $online=$p->ping("$host");  #    my $online=$p->ping("$host");
     $p->close();  #    $p->close();
     undef ($p);  #    undef ($p);
     return $online;  #    return $online;
 }  #}
   
 sub connected {  sub connected {
     my ($local,$remote)=@_;      my ($local,$remote)=@_;
Line 635  sub connected { Line 657  sub connected {
     unless ($hostname{$local}) { return 'local_unknown'; }      unless ($hostname{$local}) { return 'local_unknown'; }
     unless ($hostname{$remote}) { return 'remote_unknown'; }      unless ($hostname{$remote}) { return 'remote_unknown'; }
   
     unless (&online($hostname{$local})) { return 'local_offline'; }      #unless (&online($hostname{$local})) { return 'local_offline'; }
   
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
           
Line 654  sub connected { Line 676  sub connected {
 }  }
   
   
 sub REAPER {                        # takes care of dead children  
     $SIG{CHLD} = \&REAPER;  
     my $pid = wait;  
     my $wasserver=$children{$pid};  
     &logthis("<font color=red>CRITICAL: "  
      ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");  
     delete $children{$pid};  
     delete $childpid{$wasserver};  
     my $port = "$perlvar{'lonSockDir'}/$wasserver";  
     unlink($port);  
 }  
   
 sub hangup {  sub hangup {
     foreach (keys %children) {      foreach (keys %children) {
Line 797  lonc - LON TCP-MySQL-Server Daemon for h Line 808  lonc - LON TCP-MySQL-Server Daemon for h
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
   Usage: B<lonc>
   
 Should only be run as user=www.  This is a command-line script which  Should only be run as user=www.  This is a command-line script which
 is invoked by loncron.  is invoked by B<loncron>.  There is no expectation that a typical user
   will manually start B<lonc> from the command-line.  (In other words,
   DO NOT START B<lonc> YOURSELF.)
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Provides persistent TCP connections to the other servers in the network  Provides persistent TCP connections to the other servers in the network
 through multiplexed domain sockets  through multiplexed domain sockets
   
  PID in subdir logs/lonc.pid  B<lonc> forks off children processes that correspond to the other servers
  kill kills  in the network.  Management of these processes can be done at the
  HUP restarts  parent process level or the child process level.
  USR1 tries to open connections again  
   B<logs/lonc.log> is the location of log messages.
   
   The process management is now explained in terms of linux shell commands,
   subroutines internal to this code, and signal assignments:
   
   =over 4
   
   =item *
   
   PID is stored in B<logs/lonc.pid>
   
   This is the process id number of the parent B<lonc> process.
   
   =item *
   
   SIGTERM and SIGINT
   
   Parent signal assignment:
    $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
   
   Child signal assignment:
    $SIG{INT}  = 'DEFAULT'; (and SIGTERM is DEFAULT also)
   (The child dies and a SIGALRM is sent to parent, awaking parent from slumber
    to restart a new child.)
   
   Command-line invocations:
    B<kill> B<-s> SIGTERM I<PID>
    B<kill> B<-s> SIGINT I<PID>
   
   Subroutine B<HUNTSMAN>:
    This is only invoked for the B<lonc> parent I<PID>.
   This kills all the children, and then the parent.
   The B<lonc.pid> file is cleared.
   
   =item *
   
   SIGHUP
   
   Current bug:
    This signal can only be processed the first time
   on the parent process.  Subsequent SIGHUP signals
   have no effect.
   
   Parent signal assignment:
    $SIG{HUP}  = \&HUPSMAN;
   
   Child signal assignment:
    none (nothing happens)
   
   Command-line invocations:
    B<kill> B<-s> SIGHUP I<PID>
   
   Subroutine B<HUPSMAN>:
    This is only invoked for the B<lonc> parent I<PID>,
   This kills all the children, and then the parent.
   The B<lonc.pid> file is cleared.
   
   =item *
   
   SIGUSR1
   
   Parent signal assignment:
    $SIG{USR1} = \&USRMAN;
   
   Child signal assignment:
    $SIG{USR1}= \&logstatus;
   
   Command-line invocations:
    B<kill> B<-s> SIGUSR1 I<PID>
   
   Subroutine B<USRMAN>:
    When invoked for the B<lonc> parent I<PID>,
   SIGUSR1 is sent to all the children, and the status of
   each connection is logged.
   
   =item *
   
   SIGCHLD
   
   
   Child signal assignment:
    none
   
   Command-line invocations:
    B<kill> B<-s> SIGCHLD I<PID>
   
 =head1 README  Subroutine B<REAPER>:
    This is only invoked for the B<lonc> parent I<PID>.
   Information pertaining to the child is removed.
   The socket port is cleaned up.
   
 Not yet written.  =back
   
 =head1 PREREQUISITES  =head1 PREREQUISITES
   
Removed from v.1.30  
changed lines
  Added in v.1.32

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