--- loncom/lond 2004/02/17 20:07:25 1.175 +++ loncom/lond 2004/03/08 20:59:41 1.180 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.175 2004/02/17 20:07:25 albertel Exp $ +# $Id: lond,v 1.180 2004/03/08 20:59:41 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.175 $'; #' stupid emacs +my $VERSION='$Revision: 1.180 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -812,7 +812,6 @@ $server = IO::Socket::INET->new(LocalPor # global variables my %children = (); # keys are current child process IDs -my $children = 0; # current number of children sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; @@ -822,12 +821,18 @@ sub REAPER { # ta $pid = waitpid(-1,&WNOHANG()); if (defined($children{$pid})) { &logthis("Child $pid died"); - $children --; - delete $children{$pid}; + delete($children{$pid}); } 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"); } @@ -882,12 +887,14 @@ sub ReadHostTable { open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; while (my $configline=) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); $ip=~s/\D+$//; - $hostid{$ip}=$id; - $hostdom{$id}=$domain; - $hostip{$id}=$ip; - if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } + if (!($configline =~ /^\s*\#/)) { + my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); + chomp($ip); $ip=~s/\D+$//; + $hostid{$ip}=$id; + $hostdom{$id}=$domain; + $hostip{$id}=$ip; + if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } + } } close(CONFIG); } @@ -1251,15 +1258,24 @@ sub make_new_child { # the pid hash. # my $caller = getpeername($client); - my ($port,$iaddr)=unpack_sockaddr_in($caller); - $clientip=inet_ntoa($iaddr); + my ($port,$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) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = $clientip; - $children++; &status('Started child '.$pid); return; } else { @@ -2331,7 +2347,6 @@ sub make_new_child { my $proname=propath($udom,$uname); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { - study($regexp); while (my ($key,$value) = each(%hash)) { if ($regexp eq '.') { $qresult.=$key.'='.$value.'&';