--- loncom/lond 2004/03/08 21:00:15 1.181 +++ loncom/lond 2004/03/09 16:12:26 1.182 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.181 2004/03/08 21:00:15 albertel Exp $ +# $Id: lond,v 1.182 2004/03/09 16:12:26 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.181 $'; #' stupid emacs +my $VERSION='$Revision: 1.182 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -1827,16 +1827,27 @@ sub make_new_child { # -------------------------------------- fetch a user file from a remote server } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc. if(isClient) { - my ($cmd,$fname)=split(/:/,$userinput); + my ($cmd,$fname,$fpath)=split(/:/,$userinput); my ($udom,$uname,$ufile)=split(/\//,$fname); my $udir=propath($udom,$uname).'/userfiles'; unless (-e $udir) { mkdir($udir,0770); } 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/\///g; - my $destname=$udir.'/'.$ufile; - my $transname=$udir.'/'.$ufile.'.in.transit'; - my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; + my $destname=$udir.'/'.$fpath.$ufile; + my $transname=$udir.'/'.$fpath.$ufile.'.in.transit'; + my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile; my $response; { my $ua=new LWP::UserAgent; @@ -1846,7 +1857,7 @@ sub make_new_child { if ($response->is_error()) { unlink($transname); my $message=$response->status_line; - &logthis("LWP GET: $message for $fname ($remoteurl)"); + &logthis("LWP GET: $message for $fpath $fname ($remoteurl)"); print $client "failed\n"; } else { if (!rename($transname,$destname)) {