--- loncom/Attic/lonc 2002/03/03 18:13:07 1.31 +++ loncom/Attic/lonc 2002/03/08 03:56:19 1.32 @@ -5,7 +5,7 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # -# $Id: lonc,v 1.31 2002/03/03 18:13:07 harris41 Exp $ +# $Id: lonc,v 1.32 2002/03/08 03:56:19 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -57,12 +57,13 @@ use Socket; use Fcntl; use Tie::RefHash; use Crypt::IDEA; -use Net::Ping; +#use Net::Ping; use LWP::UserAgent(); $status=''; $lastlog=''; $conserver='SHELL'; +$DEBUG = 0; # Set to 1 for annoyingly complete logs. # -------------------------------- Set signal handlers to record abnormal exits @@ -158,47 +159,53 @@ $SIG{HUP}=$SIG{USR1}='IGNORE'; &status("Forking ..."); foreach $thisserver (keys %hostip) { - if (&online($hostname{$thisserver})) { + #if (&online($hostname{$thisserver})) { make_new_child($thisserver); - } + #} } &logthis("Done starting initial servers"); # ----------------------------------------------------- Install signal handlers -$SIG{CHLD} = \&REAPER; + $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; $SIG{HUP} = \&HUPSMAN; $SIG{USR1} = \&USRMAN; # And maintain the population. while (1) { - &status("Sleeping"); - sleep; # wait for a signal (i.e., child's death) + my $deadpid = wait; # Wait for the next child to die. # See who died and start new one &status("Woke up"); my $skipping=''; - foreach $thisserver (keys %hostip) { - if (!$childpid{$thisserver}) { - if (($childatt{$thisserver}<$childmaxattempts) && - (&online($hostname{$thisserver}))) { - $childatt{$thisserver}++; - &logthis( - "INFO: Trying to reconnect for $thisserver " - ."($childatt{$thisserver} of $childmaxattempts attempts)"); - make_new_child($thisserver); - } else { - $skipping.=$thisserver.' '; - } - - } - } - if ($skipping) { - &logthis("WARNING: Skipped $skipping"); + + if(exists($children{$deadpid})) { + + $thisserver = $children{$deadpid}; # Look name of dead guy's peer. + + delete($children{$deadpid}); # Get rid of dead hash entry. + + if($childatt{$thisserver} < $childmaxattempts) { + $childatt{$thisserver}++; + &logthis( + "INFO: Trying to reconnect for $thisserver " + ."($childatt{$thisserver} of $childmaxattempts attempts)"); + make_new_child($thisserver); + + } + else { + $skipping .= $thisserver.' '; + } + if($skipping) { + &logthis("WARNING: Skipped $skipping"); + + } } + } + sub make_new_child { $newserver=shift; @@ -217,7 +224,7 @@ sub make_new_child { sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = $newserver; - $childpid{$conserver} = $pid; + $childpid{$newserver} = $pid; return; } else { $conserver=$newserver; @@ -238,9 +245,10 @@ unlink($port); # -------------------------------------------------------------- Open other end &openremote($conserver); - + &logthis(" Connection to $conserver open "); # ----------------------------------------- We're online, send delayed messages &status("Checking for delayed messages"); + my @allbuffered; my $path="$perlvar{'lonSockDir'}/delayed"; opendir(DIRHANDLE,$path); @@ -250,7 +258,7 @@ unlink($port); foreach (@allbuffered) { &status("Sending delayed: $_"); $dfname="$path/$_"; - &logthis('Sending '.$dfname); + if($DEBUG) { &logthis('Sending '.$dfname); } my $wcmd; { my $dfh=IO::File->new($dfname); @@ -289,6 +297,7 @@ unlink($port); &logperm("S:$conserver:$bcmd"); } } + if($DEBUG) { &logthis(" Delayed transactions sent"); } # ------------------------------------------------------- Listen to UNIX socket &status("Opening socket"); @@ -300,11 +309,11 @@ unless ( my $st=120+int(rand(240)); &logthis( "WARNING: ". - "Can't make server socket ($st secs): $@"); + "Can't make server socket ($st secs): $@ .. exiting"); sleep($st); exit; }; - + # ----------------------------------------------------------------------------- &logthis("$conserver online"); @@ -329,8 +338,8 @@ while (1) { # check for new information on the connections we have # anything to read or accept? - foreach $client ($select->can_read(0.1)) { + foreach $client ($select->can_read(100.0)) { if ($client == $server) { # accept a new connection &status("Accept new connection: $conserver"); @@ -356,6 +365,7 @@ while (1) { $inbuffer{$client} .= $data; + # test whether the data in the buffer or the data we # just read means there is a complete request waiting # to be fulfilled. If there is, set $ready{$client} @@ -365,12 +375,12 @@ while (1) { } } } - + # Any complete requests to process? foreach $client (keys %ready) { handle($client); } - + # Buffers to flush? foreach $client ($select->can_write(1)) { # Skip this client if we have nothing to say @@ -426,16 +436,18 @@ sub handle { # send output to $outbuffer{$client} my $client = shift; my $request; - foreach $request (@{$ready{$client}}) { # ============================================================= Process request # $request is the text of the request # put text of reply into $outbuffer{$client} # ------------------------------------------------------------ Is this the end? + if($DEBUG) { + &logthis(" Request $request processing starts"); + } if ($request eq "close_connection_exit\n") { &status("Request close connection"); &logthis( - "CRITICAL: Request Close Connection"); + "CRITICAL: Request Close Connection ... exiting"); $remotesock->shutdown(2); $server->close(); exit; @@ -466,6 +478,9 @@ sub handle { &status("Received reply: $request"); alarm(0); }; + if($DEBUG) { + &logthis(" Request data exchange complete"); + } if ($@=~/timeout/) { $answer=''; &logthis( @@ -494,11 +509,16 @@ sub handle { } &status("Completed: $request"); - + if($DEBUG) { + &logthis(" Request processing complete"); + } # ===================================================== Done processing request } delete $ready{$client}; # -------------------------------------------------------------- End non-forker + if($DEBUG) { + &logthis(" requests for child handled"); + } } # ---------------------------------------------------------- End make_new_child } @@ -522,6 +542,7 @@ sub openremote { my $conserver=shift; &status("Opening TCP"); + my $st=120+int(rand(240)); # Sleep before opening: unless ( $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, @@ -529,14 +550,15 @@ unless ( Proto => "tcp", Type => SOCK_STREAM) ) { - my $st=120+int(rand(240)); + &logthis( -"WARNING: Couldn't connect ($st secs): $@"); +"WARNING: Couldn't connect to $conserver ($st secs): $@"); sleep($st); exit; }; # ----------------------------------------------------------------- Init dialog +&logthis("INFO Connected to $conserver, initing "); &status("Init dialogue: $conserver"); $SIG{ALRM}=sub { die "timeout" }; @@ -554,7 +576,7 @@ chomp($answer); $SIG{__DIE__}=\&catchexception; if ($@=~/timeout/) { - &logthis("Timed out during init"); + &logthis("Timed out during init.. exiting"); exit; } @@ -597,7 +619,7 @@ if ($cipher=new IDEA $cipherkey) { sleep($st); exit; } - + &logthis(" Remote open success "); } @@ -616,15 +638,15 @@ sub catchexception { # -------------------------------------- Routines to see if other box available -sub online { - my $host=shift; - &status("Pinging ".$host); - my $p=Net::Ping->new("tcp",20); - my $online=$p->ping("$host"); - $p->close(); - undef ($p); - return $online; -} +#sub online { +# my $host=shift; +# &status("Pinging ".$host); +# my $p=Net::Ping->new("tcp",20); +# my $online=$p->ping("$host"); +# $p->close(); +# undef ($p); +# return $online; +#} sub connected { my ($local,$remote)=@_; @@ -635,7 +657,7 @@ sub connected { unless ($hostname{$local}) { return 'local_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; @@ -654,17 +676,6 @@ sub connected { } -sub REAPER { # takes care of dead children - $SIG{CHLD} = \&REAPER; - my $pid = wait; - my $wasserver=$children{$pid}; - &logthis("CRITICAL: " - ."Child $pid for server $wasserver died ($childatt{$wasserver})"); - delete $children{$pid}; - delete $childpid{$wasserver}; - my $port = "$perlvar{'lonSockDir'}/$wasserver"; - unlink($port); -} sub hangup { foreach (keys %children) { @@ -892,8 +903,6 @@ each connection is logged. SIGCHLD -Parent signal assignment: - $SIG{CHLD} = \&REAPER; Child signal assignment: none