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

Diff for /loncom/Attic/lonc between versions 1.38 and 1.50

version 1.38, 2002/04/04 22:04:54 version 1.50, 2003/07/02 01:28:12
Line 37 Line 37
 # 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,  # 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
 # 10/8,10/9,10/15,11/18,12/22,  # 10/8,10/9,10/15,11/18,12/22,
 # 2/8,7/25 Gerd Kortemeyer  # 2/8,7/25 Gerd Kortemeyer
 # 12/05 Scott Harrison  
 # 12/05 Gerd Kortemeyer  # 12/05 Gerd Kortemeyer
 # YEAR=2001  # YEAR=2001
 # 01/10/01 Scott Harrison  
 # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer  # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer
 # 12/20 Scott Harrison  
 # YEAR=2002  # YEAR=2002
 # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer  # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
 # 3/07/02 Ron Fox   # 3/07/02 Ron Fox 
 # based on nonforker from Perl Cookbook  # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking  # - server who multiplexes without forking
   
   use lib '/home/httpd/lib/perl/';
   use LONCAPA::Configuration;
   
 use POSIX;  use POSIX;
 use IO::Socket;  use IO::Socket;
 use IO::Select;  use IO::Select;
Line 64  $status=''; Line 64  $status='';
 $lastlog='';  $lastlog='';
 $conserver='SHELL';  $conserver='SHELL';
 $DEBUG = 0; # Set to 1 for annoyingly complete logs.  $DEBUG = 0; # Set to 1 for annoyingly complete logs.
   $VERSION='$Revison$'; #' stupid emacs
   $remoteVERSION;
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
 &status("Init exception handlers");  &status("Init exception handlers");
 $SIG{QUIT}=\&catchexception;  $SIG{QUIT}=\&catchexception;
 $SIG{__DIE__}=\&catchexception;  $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
 &status("Read access.conf");  &status("Read loncapa.conf and loncapa_apache.conf");
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
   my %perlvar=%{$perlvarref};
 while ($configline=<CONFIG>) {  undef $perlvarref;
     if ($configline =~ /PerlSetVar/) {  
  my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
         chomp($varvalue);  
         $perlvar{$varname}=$varvalue;  
     }  
 }  
 close(CONFIG);  
   
 # ----------------------------- Make sure this process is running from user=www  # ----------------------------- Make sure this process is running from user=www
 &status("Check user ID");  &status("Check user ID");
