--- loncom/Attic/lonc	2000/07/25 16:03:57	1.7
+++ loncom/Attic/lonc	2001/08/30 20:02:28	1.17
@@ -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 Gerd Kortemeyer
+# 
 # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking
 
@@ -25,7 +30,23 @@ use Fcntl;
 use Tie::RefHash;
 use Crypt::IDEA;
 
-$childmaxattempts=10;
+# 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=5;
+
+# -------------------------------- Set signal handlers to record abnormal exits
+
+$SIG{'QUIT'}=\&catchexception;
+$SIG{__DIE__}=\&catchexception;
 
 # ------------------------------------ Read httpd access.conf and get variables
 
@@ -40,6 +61,16 @@ while ($configline=<CONFIG>) {
 }
 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";
@@ -85,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("<font color=red>CRITICAL: Shutting down</font>");
@@ -94,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("<font color=red>CRITICAL: Restarting</font>");
+    unlink("$execdir/logs/lonc.pid");
     my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lonc");         # here we go again
 }
@@ -190,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(
    "<font color=yellow>INFO: Trying to reconnect for $thisserver "
@@ -255,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(
+"<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");
+       sleep($st);
+       exit; 
+}
 sleep 5;
 print $remotesock "pong\n";
 $answer=<$remotesock>;
@@ -272,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(
@@ -362,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
@@ -411,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};
@@ -500,7 +552,3 @@ sub nonblock {
             or die "Can't make socket nonblocking: $!\n";
 }
 
-
-
-
-