Diff for /loncom/lond between versions 1.62 and 1.63

version 1.62, 2001/12/22 21:46:02 version 1.63, 2002/01/20 18:01:43
Line 46 Line 46
 # 11/26,11/27 Gerd Kortemeyer  # 11/26,11/27 Gerd Kortemeyer
 # 12/20 Scott Harrison  # 12/20 Scott Harrison
 # 12/22 Gerd Kortemeyer  # 12/22 Gerd Kortemeyer
 #  # YEAR=2002
   # 01/20/02 Gerd Kortemeyer
 ###  ###
   
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
Line 84  sub catchexception { Line 85  sub catchexception {
     die($error);      die($error);
 }  }
   
   sub timeout {
       &logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>");
       &catchexception('Timeout');
   }
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
 $SIG{'QUIT'}=\&catchexception;  $SIG{'QUIT'}=\&catchexception;
Line 187  sub checkchildren { Line 192  sub checkchildren {
     &initnewstatus();      &initnewstatus();
     &logstatus();      &logstatus();
     &logthis('Going to check on the children');      &logthis('Going to check on the children');
       $docdir=$perlvar{'lonDocRoot'};
     foreach (sort keys %children) {      foreach (sort keys %children) {
           unlink("$docdir/lon-status/londchld/$_.txt");
  sleep 1;   sleep 1;
         unless (kill 'USR1' => $_) {          unless (kill 'USR1' => $_) {
     &logthis ('Child '.$_.' is dead');      &logthis ('Child '.$_.' is dead');
             &logstatus($$.' is dead');              &logstatus($$.' is dead');
         }           } 
     }      }
       sleep 5;
       foreach (sort keys %children) {
           unless (-e "$docdir/lon-status/londchld/$_.txt") {
       &logthis('Child '.$_.' did not respond');
               kill -9 => $_;
           }
       }
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 212  sub logthis { Line 226  sub logthis {
   
 sub logstatus {  sub logstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
       {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
     print $fh $$."\t".$status."\t".$lastlog."\n";      print $fh $$."\t".$status."\t".$lastlog."\n";
       $fh->close();
       }
       {
    my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");
           print $fh $status."\n".$lastlog."\n".time;
           $fh->close();
       }
 }  }
   
 sub initnewstatus {  sub initnewstatus {
Line 431  sub make_new_child { Line 453  sub make_new_child {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
           $SIG{ALRM}= \&timeout;
         $lastlog='Forked ';          $lastlog='Forked ';
         $status='Forked';          $status='Forked';
   
Line 499  sub make_new_child { Line 522  sub make_new_child {
                 chomp($userinput);                  chomp($userinput);
                 &status('Processing '.$hostid{$clientip}.': '.$userinput);                  &status('Processing '.$hostid{$clientip}.': '.$userinput);
                 my $wasenc=0;                  my $wasenc=0;
                   alarm(120);
 # ------------------------------------------------------------ See if encrypted  # ------------------------------------------------------------ See if encrypted
  if ($userinput =~ /^enc/) {   if ($userinput =~ /^enc/) {
   if ($cipher) {    if ($cipher) {
Line 1335  sub make_new_child { Line 1359  sub make_new_child {
                        print $client "unknown_cmd\n";                         print $client "unknown_cmd\n";
                    }                     }
 # -------------------------------------------------------------------- complete  # -------------------------------------------------------------------- complete
      alarm(0);
                    &status('Listening to '.$hostid{$clientip});                     &status('Listening to '.$hostid{$clientip});
        }         }
 # --------------------------------------------- client unknown or fishy, refuse  # --------------------------------------------- client unknown or fishy, refuse

Removed from v.1.62  
changed lines
  Added in v.1.63


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>