--- loncom/Attic/lonc	2000/12/05 03:23:59	1.8
+++ loncom/Attic/lonc	2001/06/12 15:32:38	1.16
@@ -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,6 +30,17 @@ 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
@@ -34,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=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {
@@ -46,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";
@@ -54,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=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
@@ -103,6 +127,7 @@ sub HUPSMAN {                      # sig
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     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
 }
@@ -161,9 +186,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
 
@@ -218,14 +243,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;
@@ -235,7 +260,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
 
@@ -279,7 +304,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(
@@ -369,7 +394,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
@@ -418,16 +443,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};
@@ -502,29 +532,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";
-}
-
-# 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);
+            or die "Can't make socket nonblocking: $!\n";
 }