--- loncom/Attic/lonc 2001/03/13 21:15:40 1.14 +++ loncom/Attic/lonc 2001/08/30 20:02:28 1.17 @@ -16,7 +16,7 @@ # 12/05 Scott Harrison # 12/05 Gerd Kortemeyer # 01/10/01 Scott Harrison -# 03/14/01 Gerd Kortemeyer +# 03/14/01,03/15,06/12 Gerd Kortemeyer # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -41,7 +41,7 @@ sub catchexception { die($@); } -$childmaxattempts=10; +$childmaxattempts=5; # -------------------------------- Set signal handlers to record abnormal exits @@ -116,7 +116,11 @@ sub REAPER { # ta sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - kill 'INT' => keys %children; + map { + $wasserver=$children{$_}; + &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); + kill ('INT',$_); + } keys %children; my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); &logthis("CRITICAL: Shutting down"); @@ -125,7 +129,11 @@ sub HUNTSMAN { # si sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - kill 'INT' => keys %children; + map { + $wasserver=$children{$_}; + &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); + kill ('INT',$_); + } keys %children; &logthis("CRITICAL: Restarting"); unlink("$execdir/logs/lonc.pid"); my $execdir=$perlvar{'lonDaemons'}; @@ -222,7 +230,7 @@ while (1) { # See who died and start new one foreach $thisserver (keys %hostip) { if (!$childpid{$thisserver}) { - if ($childatt{$thisserver}<=$childmaxattempts) { + if ($childatt{$thisserver}<$childmaxattempts) { $childatt{$thisserver}++; &logthis( "INFO: Trying to reconnect for $thisserver " @@ -287,6 +295,13 @@ print $remotesock "$answer"; $answer=<$remotesock>; chomp($answer); &logthis("Init reply for $conserver: >$answer<"); +if ($answer ne 'ok') { + my $st=120+int(rand(240)); + &logthis( +"WARNING: Init failed $conserver ($st secs)"); + sleep($st); + exit; +} sleep 5; print $remotesock "pong\n"; $answer=<$remotesock>; @@ -394,7 +409,7 @@ while (1) { # check for new information on the connections we have # anything to read or accept? - foreach $client ($select->can_read(1)) { + foreach $client ($select->can_read(0.1)) { if ($client == $server) { # accept a new connection @@ -443,16 +458,21 @@ while (1) { $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { # Whine, but move on. - warn "I was told I could write, but I can't.\n"; + &logthis("I was told I could write, but I can't.\n"); next; } + $errno=$!; if (($rv == length $outbuffer{$client}) || - ($! == POSIX::EWOULDBLOCK)) { + ($errno == POSIX::EWOULDBLOCK) || ($errno == 0)) { substr($outbuffer{$client}, 0, $rv) = ''; delete $outbuffer{$client} unless length $outbuffer{$client}; } else { # Couldn't write all the data, and it wasn't because # it would have blocked. Shutdown and move on. + + &logthis("Dropping data with ".$errno.": ". + length($outbuffer{$client}).", $rv"); + delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client};