--- loncom/Attic/lonc 2000/12/05 16:51:41 1.9 +++ loncom/Attic/lonc 2001/11/27 19:32:46 1.19 @@ -12,7 +12,12 @@ # 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 +# 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,11/26,11/27 Gerd Kortemeyer +# # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -25,28 +30,21 @@ use Fcntl; use Tie::RefHash; use Crypt::IDEA; +my $status=''; +my $lastlog=''; + # 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->[$@]"); + ."\"$signal\" with this parameter->[$@]"); die($@); } -# grabs exception and records it to log before exiting -# NOTE: we must NOT use the regular (non-overrided) die function in -# the code because a handler CANNOT be attached to it -# (despite what some of the documentation says about SIG{__DIE__}. -sub catchdie { - my ($message)=@_; - &logthis("CRITICAL: " - ."ABNORMAL EXIT. Child $$ for server $wasserver died through " - ."\_\_DIE\_\_ with this parameter->[$message]"); - die($message); -} - -$childmaxattempts=10; +$childmaxattempts=5; # -------------------------------- Set signal handlers to record abnormal exits @@ -55,8 +53,7 @@ $SIG{__DIE__}=\&catchexception; # ------------------------------------ Read httpd access.conf and get variables -open (CONFIG,"/etc/httpd/conf/access.conf") - || catchdie "Can't read access.conf"; +open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; while ($configline=) { if ($configline =~ /PerlSetVar/) { @@ -67,6 +64,16 @@ while ($configline=) { } 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"; @@ -75,13 +82,12 @@ if (-e $pidfile) { my $lfh=IO::File->new("$pidfile"); my $pide=<$lfh>; chomp($pide); - if (kill 0 => $pide) { catchdie "already running"; } + if (kill 0 => $pide) { die "already running"; } } # ------------------------------------------------------------- Read hosts file -open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") - || catchdie "Can't read host file"; +open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; while ($configline=) { my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); @@ -113,7 +119,13 @@ 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{$_}; + &status("Closing $wasserver"); + &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); + &status("Kill PID $_ for $wasserver"); + kill ('INT',$_); + } keys %children; my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); &logthis("CRITICAL: Shutting down"); @@ -122,12 +134,32 @@ 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{$_}; + &status("Closing $wasserver"); + &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); + &status("Kill PID $_ for $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 checkchildren { + &initnewstatus(); + &logstatus(); + &logthis('Going to check on the children'); + map { + sleep 1; + unless (kill 'USR1' => $_) { + &logthis ('Child '.$_.' is dead'); + &logstatus($$.' is dead'); + } + } sort keys %children; +} + sub USRMAN { &logthis("USR1: Trying to establish connections again"); foreach $thisserver (keys %hostip) { @@ -137,6 +169,7 @@ sub USRMAN { ." >$answer<"); } %childatt=(); + &checkchildren(); } # -------------------------------------------------- Non-critical communication @@ -149,10 +182,18 @@ sub subreply { Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; - my $answer=<$sclient>; - chomp($answer); - if (!$answer) { $answer="con_lost"; } + $SIG{ALRM}=sub { die "timeout" }; + $SIG{__DIE__}='DEFAULT'; + eval { + alarm(10); + print $sclient "$cmd\n"; + my $answer=<$sclient>; + chomp($answer); + alarm(0); + }; + if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; } + $SIG{ALRM}='DEFAULT'; + $SIG{__DIE__}=\&catchexception; } else { $answer='self_reply'; } return $answer; } @@ -165,6 +206,7 @@ sub logthis { my $fh=IO::File->new(">>$execdir/logs/lonc.log"); my $now=time; my $local=localtime($now); + $lastlog=$local.': '.$message; print $fh "$local ($$): $message\n"; } @@ -177,14 +219,39 @@ sub logperm { my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); print $fh "$now:$message:$local\n"; } +# ------------------------------------------------------------------ Log status + +sub logstatus { + my $docdir=$perlvar{'lonDocRoot'}; + my $fh=IO::File->new(">>$docdir/lon-status/loncstatus.txt"); + print $fh $$."\t".$status."\t".$lastlog."\n"; +} + +sub initnewstatus { + my $docdir=$perlvar{'lonDocRoot'}; + my $fh=IO::File->new(">$docdir/lon-status/loncstatus.txt"); + my $now=time; + my $local=localtime($now); + print $fh "LONC status $local - parent $$\n\n"; +} + +# -------------------------------------------------------------- Status setting + +sub status { + my $what=shift; + my $now=time; + my $local=localtime($now); + $status=$local.': '.$what; +} + # ---------------------------------------------------- Fork once and dissociate $fpid=fork; exit if $fpid; -catchdie "Couldn't fork: $!" unless defined ($fpid); +die "Couldn't fork: $!" unless defined ($fpid); -POSIX::setsid() or catchdie "Can't start new session: $!"; +POSIX::setsid() or die "Can't start new session: $!"; # ------------------------------------------------------- Write our PID on disk @@ -200,6 +267,8 @@ $SIG{HUP}=$SIG{USR1}='IGNORE'; # Fork off our children, one for every server +&status("Forking ..."); + foreach $thisserver (keys %hostip) { make_new_child($thisserver); } @@ -214,11 +283,13 @@ $SIG{USR1} = \&USRMAN; # And maintain the population. while (1) { + &status("Sleeping"); sleep; # wait for a signal (i.e., child's death) # See who died and start new one + &status("Woke up"); foreach $thisserver (keys %hostip) { if (!$childpid{$thisserver}) { - if ($childatt{$thisserver}<=$childmaxattempts) { + if ($childatt{$thisserver}<$childmaxattempts) { $childatt{$thisserver}++; &logthis( "INFO: Trying to reconnect for $thisserver " @@ -239,31 +310,36 @@ sub make_new_child { # block signal for fork $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset) - or catchdie "Can't block SIGINT for fork: $!\n"; + or die "Can't block SIGINT for fork: $!\n"; - catchdie "fork: $!" unless defined ($pid = fork); + die "fork: $!" unless defined ($pid = fork); if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) - or catchdie "Can't unblock SIGINT for fork: $!\n"; + or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = $conserver; $childpid{$conserver} = $pid; return; } else { # Child can *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before - + $SIG{USR1}= \&logstatus; + # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) - or catchdie "Can't unblock SIGINT for fork: $!\n"; + or die "Can't unblock SIGINT for fork: $!\n"; # ----------------------------- This is the modified main program of non-forker $port = "$perlvar{'lonSockDir'}/$conserver"; unlink($port); + # ---------------------------------------------------- Client to network server + +&status("Opening TCP: $conserver"); + unless ( $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, PeerPort => $perlvar{'londPort'}, @@ -277,19 +353,31 @@ unless ( exit; }; # --------------------------------------- Send a ping to make other end do USR1 + +&status("Init dialogue: $conserver"); + print $remotesock "init\n"; $answer=<$remotesock>; 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; +&status("Ponging $conserver"); print $remotesock "pong\n"; $answer=<$remotesock>; chomp($answer); &logthis("Pong reply for $conserver: >$answer<"); # ----------------------------------------------------------- Initialize cipher +&status("Initialize cipher: $conserver"); print $remotesock "ekey\n"; my $buildkey=<$remotesock>; my $key=$conserver.$perlvar{'lonHostID'}; @@ -300,7 +388,7 @@ $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 { my $st=120+int(rand(240)); &logthis( @@ -311,7 +399,7 @@ if ($cipher=new IDEA $cipherkey) { } # ----------------------------------------- We're online, send delayed messages - + &status("Checking for delayed messages"); my @allbuffered; my $path="$perlvar{'lonSockDir'}/delayed"; opendir(DIRHANDLE,$path); @@ -319,6 +407,7 @@ if ($cipher=new IDEA $cipherkey) { closedir(DIRHANDLE); my $dfname; map { + &status("Sending delayed $conserver $_"); $dfname="$path/$_"; &logthis($dfname); my $wcmd; @@ -353,6 +442,7 @@ if ($cipher=new IDEA $cipherkey) { } @allbuffered; # ------------------------------------------------------- Listen to UNIX socket +&status("Opening socket $conserver"); unless ( $server = IO::Socket::UNIX->new(Local => $port, Type => SOCK_STREAM, @@ -390,11 +480,11 @@ 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 - + &status("Accept new connection: $conserver"); $client = $server->accept(); $select->add($client); nonblock($client); @@ -409,6 +499,7 @@ while (1) { delete $outbuffer{$client}; delete $ready{$client}; + &status("Idle $conserver"); $select->remove($client); close $client; next; @@ -439,16 +530,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}; @@ -488,8 +584,27 @@ sub handle { } $request="enc:$cmdlength:$encrequest\n"; } +# --------------------------------------------------------------- Main exchange + $SIG{ALRM}=sub { die "timeout" }; + $SIG{__DIE__}='DEFAULT'; + eval { + alarm(300); + &status("Sending $conserver: $request"); print $remotesock "$request"; + &status("Waiting for reply from $conserver: $request"); $answer=<$remotesock>; + &status("Received reply: $request"); + alarm(0); + }; + if ($@=~/timeout/) { + $answer=''; + &logthis( + "CRITICAL: Timeout $conserver: $request"); + } + $SIG{ALRM}='DEFAULT'; + $SIG{__DIE__}=\&catchexception; + + if ($answer) { if ($answer =~ /^enc/) { my ($cmd,$cmdlength,$encinput)=split(/:/,$answer); @@ -511,6 +626,7 @@ sub handle { # ===================================================== Done processing request } delete $ready{$client}; + &status("Completed $conserver: $request"); # -------------------------------------------------------------- End non-forker } # ---------------------------------------------------------- End make_new_child @@ -523,8 +639,8 @@ sub nonblock { $flags = fcntl($socket, F_GETFL, 0) - or catchdie "Can't get flags for socket: $!\n"; + or die "Can't get flags for socket: $!\n"; fcntl($socket, F_SETFL, $flags | O_NONBLOCK) - or catchdie "Can't make socket nonblocking: $!\n"; + or die "Can't make socket nonblocking: $!\n"; }