--- loncom/lond 2004/02/17 21:02:37 1.176 +++ loncom/lond 2004/03/16 20:48:49 1.184 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.176 2004/02/17 21:02:37 albertel Exp $ +# $Id: lond,v 1.184 2004/03/16 20:48:49 raeburn 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.176 $'; #' stupid emacs +my $VERSION='$Revision: 1.184 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -822,7 +822,7 @@ sub REAPER { # ta if (defined($children{$pid})) { &logthis("Child $pid died"); delete($children{$pid}); - } else { + } elsif ($pid > 0) { &logthis("Unknown Child $pid died"); } } while ( $pid > 0 ); @@ -1258,8 +1258,18 @@ 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. @@ -1818,12 +1828,21 @@ sub make_new_child { } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. if(isClient) { my ($cmd,$fname)=split(/:/,$userinput); - my ($udom,$uname,$ufile)=split(/\//,$fname); + my ($udom,$uname,$ufile) = ($fname =~ /^([^\/]+)\/([^\/]+)\/(.+)$/); my $udir=propath($udom,$uname).'/userfiles'; unless (-e $udir) { mkdir($udir,0770); } if (-e $udir) { - $ufile=~s/^[\.\~]+//; - $ufile=~s/\///g; + $ufile=~s/^[\.\~]+//; + my $path = $udir; + if ($ufile =~/(.+)\/([^\/]+)$/) { + my @parts=split(/\//,$1); + foreach my $part (@parts) { + $path .= '/'.$part; + if ((-e $path)!=1) { + mkdir($path,0770); + } + } + } my $destname=$udir.'/'.$ufile; my $transname=$udir.'/'.$ufile.'.in.transit'; my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; @@ -1852,7 +1871,6 @@ sub make_new_child { } } else { Reply($client, "refused\n", $userinput); - } # ------------------------------------------ authenticate access to a user file } elsif ($userinput =~ /^tokenauthuserfile/) { # Client only @@ -1863,7 +1881,7 @@ sub make_new_child { if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. $session.'.id')) { while (my $line=) { - if ($line=~/userfile\.$fname\=/) { $reply='ok'; } + if ($line=~ m|userfile\.$fname\=|) { $reply='ok'; } } close(ENVIN); print $client $reply."\n"; @@ -2006,12 +2024,12 @@ sub make_new_child { } else { print $client "error: ".($!+0) ." untie(GDBM) failed ". - "while attempting put\n"; + "while attempting inc\n"; } } else { print $client "error: ".($!) ." tie(GDBM) Failed ". - "while attempting put\n"; + "while attempting inc\n"; } } else { print $client "refused\n"; @@ -2337,7 +2355,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.'&';