version 1.165.2.1, 2004/01/14 01:20:40
|
version 1.165.2.3, 2004/03/08 20:13:07
|
Line 577 $server = IO::Socket::INET->new(LocalPor
|
Line 577 $server = IO::Socket::INET->new(LocalPor
|
# global variables |
# global variables |
|
|
my %children = (); # keys are current child process IDs |
my %children = (); # keys are current child process IDs |
my $children = 0; # current number of children |
|
|
|
sub REAPER { # takes care of dead children |
sub REAPER { # takes care of dead children |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
&status("Handling child death"); |
&status("Handling child death"); |
my $pid = wait; |
my $pid; |
if (defined($children{$pid})) { |
do { |
&logthis("Child $pid died"); |
$pid = waitpid(-1,&WNOHANG()); |
$children --; |
if (defined($children{$pid})) { |
delete $children{$pid}; |
&logthis("Child $pid died"); |
} else { |
delete($children{$pid}); |
&logthis("Unknown Child $pid died"); |
} else { |
|
&logthis("Unknown Child $pid died"); |
|
} |
|
} while ( $pid > 0 ); |
|
foreach my $child (keys(%children)) { |
|
$pid = waitpid($child,&WNOHANG()); |
|
if ($pid > 0) { |
|
&logthis("Child $child - $pid looks like we missed it's death"); |
|
delete($children{$pid}); |
|
} |
} |
} |
&status("Finished Handling child death"); |
&status("Finished Handling child death"); |
} |
} |
Line 644 sub ReadHostTable {
|
Line 652 sub ReadHostTable {
|
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
|
|
while (my $configline=<CONFIG>) { |
while (my $configline=<CONFIG>) { |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
if (!($configline =~ /^\s*\#/)) { |
chomp($ip); $ip=~s/\D+$//; |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
$hostid{$ip}=$id; |
chomp($ip); $ip=~s/\D+$//; |
$hostdom{$id}=$domain; |
$hostid{$ip}=$id; |
$hostip{$id}=$ip; |
$hostdom{$id}=$domain; |
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
$hostip{$id}=$ip; |
|
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
|
} |
} |
} |
close(CONFIG); |
close(CONFIG); |
} |
} |
Line 785 sub logstatus {
|
Line 795 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".$currenthostid."\t".$status."\t".$lastlog."\n"; |
print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; |
$fh->close(); |
$fh->close(); |
} |
} |
&status("Finished londstatus.txt"); |
&status("Finished londstatus.txt"); |
Line 1021 sub make_new_child {
|
Line 1031 sub make_new_child {
|
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
$children{$pid} = $clientip; |
$children{$pid} = $clientip; |
$children++; |
|
&status('Started child '.$pid); |
&status('Started child '.$pid); |
return; |
return; |
} else { |
} else { |
Line 1959 sub make_new_child {
|
Line 1968 sub make_new_child {
|
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
foreach my $key (@keys) { |
foreach my $key (@keys) { |
delete($hash{&unescape($key)}); |
delete($hash{$key}); |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |