version 1.175, 2004/02/17 20:07:25
|
version 1.183, 2004/03/09 21:05:13
|
Line 812 $server = IO::Socket::INET->new(LocalPor
|
Line 812 $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; |
Line 822 sub REAPER { # ta
|
Line 821 sub REAPER { # ta
|
$pid = waitpid(-1,&WNOHANG()); |
$pid = waitpid(-1,&WNOHANG()); |
if (defined($children{$pid})) { |
if (defined($children{$pid})) { |
&logthis("Child $pid died"); |
&logthis("Child $pid died"); |
$children --; |
delete($children{$pid}); |
delete $children{$pid}; |
} elsif ($pid > 0) { |
} else { |
|
&logthis("Unknown Child $pid died"); |
&logthis("Unknown Child $pid died"); |
} |
} |
} while ( $pid > 0 ); |
} 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 882 sub ReadHostTable {
|
Line 887 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 1251 sub make_new_child {
|
Line 1258 sub make_new_child {
|
# the pid hash. |
# the pid hash. |
# |
# |
my $caller = getpeername($client); |
my $caller = getpeername($client); |
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my ($port,$iaddr); |
$clientip=inet_ntoa($iaddr); |
if (defined($caller) && length($caller) > 0) { |
|
($port,$iaddr)=unpack_sockaddr_in($caller); |
|
} else { |
|
&logthis("Unable to determine who caller was, getpeername returned nothing"); |
|
} |
|
if (defined($iaddr)) { |
|
$clientip=inet_ntoa($iaddr); |
|
} else { |
|
&logthis("Unable to determine clinetip"); |
|
$clientip='Unavailable'; |
|
} |
|
|
if ($pid) { |
if ($pid) { |
# Parent records the child's birth and returns. |
# Parent records the child's birth and returns. |
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 1811 sub make_new_child {
|
Line 1827 sub make_new_child {
|
# -------------------------------------- fetch a user file from a remote server |
# -------------------------------------- fetch a user file from a remote server |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. |
if(isClient) { |
if(isClient) { |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname,$fpath)=split(/:/,$userinput); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my $udir=propath($udom,$uname).'/userfiles'; |
my $udir=propath($udom,$uname).'/userfiles'; |
unless (-e $udir) { mkdir($udir,0770); } |
unless (-e $udir) { mkdir($udir,0770); } |
if (-e $udir) { |
if (-e $udir) { |
|
unless ($fpath eq '') { |
|
my $filepath = $udir; |
|
my @parts=split(/\//,$fpath); |
|
my $count; |
|
for ($count=0;$count<=$#parts;$count++) { |
|
$filepath .="/$parts[$count]"; |
|
if ((-e $filepath)!=1) { |
|
mkdir($filepath,0770); |
|
} |
|
} |
|
} |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/\///g; |
$ufile=~s/\///g; |
my $destname=$udir.'/'.$ufile; |
my $destname=$udir.'/'.$fpath.$ufile; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $transname=$udir.'/'.$fpath.$ufile.'.in.transit'; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile; |
my $response; |
my $response; |
{ |
{ |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
Line 1830 sub make_new_child {
|
Line 1857 sub make_new_child {
|
if ($response->is_error()) { |
if ($response->is_error()) { |
unlink($transname); |
unlink($transname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fpath $fname ($remoteurl)"); |
print $client "failed\n"; |
print $client "failed\n"; |
} else { |
} else { |
if (!rename($transname,$destname)) { |
if (!rename($transname,$destname)) { |
Line 2000 sub make_new_child {
|
Line 2027 sub make_new_child {
|
} else { |
} else { |
print $client "error: ".($!+0) |
print $client "error: ".($!+0) |
." untie(GDBM) failed ". |
." untie(GDBM) failed ". |
"while attempting put\n"; |
"while attempting inc\n"; |
} |
} |
} else { |
} else { |
print $client "error: ".($!) |
print $client "error: ".($!) |
." tie(GDBM) Failed ". |
." tie(GDBM) Failed ". |
"while attempting put\n"; |
"while attempting inc\n"; |
} |
} |
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
Line 2331 sub make_new_child {
|
Line 2358 sub make_new_child {
|
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { |
study($regexp); |
|
while (my ($key,$value) = each(%hash)) { |
while (my ($key,$value) = each(%hash)) { |
if ($regexp eq '.') { |
if ($regexp eq '.') { |
$qresult.=$key.'='.$value.'&'; |
$qresult.=$key.'='.$value.'&'; |