version 1.61, 2001/12/20 17:43:05
|
version 1.63, 2002/01/20 18:01:43
|
Line 45
|
Line 45
|
# 9/30,10/22,11/13,11/15,11/16 Scott Harrison |
# 9/30,10/22,11/13,11/15,11/16 Scott Harrison |
# 11/26,11/27 Gerd Kortemeyer |
# 11/26,11/27 Gerd Kortemeyer |
# 12/20 Scott Harrison |
# 12/20 Scott Harrison |
# |
# 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 83 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 186 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 211 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 430 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 498 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 1089 sub make_new_child {
|
Line 1114 sub make_new_child {
|
} |
} |
# ------------------------------------------------------------------------ dump |
# ------------------------------------------------------------------------ dump |
} elsif ($userinput =~ /^dump/) { |
} elsif ($userinput =~ /^dump/) { |
my ($cmd,$udom,$uname,$namespace) |
my ($cmd,$udom,$uname,$namespace,$regexp) |
=split(/:/,$userinput); |
=split(/:/,$userinput); |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
|
if (defined($regexp)) { |
|
$regexp=&unescape($regexp); |
|
} else { |
|
$regexp='.'; |
|
} |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
foreach $key (keys %hash) { |
foreach $key (keys %hash) { |
$qresult.="$key=$hash{$key}&"; |
if (eval('$key=~/$regexp/')) { |
|
$qresult.="$key=$hash{$key}&"; |
|
} |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
Line 1327 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 |