--- loncom/Attic/lonc 1999/11/18 19:52:46 1.3 +++ loncom/Attic/lonc 2001/08/30 20:02:28 1.17 @@ -11,7 +11,13 @@ # USR1 tries to open connections again # 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 Gerd Kortemeyer +# 10/8,10/9,10/15,11/18,12/22, +# 2/8,7/25 Gerd Kortemeyer +# 12/05 Scott Harrison +# 12/05 Gerd Kortemeyer +# 01/10/01 Scott Harrison +# 03/14/01,03/15,06/12 Gerd Kortemeyer +# # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -24,6 +30,24 @@ use Fcntl; use Tie::RefHash; use Crypt::IDEA; +# grabs exception and records it to log before exiting +sub catchexception { + my ($signal)=@_; + $SIG{'QUIT'}='DEFAULT'; + $SIG{__DIE__}='DEFAULT'; + &logthis("CRITICAL: " + ."ABNORMAL EXIT. Child $$ for server $wasserver died through " + ."\"$signal\" with this parameter->[$@]"); + die($@); +} + +$childmaxattempts=5; + +# -------------------------------- Set signal handlers to record abnormal exits + +$SIG{'QUIT'}=\&catchexception; +$SIG{__DIE__}=\&catchexception; + # ------------------------------------ Read httpd access.conf and get variables open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; @@ -31,11 +55,33 @@ open (CONFIG,"/etc/httpd/conf/access.con while ($configline=) { 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 +my $wwwid=getpwnam('www'); +if ($wwwid!=$<) { + $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; + system("echo 'User ID mismatch. lonc must be run as user www.' |\ + mailto $emailto -s '$subj' > /dev/null"); + exit 1; +} + +# --------------------------------------------- Check if other instance running + +my $pidfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; + +if (-e $pidfile) { + my $lfh=IO::File->new("$pidfile"); + my $pide=<$lfh>; + chomp($pide); + if (kill 0 => $pide) { die "already running"; } +} + # ------------------------------------------------------------- Read hosts file open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; @@ -60,7 +106,8 @@ sub REAPER { # ta $SIG{CHLD} = \&REAPER; my $pid = wait; my $wasserver=$children{$pid}; - &logthis("Child $pid for server $wasserver died"); + &logthis("CRITICAL: " + ."Child $pid for server $wasserver died ($childatt{$wasserver})"); delete $children{$pid}; delete $childpid{$wasserver}; my $port = "$perlvar{'lonSockDir'}/$wasserver"; @@ -69,34 +116,45 @@ 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("Shutting down"); + &logthis("CRITICAL: Shutting down"); exit; # clean up with dignity } sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - kill 'INT' => keys %children; - &logthis("Restarting"); + 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'}; exec("$execdir/lonc"); # here we go again } sub USRMAN { - %childatt=(); &logthis("USR1: Trying to establish connections again"); foreach $thisserver (keys %hostip) { $answer=subreply("ping",$thisserver); - &logthis( - "USR1: Ping $thisserver (pid >$childpid{$thisserver}<): >$answer<"); + &logthis("USR1: Ping $thisserver " + ."(pid >$childpid{$thisserver}<, $childatt{thisserver} attempts): " + ." >$answer<"); } + %childatt=(); } # -------------------------------------------------- Non-critical communication sub subreply { my ($cmd,$server)=@_; + my $answer=''; if ($server ne $perlvar{'lonHostID'}) { my $peerfile="$perlvar{'lonSockDir'}/$server"; my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", @@ -146,7 +204,7 @@ $execdir=$perlvar{'lonDaemons'}; open (PIDSAVE,">$execdir/logs/lonc.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); -&logthis("---------- Starting ----------"); +&logthis("CRITICAL: ---------- Starting ----------"); # ----------------------------- Ignore signals generated during initial startup $SIG{HUP}=$SIG{USR1}='IGNORE'; @@ -172,9 +230,12 @@ while (1) { # See who died and start new one foreach $thisserver (keys %hostip) { if (!$childpid{$thisserver}) { - if ($childatt{$thisserver}<5) { + if ($childatt{$thisserver}<$childmaxattempts) { + $childatt{$thisserver}++; + &logthis( + "INFO: Trying to reconnect for $thisserver " + ."($childatt{$thisserver} of $childmaxattempts attempts)"); make_new_child($thisserver); - $childatt{$thisserver}++; } } } @@ -220,8 +281,11 @@ unless ( PeerPort => $perlvar{'londPort'}, Proto => "tcp", Type => SOCK_STREAM) - ) { &logthis("Couldn't connect $conserver: $@"); - sleep(5); + ) { + my $st=120+int(rand(240)); + &logthis( +"WARNING: Couldn't connect $conserver ($st secs): $@"); + sleep($st); exit; }; # --------------------------------------- Send a ping to make other end do USR1 @@ -231,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>; @@ -248,22 +319,32 @@ $key=$key.$buildkey.$key.$buildkey.$key. $key=substr($key,0,32); my $cipherkey=pack("H32",$key); if ($cipher=new IDEA $cipherkey) { - &logthis("Secure connection inititalized: $conserver"); + &logthis("Secure connection initialized: $conserver"); } else { - &logthis("Error: Could not establish secure connection, $conserver!"); + my $st=120+int(rand(240)); + &logthis( + "WARNING: ". + "Could not establish secure connection, $conserver ($st secs)!"); + sleep($st); + exit; } # ----------------------------------------- We're online, send delayed messages + my @allbuffered; my $path="$perlvar{'lonSockDir'}/delayed"; + opendir(DIRHANDLE,$path); + @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; + closedir(DIRHANDLE); my $dfname; - while ($dfname=<$path/*.$conserver>) { + map { + $dfname="$path/$_"; + &logthis($dfname); my $wcmd; { my $dfh=IO::File->new($dfname); - $wcmd=<$dfh>; + $cmd=<$dfh>; } - my ($server,$cmd)=split(/:/,$wcmd); chomp($cmd); my $bcmd=$cmd; if ($cmd =~ /^encrypt\:/) { @@ -285,23 +366,30 @@ if ($cipher=new IDEA $cipherkey) { chomp($answer); if ($answer ne '') { unlink("$dfname"); - &logthis("Delayed $cmd to $conserver ($server): >$answer<"); + &logthis("Delayed $cmd to $conserver: >$answer<"); &logperm("S:$conserver:$bcmd"); } - } + } @allbuffered; # ------------------------------------------------------- Listen to UNIX socket unless ( $server = IO::Socket::UNIX->new(Local => $port, Type => SOCK_STREAM, Listen => 10 ) - ) { &logthis("Can't make server socket $conserver: $@"); - sleep(5); + ) { + my $st=120+int(rand(240)); + &logthis( + "WARNING: ". + "Can't make server socket $conserver ($st secs): $@"); + sleep($st); exit; }; # ----------------------------------------------------------------------------- +&logthis("$conserver online"); + +# ----------------------------------------------------------------------------- # begin with empty buffers %inbuffer = (); %outbuffer = (); @@ -321,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 @@ -370,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}; @@ -459,7 +552,3 @@ sub nonblock { or die "Can't make socket nonblocking: $!\n"; } - - - -