--- loncom/lond	2001/11/16 16:26:01	1.56
+++ loncom/lond	2001/11/26 20:31:01	1.57
@@ -17,8 +17,9 @@
 # 04/02 Scott Harrison
 # 05/11,05/28,08/30 Gerd Kortemeyer
 # 9/30,10/22,11/13,11/15,11/16 Scott Harrison
+# 11/26 Gerd Kortemeyer
 #
-# $Id: lond,v 1.56 2001/11/16 16:26:01 harris41 Exp $
+# $Id: lond,v 1.57 2001/11/26 20:31:01 www Exp $
 ###
 
 # based on "Perl Cookbook" ISBN 1-56592-243-3
@@ -39,6 +40,9 @@ use Authen::Krb4;
 use lib '/home/httpd/lib/perl/';
 use localauth;
 
+my $status='';
+my $lastlog='';
+
 # grabs exception and records it to log before exiting
 sub catchexception {
     my ($error)=@_;
@@ -47,6 +51,7 @@ sub catchexception {
     &logthis("<font color=red>CRITICAL: "
      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
      ."a crash with this error msg->[$error]</font>");
+    &logthis('Famous last words: '.$status.' - '.$lastlog);
     if ($client) { print $client "error: $error\n"; }
     die($error);
 }
@@ -149,6 +154,19 @@ sub HUPSMAN {                      # sig
     exec("$execdir/lond");         # here we go again
 }
 
+sub checkchildren {
+    &initnewstatus();
+    &logstatus();
+    &logthis('Going to check on the children');
+    map {
+	sleep 1;
+        unless (kill 'USR1' => $_) {
+	    &logthis ('Child '.$_.' is dead');
+            &logstatus($$.' is dead');
+        } 
+    } sort keys %children;
+}
+
 # --------------------------------------------------------------------- Logging
 
 sub logthis {
@@ -160,6 +178,30 @@ sub logthis {
     print $fh "$local ($$): $message\n";
 }
 
+# ------------------------------------------------------------------ Log status
+
+sub logstatus {
+    my $docdir=$perlvar{'lonDocRoot'};
+    my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
+    print $fh $$."\t".$status."\t".$lastlog."\n";
+}
+
+sub initnewstatus {
+    my $docdir=$perlvar{'lonDocRoot'};
+    my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
+    my $now=time;
+    my $local=localtime($now);
+    print $fh "LOND status $local - parent $$\n\n";
+}
+
+# -------------------------------------------------------------- Status setting
+
+sub status {
+    my $what=shift;
+    my $now=time;
+    my $local=localtime($now);
+    $status=$local.': '.$what;
+}
 
 # -------------------------------------------------------- Escape Special Chars
 
@@ -306,6 +348,7 @@ open (PIDSAVE,">$execdir/logs/lond.pid")
 print PIDSAVE "$$\n";
 close(PIDSAVE);
 &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
+&status('Starting');
 
 # ------------------------------------------------------- Now we are on our own
     
@@ -316,13 +359,19 @@ for (1 .. $PREFORK) {
 
 # ----------------------------------------------------- Install signal handlers
 
+&status('Forked children');
+
 $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;
+$SIG{USR1} = \&checkchildren;
 
 # And maintain the population.
 while (1) {
+    &status('Sleeping');
     sleep;                          # wait for a signal (i.e., child's death)
+    &logthis('Woke up');
+    &status('Woke up');
     for ($i = $children; $i < $PREFORK; $i++) {
         make_new_child();           # top up the child pool
     }
@@ -346,11 +395,15 @@ sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;
         $children++;
+        &status('Started child '.$pid);
         return;
     } else {
         # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
-    
+        $SIG{USR1}= \&logstatus;
+        $lastlog='Forked ';
+        $status='Forked';
+
         # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";
@@ -359,8 +412,9 @@ sub make_new_child {
     
         # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
+            &status('Idle, waiting for connection');
             $client = $server->accept()     or last;
-
+            &status('Accepted connection');
 # =============================================================================
             # do something with the connection
 # -----------------------------------------------------------------------------
@@ -372,13 +426,17 @@ sub make_new_child {
             &logthis(
 "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
             );
+            &status("Connecting $clientip ($hostid{$clientip})"); 
             my $clientok;
             if ($clientrec) {
+	      &status("Waiting for init from $clientip ($hostid{$clientip})");
 	      my $remotereq=<$client>;
               $remotereq=~s/\W//g;
               if ($remotereq eq 'init') {
 		  my $challenge="$$".time;
                   print $client "$challenge\n";
+                  &status(
+           "Waiting for challenge reply from $clientip ($hostid{$clientip})"); 
                   $remotereq=<$client>;
                   $remotereq=~s/\W//g;
                   if ($challenge eq $remotereq) {
@@ -388,26 +446,31 @@ sub make_new_child {
 		      &logthis(
  "<font color=blue>WARNING: $clientip did not reply challenge</font>");
                       print $client "bye\n";
+                      &status('No challenge reply '.$clientip);
                   }
               } else {
 		  &logthis(
                     "<font color=blue>WARNING: "
                    ."$clientip failed to initialize: >$remotereq< </font>");
 		  print $client "bye\n";
+                  &status('No init '.$clientip);
               }
 	    } else {
               &logthis(
  "<font color=blue>WARNING: Unknown client $clientip</font>");
               print $client "bye\n";
+              &status('Hung up on '.$clientip);
             }
             if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again
 	      &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
               &logthis(
        "<font color=green>Established connection: $hostid{$clientip}</font>");
+              &status('Listening to '.$hostid{$clientip});
 # ------------------------------------------------------------ Process requests
               while (my $userinput=<$client>) {
                 chomp($userinput);
+                &status('Processing '.$hostid{$clientip}.': '.$userinput);
                 my $wasenc=0;
 # ------------------------------------------------------------ See if encrypted
 		if ($userinput =~ /^enc/) {