--- loncom/Attic/lonc 1999/10/13 17:48:51 1.1.1.1
+++ loncom/Attic/lonc 2001/01/10 17:53:51 1.13
@@ -10,7 +10,12 @@
# HUP restarts
# 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 Gerd Kortemeyer
+# 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
+# 12/05 Scott Harrison
+# 12/05 Gerd Kortemeyer
+#
# based on nonforker from Perl Cookbook
# - server who multiplexes without forking
@@ -23,6 +28,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("<font color=red>CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+ ."\"$signal\" with this parameter->[$@]</font>");
+ die($@);
+}
+
+$childmaxattempts=10;
+
+# -------------------------------- 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";
@@ -30,11 +53,33 @@ open (CONFIG,"/etc/httpd/conf/access.con
while ($configline=<CONFIG>) {
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. loncron 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";
@@ -59,7 +104,8 @@ sub REAPER { # ta
$SIG{CHLD} = \&REAPER;
my $pid = wait;
my $wasserver=$children{$pid};
- &logthis("Child $pid for server $wasserver died");
+ &logthis("<font color=red>CRITICAL: "
+ ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");
delete $children{$pid};
delete $childpid{$wasserver};
my $port = "$perlvar{'lonSockDir'}/$wasserver";
@@ -71,31 +117,34 @@ sub HUNTSMAN { # si
kill 'INT' => keys %children;
my $execdir=$perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
- &logthis("Shutting down");
+ &logthis("<font color=red>CRITICAL: Shutting down</font>");
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");
+ &logthis("<font color=red>CRITICAL: Restarting</font>");
+ 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",
@@ -121,6 +170,16 @@ sub logthis {
print $fh "$local ($$): $message\n";
}
+
+sub logperm {
+ my $message=shift;
+ my $execdir=$perlvar{'lonDaemons'};
+ my $now=time;
+ my $local=localtime($now);
+ my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
+ print $fh "$now:$message:$local\n";
+}
+
# ---------------------------------------------------- Fork once and dissociate
$fpid=fork;
@@ -135,7 +194,7 @@ $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonc.pid");
print PIDSAVE "$$\n";
close(PIDSAVE);
-&logthis("---------- Starting ----------");
+&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
# ----------------------------- Ignore signals generated during initial startup
$SIG{HUP}=$SIG{USR1}='IGNORE';
@@ -161,9 +220,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(
+ "<font color=yellow>INFO: Trying to reconnect for $thisserver "
+ ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");
make_new_child($thisserver);
- $childatt{$thisserver}++;
}
}
}
@@ -209,15 +271,20 @@ unless (
PeerPort => $perlvar{'londPort'},
Proto => "tcp",
Type => SOCK_STREAM)
- ) { &logthis("Couldn't connect $conserver: $@");
- sleep(5);
+ ) {
+ my $st=120+int(rand(240));
+ &logthis(
+"<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");
+ sleep($st);
exit;
};
# --------------------------------------- Send a ping to make other end do USR1
-print $remotesock "ping\n";
+print $remotesock "init\n";
+$answer=<$remotesock>;
+print $remotesock "$answer";
$answer=<$remotesock>;
chomp($answer);
-&logthis("Ping reply for $conserver: >$answer<");
+&logthis("Init reply for $conserver: >$answer<");
sleep 5;
print $remotesock "pong\n";
$answer=<$remotesock>;
@@ -235,24 +302,77 @@ $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(
+ "<font color=blue>WARNING: ".
+ "Could not establish secure connection, $conserver ($st secs)!</font>");
+ 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;
+ map {
+ $dfname="$path/$_";
+ &logthis($dfname);
+ my $wcmd;
+ {
+ my $dfh=IO::File->new($dfname);
+ $cmd=<$dfh>;
+ }
+ chomp($cmd);
+ my $bcmd=$cmd;
+ if ($cmd =~ /^encrypt\:/) {
+ my $rcmd=$cmd;
+ $rcmd =~ s/^encrypt\://;
+ chomp($rcmd);
+ my $cmdlength=length($rcmd);
+ $rcmd.=" ";
+ my $encrequest='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encrequest.=
+ unpack("H16",$cipher->encrypt(substr($rcmd,$encidx,8)));
+ }
+ $cmd="enc:$cmdlength:$encrequest\n";
+ }
+ print $remotesock "$cmd\n";
+ $answer=<$remotesock>;
+ chomp($answer);
+ if ($answer ne '') {
+ unlink("$dfname");
+ &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(
+ "<font color=blue>WARNING: ".
+ "Can't make server socket $conserver ($st secs): $@</font>");
+ sleep($st);
exit;
};
# -----------------------------------------------------------------------------
+&logthis("<font color=green>$conserver online</font>");
+
+# -----------------------------------------------------------------------------
# begin with empty buffers
%inbuffer = ();
%outbuffer = ();
@@ -410,7 +530,3 @@ sub nonblock {
or die "Can't make socket nonblocking: $!\n";
}
-
-
-
-