--- loncom/Attic/lonc 2002/04/04 22:04:54 1.38 +++ loncom/Attic/lonc 2003/07/02 01:28:12 1.50 @@ -5,7 +5,7 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # -# $Id: lonc,v 1.38 2002/04/04 22:04:54 foxr Exp $ +# $Id: lonc,v 1.50 2003/07/02 01:28:12 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,18 +37,18 @@ # 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, # 2/8,7/25 Gerd Kortemeyer -# 12/05 Scott Harrison # 12/05 Gerd Kortemeyer # YEAR=2001 -# 01/10/01 Scott Harrison # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer -# 12/20 Scott Harrison # YEAR=2002 # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer # 3/07/02 Ron Fox # based on nonforker from Perl Cookbook # - server who multiplexes without forking +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + use POSIX; use IO::Socket; use IO::Select; @@ -64,25 +64,19 @@ $status=''; $lastlog=''; $conserver='SHELL'; $DEBUG = 0; # Set to 1 for annoyingly complete logs. - +$VERSION='$Revison$'; #' stupid emacs +$remoteVERSION; # -------------------------------- Set signal handlers to record abnormal exits &status("Init exception handlers"); $SIG{QUIT}=\&catchexception; $SIG{__DIE__}=\&catchexception; -# ------------------------------------ Read httpd access.conf and get variables -&status("Read access.conf"); -open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; - -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } -} -close(CONFIG); +# ---------------------------------- Read loncapa_apache.conf and loncapa.conf +&status("Read loncapa.conf and loncapa_apache.conf"); +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); +my %perlvar=%{$perlvarref}; +undef $perlvarref; # ----------------------------- Make sure this process is running from user=www &status("Check user ID"); @@ -175,7 +169,14 @@ $SIG{USR1} = \&USRMAN; # And maintain the population. while (1) { 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"); my $skipping=''; @@ -255,7 +256,7 @@ unlink($port); @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; closedir(DIRHANDLE); my $dfname; - foreach (@allbuffered) { + foreach (sort @allbuffered) { &status("Sending delayed: $_"); $dfname="$path/$_"; if($DEBUG) { &logthis('Sending '.$dfname); } @@ -325,7 +326,7 @@ tie %ready, 'Tie::RefHash'; # Main loop: check reads/accepts, check writes, check ready to process -status("Main loop"); +status("Main loop $conserver"); while (1) { my $client; my $rv; @@ -365,6 +366,8 @@ while (1) { } $servers{$client->fileno} = $client; nonblock($client); + $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of + # connection liveness. } HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready); HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer, @@ -700,75 +703,89 @@ sub openremote { my $conserver=shift; -&status("Opening TCP"); + &status("Opening TCP $conserver"); my $st=120+int(rand(240)); # Sleep before opening: -unless ( - $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, - PeerPort => $perlvar{'londPort'}, - Proto => "tcp", - Type => SOCK_STREAM) - ) { - - &logthis( -"WARNING: Couldn't connect to $conserver ($st secs): "); - sleep($st); - exit; - }; + unless ( + $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, + PeerPort => $perlvar{'londPort'}, + Proto => "tcp", + Type => SOCK_STREAM) + ) { + + &logthis( + "WARNING: Couldn't connect to $conserver ($st secs): "); + sleep($st); + exit; + }; # ----------------------------------------------------------------- Init dialog -&logthis("INFO Connected to $conserver, initing "); -&status("Init dialogue: $conserver"); + &logthis("INFO Connected to $conserver, initing"); + &status("Init dialogue: $conserver"); $answer = londtransaction($remotesock, "init", 60); chomp($answer); $answer = londtransaction($remotesock, $answer, 60); chomp($answer); - - if ($@=~/timeout/) { - &logthis("Timed out during init.. exiting"); - exit; - } -if ($answer ne 'ok') { - &logthis("Init reply: >$answer<"); - my $st=120+int(rand(240)); - &logthis( -"WARNING: Init failed ($st secs)"); - sleep($st); - exit; -} + if ($@=~/timeout/) { + &logthis("Timed out during init.. exiting"); + exit; + } -sleep 5; -&status("Ponging"); -print $remotesock "pong\n"; -$answer=<$remotesock>; -chomp($answer); -if ($answer!~/^$conserver/) { - &logthis("Pong reply: >$answer<"); -} + if ($answer ne 'ok') { + &logthis("Init reply: >$answer<"); + my $st=120+int(rand(240)); + &logthis("WARNING: Init failed ($st secs)"); + sleep($st); + exit; + } + + $answer = londtransaction($remotesock,"sethost:$conserver",60); + chomp($answer); + if ( $answer ne 'ok') { + &logthis('WARNING: unable to specify remote host'. + $answer.''); + } + + $answer = londtransaction($remotesock,"version:$VERSION",60); + chomp($answer); + if ($answer =~ /^version:/) { + $remoteVERSION=(split(/:/,$answer))[1]; + } else { + &logthis('WARNING: request remote version failed :'. + $answer.': my version is :'.$VERSION.':'); + } + + sleep 5; + &status("Ponging $conserver"); + print $remotesock "pong\n"; + $answer=<$remotesock>; + chomp($answer); + if ($answer!~/^$conserver/) { + &logthis("Pong reply: >$answer<"); + } # ----------------------------------------------------------- Initialize cipher -&status("Initialize cipher"); -print $remotesock "ekey\n"; -my $buildkey=<$remotesock>; -my $key=$conserver.$perlvar{'lonHostID'}; -$key=~tr/a-z/A-Z/; -$key=~tr/G-P/0-9/; -$key=~tr/Q-Z/0-9/; -$key=$key.$buildkey.$key.$buildkey.$key.$buildkey; -$key=substr($key,0,32); -my $cipherkey=pack("H32",$key); -if ($cipher=new IDEA $cipherkey) { - &logthis("Secure connection initialized"); -} else { - my $st=120+int(rand(240)); - &logthis( - "WARNING: ". - "Could not establish secure connection ($st secs)!"); - sleep($st); - exit; -} + &status("Initialize cipher"); + print $remotesock "ekey\n"; + my $buildkey=<$remotesock>; + my $key=$conserver.$perlvar{'lonHostID'}; + $key=~tr/a-z/A-Z/; + $key=~tr/G-P/0-9/; + $key=~tr/Q-Z/0-9/; + $key=$key.$buildkey.$key.$buildkey.$key.$buildkey; + $key=substr($key,0,32); + my $cipherkey=pack("H32",$key); + if ($cipher=new IDEA $cipherkey) { + &logthis("Secure connection initialized"); + } else { + my $st=120+int(rand(240)); + &logthis("WARNING: ". + "Could not establish secure connection ($st secs)!"); + sleep($st); + exit; + } &logthis(" Remote open success "); } @@ -850,8 +867,8 @@ sub HUPSMAN { # sig local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children &hangup(); &logthis("CRITICAL: Restarting"); - unlink("$execdir/logs/lonc.pid"); my $execdir=$perlvar{'lonDaemons'}; + unlink("$execdir/logs/lonc.pid"); exec("$execdir/lonc"); # here we go again } @@ -870,8 +887,25 @@ sub checkchildren { sub USRMAN { &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("INFO: Restarting child for server: " + .$host."\n"); + make_new_child($host); + } + else { + $childatt{$host} = 0; + } + } + &checkchildren(); # See if any children are still dead... } # -------------------------------------------------- Non-critical communication @@ -956,12 +990,12 @@ sub londtransaction { alarm(0); }; } else { - if($DEBUG) { - &logthis("Timeout on send in londtransaction"); - } + &logthis("lonc - suiciding on send Timeout"); + die("lonc - suiciding on send Timeout"); } - if( ($@ =~ /timeout/) && ($DEBUG)) { - &logthis("Timeout on receive in londtransaction"); + if ($@ =~ /timeout/) { + &logthis("lonc - suiciding on read Timeout"); + die("lonc - suiciding on read Timeout"); } # # Restore the initial sigmask set. @@ -1016,6 +1050,7 @@ sub status { my $now=time; my $local=localtime($now); $status=$local.': '.$what; + $0='lonc: '.$what.' '.$local; }