--- loncom/Attic/lonc	2000/02/08 17:34:24	1.5
+++ loncom/Attic/lonc	2000/12/05 16:51:41	1.9
@@ -12,7 +12,7 @@
 
 # 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 Gerd Kortemeyer 
+# 2/8,7/25 Gerd Kortemeyer 
 # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking
 
@@ -25,11 +25,38 @@ use Fcntl;
 use Tie::RefHash;
 use Crypt::IDEA;
 
+# grabs exception and records it to log before exiting
+sub catchexception {
+    my ($signal)=@_;
+    &logthis("<font color=red>CRITICAL: "
+     ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+     ."$signal with this parameter->[$@]</font>");
+    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("<font color=red>CRITICAL: "
+     ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+     ."\_\_DIE\_\_ with this parameter->[$message]</font>");
+    die($message);
+}
+
 $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";
+open (CONFIG,"/etc/httpd/conf/access.conf") 
+    || catchdie "Can't read access.conf";
 
 while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {
@@ -40,9 +67,21 @@ while ($configline=<CONFIG>) {
 }
 close(CONFIG);
 
+# --------------------------------------------- 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) { catchdie "already running"; }
+}
+
 # ------------------------------------------------------------- Read hosts file
 
-open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
+open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") 
+    || catchdie "Can't read host file";
 
 while ($configline=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
@@ -64,8 +103,8 @@ sub REAPER {                        # ta
     $SIG{CHLD} = \&REAPER;
     my $pid = wait;
     my $wasserver=$children{$pid};
-    &logthis(
-     "<font color=red>CRITICAL: Child $pid for server $wasserver died</font>");
+    &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";
@@ -90,13 +129,14 @@ sub HUPSMAN {                      # sig
 }
 
 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
@@ -142,9 +182,9 @@ sub logperm {
 
 $fpid=fork;
 exit if $fpid;
-die "Couldn't fork: $!" unless defined ($fpid);
+catchdie "Couldn't fork: $!" unless defined ($fpid);
 
-POSIX::setsid() or die "Can't start new session: $!";
+POSIX::setsid() or catchdie "Can't start new session: $!";
 
 # ------------------------------------------------------- Write our PID on disk
 
@@ -178,13 +218,12 @@ while (1) {
                                     # See who died and start new one
     foreach $thisserver (keys %hostip) {
         if (!$childpid{$thisserver}) {
-	    if ($childatt{$thisserver}<=$childmaxattempt) {
-	       my $ainfoatt=1*$childatt{$thisserver};
+	    if ($childatt{$thisserver}<=$childmaxattempts) {
+	       $childatt{$thisserver}++;
                &logthis(
    "<font color=yellow>INFO: Trying to reconnect for $thisserver "
-  ."($ainfoatt of $childmaxattempts attempts)</font>"); 
+  ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
                make_new_child($thisserver);
-               $childatt{$thisserver}++;
 	    }
         }       
     }
@@ -200,14 +239,14 @@ sub make_new_child {
     # block signal for fork
     $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)
-        or die "Can't block SIGINT for fork: $!\n";
+        or catchdie "Can't block SIGINT for fork: $!\n";
     
-    die "fork: $!" unless defined ($pid = fork);
+    catchdie "fork: $!" unless defined ($pid = fork);
     
     if ($pid) {
         # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)
-            or die "Can't unblock SIGINT for fork: $!\n";
+            or catchdie "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $conserver;
         $childpid{$conserver} = $pid;
         return;
@@ -217,7 +256,7 @@ sub make_new_child {
     
         # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)
-            or die "Can't unblock SIGINT for fork: $!\n";
+            or catchdie "Can't unblock SIGINT for fork: $!\n";
 
 # ----------------------------- This is the modified main program of non-forker
 
@@ -484,12 +523,8 @@ sub nonblock {
 
     
     $flags = fcntl($socket, F_GETFL, 0)
-            or die "Can't get flags for socket: $!\n";
+            or catchdie "Can't get flags for socket: $!\n";
     fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
-            or die "Can't make socket nonblocking: $!\n";
+            or catchdie "Can't make socket nonblocking: $!\n";
 }
 
-
-
-
-