Line 175  $SIG{USR1} = \&USRMAN; Line 169  $SIG{USR1} = \&USRMAN;
 # And maintain the population.  # And maintain the population.
 while (1) {  while (1) {
     my $deadpid = wait; # Wait for the next child to die.      my $deadpid = wait; # Wait for the next child to die.
                                     # See who died and start new one                                  # See who died and start new one
                                   # or a signal (e.g. USR1 for restart).
                                   # if a signal, the wait will fail
                                   # This is ordinarily detected by
                                   # checking for the existence of the
                                   # pid index inthe children hash since
                                   # the return value from a failed wait is -1
                                   # which is an impossible PID.
     &status("Woke up");      &status("Woke up");
     my $skipping='';      my $skipping='';
   
Line 255  unlink($port); Line 256  unlink($port);
     @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;      @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     my $dfname;      my $dfname;
     foreach (@allbuffered) {      foreach (sort @allbuffered) {
         &status("Sending delayed: $_");          &status("Sending delayed: $_");
         $dfname="$path/$_";          $dfname="$path/$_";
         if($DEBUG) { &logthis('Sending '.$dfname); }          if($DEBUG) { &logthis('Sending '.$dfname); }
Line 325  tie %ready, 'Tie::RefHash'; Line 326  tie %ready, 'Tie::RefHash';
   
 # Main loop: check reads/accepts, check writes, check ready to process  # Main loop: check reads/accepts, check writes, check ready to process
   
 status("Main loop");  status("Main loop $conserver");
 while (1) {  while (1) {
     my $client;      my $client;
     my $rv;      my $rv;
Line 365  while (1) { Line 366  while (1) {
  }   }
  $servers{$client->fileno} = $client;   $servers{$client->fileno} = $client;
  nonblock($client);   nonblock($client);
    $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
                                     # connection liveness.
     }      }
     HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);      HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);
     HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,      HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,
Line 700  sub openremote { Line 703  sub openremote {
   
     my $conserver=shift;      my $conserver=shift;
   
 &status("Opening TCP");      &status("Opening TCP $conserver");
     my $st=120+int(rand(240)); # Sleep before opening:      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},
                                       PeerPort => $perlvar{'londPort'},   PeerPort => $perlvar{'londPort'},
                                       Proto    => "tcp",   Proto    => "tcp",
                                       Type     => SOCK_STREAM)   Type     => SOCK_STREAM)
    ) {      ) {
   
        &logthis(   &logthis(
 "<font color=blue>WARNING: Couldn't connect to $conserver ($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>");      &logthis("<font color=green>INFO Connected to $conserver, initing</font>");
 &status("Init dialogue: $conserver");      &status("Init dialogue: $conserver");
   
     $answer = londtransaction($remotesock, "init", 60);      $answer = londtransaction($remotesock, "init", 60);
     chomp($answer);      chomp($answer);
     $answer = londtransaction($remotesock, $answer, 60);      $answer = londtransaction($remotesock, $answer, 60);
     chomp($answer);      chomp($answer);
    
      if ($@=~/timeout/) {  
  &logthis("Timed out during init.. exiting");  
          exit;  
      }  
   
 if ($answer ne 'ok') {      if ($@=~/timeout/) {
        &logthis("Init reply: >$answer<");   &logthis("Timed out during init.. exiting");
        my $st=120+int(rand(240));   exit;
        &logthis(      }
 "<font color=blue>WARNING: Init failed ($st secs)</font>");  
        sleep($st);  
        exit;   
 }  
   
 sleep 5;      if ($answer ne 'ok') {
 &status("Ponging");   &logthis("Init reply: >$answer<");
 print $remotesock "pong\n";   my $st=120+int(rand(240));
 $answer=<$remotesock>;   &logthis("<font color=blue>WARNING: Init failed ($st secs)</font>");
 chomp($answer);   sleep($st);
 if ($answer!~/^$conserver/) {   exit;
    &logthis("Pong reply: >$answer<");      }
 }  
       $answer = londtransaction($remotesock,"sethost:$conserver",60);
       chomp($answer);
       if ( $answer ne 'ok') {
    &logthis('<font color="blue">WARNING: unable to specify remote host'.
    $answer.'</font>');
       }
   
       $answer = londtransaction($remotesock,"version:$VERSION",60);
       chomp($answer);
       if ($answer =~ /^version:/) {
    $remoteVERSION=(split(/:/,$answer))[1];
       } else {
    &logthis('<font color="blue">WARNING: request remote version failed :'.
    $answer.': my version is :'.$VERSION.':</font>');
       }
   
       sleep 5;
       &status("Ponging $conserver");
       print $remotesock "pong\n";
       $answer=<$remotesock>;
       chomp($answer);
       if ($answer!~/^$conserver/) {
    &logthis("Pong reply: >$answer<");
       }
 # ----------------------------------------------------------- Initialize cipher  # ----------------------------------------------------------- Initialize cipher
   
 &status("Initialize cipher");      &status("Initialize cipher");
 print $remotesock "ekey\n";      print $remotesock "ekey\n";
 my $buildkey=<$remotesock>;      my $buildkey=<$remotesock>;
 my $key=$conserver.$perlvar{'lonHostID'};      my $key=$conserver.$perlvar{'lonHostID'};
 $key=~tr/a-z/A-Z/;      $key=~tr/a-z/A-Z/;
 $key=~tr/G-P/0-9/;      $key=~tr/G-P/0-9/;
 $key=~tr/Q-Z/0-9/;      $key=~tr/Q-Z/0-9/;
 $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;      $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
 $key=substr($key,0,32);      $key=substr($key,0,32);
 my $cipherkey=pack("H32",$key);      my $cipherkey=pack("H32",$key);
 if ($cipher=new IDEA $cipherkey) {      if ($cipher=new IDEA $cipherkey) {
    &logthis("Secure connection initialized");   &logthis("Secure connection initialized");
 } else {      } else {
    my $st=120+int(rand(240));   my $st=120+int(rand(240));
    &logthis(   &logthis("<font color=blue>WARNING: ".
      "<font color=blue>WARNING: ".   "Could not establish secure connection ($st secs)!</font>");
      "Could not establish secure connection ($st secs)!</font>");   sleep($st);
    sleep($st);   exit;
    exit;      }
 }  
     &logthis("<font color=green> Remote open success </font>");      &logthis("<font color=green> Remote open success </font>");
 }  }
   
Line 850  sub HUPSMAN {                      # sig Line 867  sub HUPSMAN {                      # sig
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     &hangup();      &hangup();
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color=red>CRITICAL: Restarting</font>");
     unlink("$execdir/logs/lonc.pid");  
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
       unlink("$execdir/logs/lonc.pid");
     exec("$execdir/lonc");         # here we go again      exec("$execdir/lonc");         # here we go again
 }  }
   
Line 870  sub checkchildren { Line 887  sub checkchildren {
   
 sub USRMAN {  sub USRMAN {
     &logthis("USR1: Trying to establish connections again");      &logthis("USR1: Trying to establish connections again");
     %childatt=();      #
     &checkchildren();      #  It is really important not to just clear the childatt hash or we will
       #  lose all memory of the children.  What we really want to do is this:
       #  For each index where childatt is >= $childmaxattempts
       #  Zero the associated counter and do a make_child for the host.
       #  Regardles, the childatt entry is zeroed:
       my $host;
       foreach $host (keys %childatt) {
    if ($childatt{$host} >= $childmaxattempts) {
       $childatt{$host} = 0;
       &logthis("<font color=green>INFO: Restarting child for server: "
        .$host."</font>\n");
       make_new_child($host);
    }
    else {
       $childatt{$host} = 0;
    }
       }
       &checkchildren(); # See if any children are still dead...
 }  }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
Line 956  sub londtransaction { Line 990  sub londtransaction {
     alarm(0);      alarm(0);
  };   };
     } else {      } else {
  if($DEBUG) {   &logthis("lonc - suiciding on send Timeout");
     &logthis("Timeout on send in londtransaction");   die("lonc - suiciding on send Timeout");
  }  
     }      }
     if( ($@ =~ /timeout/)  && ($DEBUG)) {      if ($@ =~ /timeout/) {
  &logthis("Timeout on receive in londtransaction");   &logthis("lonc - suiciding on read Timeout");
    die("lonc - suiciding on read Timeout");
     }      }
     #      #
     # Restore the initial sigmask set.      # Restore the initial sigmask set.
Line 1016  sub status { Line 1050  sub status {
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     $status=$local.': '.$what;      $status=$local.': '.$what;
       $0='lonc: '.$what.' '.$local;
 }  }
   
   
Removed from v.1.38  
changed lines
  Added in v.1.50

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