version 1.62, 2001/12/22 21:46:02
|
version 1.69, 2002/02/07 10:17:00
|
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,02/05 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 131 open (CONFIG,"$perlvar{'lonTabDir'}/host
|
Line 136 open (CONFIG,"$perlvar{'lonTabDir'}/host
|
|
|
while ($configline=<CONFIG>) { |
while ($configline=<CONFIG>) { |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
chomp($ip); |
chomp($ip); $ip=~s/\D+$//g; |
$hostid{$ip}=$id; |
$hostid{$ip}=$id; |
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
$PREFORK++; |
$PREFORK++; |
Line 158 $children = 0; # cu
|
Line 163 $children = 0; # cu
|
sub REAPER { # takes care of dead children |
sub REAPER { # takes care of dead children |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
my $pid = wait; |
my $pid = wait; |
$children --; |
if (defined($children{$pid})) { |
&logthis("Child $pid died"); |
&logthis("Child $pid died"); |
delete $children{$pid}; |
$children --; |
|
delete $children{$pid}; |
|
} else { |
|
&logthis("Unknown Child $pid died"); |
|
} |
} |
} |
|
|
sub HUNTSMAN { # signal handler for SIGINT |
sub HUNTSMAN { # signal handler for SIGINT |
Line 187 sub checkchildren {
|
Line 196 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) { |
sleep 1; |
sleep 1; |
unless (kill 'USR1' => $_) { |
unless (kill 'USR1' => $_) { |
Line 194 sub checkchildren {
|
Line 204 sub checkchildren {
|
&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 => $_; |
|
$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 |
# --------------------------------------------------------------------- Logging |
Line 212 sub logthis {
|
Line 234 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 222 sub initnewstatus {
|
Line 252 sub initnewstatus {
|
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
print $fh "LOND status $local - parent $$\n\n"; |
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 |
# -------------------------------------------------------------- Status setting |
Line 431 sub make_new_child {
|
Line 466 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 535 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 677 sub make_new_child {
|
Line 714 sub make_new_child {
|
$fpnow.='/'.$fpparts[$i]; |
$fpnow.='/'.$fpparts[$i]; |
unless (-e $fpnow) { |
unless (-e $fpnow) { |
unless (mkdir($fpnow,0777)) { |
unless (mkdir($fpnow,0777)) { |
$fperror="error:$!\n"; |
$fperror="error:$!"; |
} |
} |
} |
} |
} |
} |
Line 1335 sub make_new_child {
|
Line 1372 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 |