--- loncom/lond 2001/12/20 17:43:05 1.61 +++ loncom/lond 2002/02/06 14:18:09 1.68.2.1 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.61 2001/12/20 17:43:05 harris41 Exp $ +# $Id: lond,v 1.68.2.1 2002/02/06 14:18:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -45,7 +45,9 @@ # 9/30,10/22,11/13,11/15,11/16 Scott Harrison # 11/26,11/27 Gerd Kortemeyer # 12/20 Scott Harrison -# +# 12/22 Gerd Kortemeyer +# YEAR=2002 +# 01/20/02,02/05 Gerd Kortemeyer ### # based on "Perl Cookbook" ISBN 1-56592-243-3 @@ -83,6 +85,10 @@ sub catchexception { die($error); } +sub timeout { + &logthis("CRITICAL: TIME OUT ".$$.""); + &catchexception('Timeout'); +} # -------------------------------- Set signal handlers to record abnormal exits $SIG{'QUIT'}=\&catchexception; @@ -157,9 +163,13 @@ $children = 0; # cu sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; my $pid = wait; - $children --; - &logthis("Child $pid died"); - delete $children{$pid}; + if (defined($children{$pid})) { + &logthis("Child $pid died"); + $children --; + delete $children{$pid}; + } else { + &logthis("Unknown Child $pid died"); + } } sub HUNTSMAN { # signal handler for SIGINT @@ -186,6 +196,7 @@ sub checkchildren { &initnewstatus(); &logstatus(); &logthis('Going to check on the children'); + $docdir=$perlvar{'lonDocRoot'}; foreach (sort keys %children) { sleep 1; unless (kill 'USR1' => $_) { @@ -193,6 +204,18 @@ sub checkchildren { &logstatus($$.' is dead'); } } + sleep 5; + foreach (sort keys %children) { + unless (-e "$docdir/lon-status/londchld/$_.txt") { + &logthis('Child '.$_.' did not respond'); + kill 9 => $_; + $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + $subj="LON: $perlvar{'lonHostID'} killed lond process $_"; + my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; + $execdir=$perlvar{'lonDaemons'}; + $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_` + } + } } # --------------------------------------------------------------------- Logging @@ -211,8 +234,16 @@ sub logthis { sub logstatus { my $docdir=$perlvar{'lonDocRoot'}; + { my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); 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 { @@ -221,6 +252,11 @@ sub initnewstatus { my $now=time; my $local=localtime($now); print $fh "LOND status $local - parent $$\n\n"; + opendir(DIR,"$docdir/lon-status/londchld"); + while ($filename=readdir(DIR)) { + unlink("$docdir/lon-status/londchld/$filename"); + } + closedir(DIR); } # -------------------------------------------------------------- Status setting @@ -430,6 +466,7 @@ sub make_new_child { # Child can *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before $SIG{USR1}= \&logstatus; + $SIG{ALRM}= \&timeout; $lastlog='Forked '; $status='Forked'; @@ -497,7 +534,9 @@ sub make_new_child { while (my $userinput=<$client>) { chomp($userinput); &status('Processing '.$hostid{$clientip}.': '.$userinput); + &logthis('Processing '.$hostid{$clientip}.': '.$userinput); my $wasenc=0; + alarm(120); # ------------------------------------------------------------ See if encrypted if ($userinput =~ /^enc/) { if ($cipher) { @@ -512,7 +551,9 @@ sub make_new_child { $userinput=substr($userinput,0,$cmdlength); $wasenc=1; } - } + &logthis('Decrypted '.$hostid{$clientip}.': '.$userinput); + } + # ------------------------------------------------------------- Normal commands # ------------------------------------------------------------------------ ping if ($userinput =~ /^ping/) { @@ -676,7 +717,7 @@ sub make_new_child { $fpnow.='/'.$fpparts[$i]; unless (-e $fpnow) { unless (mkdir($fpnow,0777)) { - $fperror="error:$!\n"; + $fperror="error:$!"; } } } @@ -1089,15 +1130,22 @@ sub make_new_child { } # ------------------------------------------------------------------------ dump } elsif ($userinput =~ /^dump/) { - my ($cmd,$udom,$uname,$namespace) + my ($cmd,$udom,$uname,$namespace,$regexp) =split(/:/,$userinput); $namespace=~s/\//\_/g; $namespace=~s/\W//g; + if (defined($regexp)) { + $regexp=&unescape($regexp); + } else { + $regexp='.'; + } my $proname=propath($udom,$uname); my $qresult=''; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { foreach $key (keys %hash) { - $qresult.="$key=$hash{$key}&"; + if (eval('$key=~/$regexp/')) { + $qresult.="$key=$hash{$key}&"; + } } if (untie(%hash)) { $qresult=~s/\&$//; @@ -1327,7 +1375,9 @@ sub make_new_child { print $client "unknown_cmd\n"; } # -------------------------------------------------------------------- complete + alarm(0); &status('Listening to '.$hostid{$clientip}); + &logthis('Completed '.$userinput.' Listening to '.$hostid{$clientip}); } # --------------------------------------------- client unknown or fishy, refuse } else {