--- loncom/Attic/lonc 2000/12/05 19:03:55 1.10
+++ loncom/Attic/lonc 2001/08/30 20:02:28 1.17
@@ -15,6 +15,8 @@
# 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
@@ -35,25 +37,11 @@ sub catchexception {
$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)=@_;
- $SIG{'QUIT'}='DEFAULT';
- $SIG{__DIE__}='DEFAULT';
- &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
@@ -62,8 +50,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/) {
@@ -74,6 +61,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";
@@ -82,13 +79,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);
@@ -120,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");
@@ -129,8 +129,13 @@ 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'};
exec("$execdir/lonc"); # here we go again
}
@@ -189,9 +194,9 @@ sub logperm {
$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
@@ -225,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 "
@@ -246,14 +251,14 @@ 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;
@@ -263,7 +268,7 @@ sub make_new_child {
# 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
@@ -290,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>;
@@ -307,7 +319,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(
@@ -397,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
@@ -446,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};
@@ -530,8 +547,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";
}