version 1.171, 2004/01/14 01:08:31
|
version 1.175, 2004/02/17 20:07:25
|
Line 817 my $children = 0; #
|
Line 817 my $children = 0; #
|
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 { |
$children --; |
&logthis("Unknown Child $pid died"); |
delete $children{$pid}; |
} |
} else { |
|
&logthis("Unknown Child $pid died"); |
|
} |
|
} while ( $pid > 0 ); |
&status("Finished Handling child death"); |
&status("Finished Handling child death"); |
} |
} |
|
|
Line 1020 sub logstatus {
|
Line 1023 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 2213 sub make_new_child {
|
Line 2216 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"; |
Line 2724 sub make_new_child {
|
Line 2727 sub make_new_child {
|
# -------------------------------------------------------------------------- ls |
# -------------------------------------------------------------------------- ls |
} elsif ($userinput =~ /^ls/) { |
} elsif ($userinput =~ /^ls/) { |
if(isClient) { |
if(isClient) { |
|
my $obs; |
|
my $rights; |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
my ($cmd,$ulsdir)=split(/:/,$userinput); |
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
Line 2731 sub make_new_child {
|
Line 2736 sub make_new_child {
|
if(-d $ulsdir) { |
if(-d $ulsdir) { |
if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
|
undef $obs, $rights; |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
$ulsout.=$ulsfn.'&'. |
#We do some obsolete checking here |
join('&',@ulsstats).':'; |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
|
open(FILE, $ulsdir.'/'.$ulsfn.".meta"); |
|
my @obsolete=<FILE>; |
|
foreach my $obsolete (@obsolete) { |
|
if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } |
|
if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; } |
|
} |
|
} |
|
$ulsout.=$ulsfn.'&'.join('&',@ulsstats); |
|
if($obs eq '1') { $ulsout.="&1"; } |
|
else { $ulsout.="&0"; } |
|
if($rights eq '1') { $ulsout.="&1:"; } |
|
else { $ulsout.="&0:"; } |
} |
} |
closedir(LSDIR); |
closedir(LSDIR); |
} |
} |