--- loncom/lonnet/perl/lonnet.pm 2004/03/09 16:25:19 1.476 +++ loncom/lonnet/perl/lonnet.pm 2004/03/16 20:15:08 1.477 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.476 2004/03/09 16:25:19 raeburn Exp $ +# $Id: lonnet.pm,v 1.477 2004/03/16 20:15:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1171,7 +1171,8 @@ sub tokenwrapper { $uri=~s/^\///; $ENV{'user.environment'}=~/\/([^\/]+)\.id/; my $token=$1; - if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { +# if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { + if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/(.+)(\?\.*)*$/) { &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. (($uri=~/\?/)?'&':'?').'token='.$token. @@ -1180,19 +1181,68 @@ sub tokenwrapper { return '/adm/notfound.html'; } } - + +# --------------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course +# input: action, courseID, current domain, home server for course, intended path to file, +# source of file. +# output: ok if successful, diagnostic message otherwise +# +# Allows directory structure to be used within lonUsers/../userfiles/ for a course. +# +# action = propagate - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will +# be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles in course's home server. +# +# action = copy - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will be copied +# from $source (current location) to /home/httpd/html/userfiles/$domain/1/2/3/$course/$file +# and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file in +# course's home server. + +sub process_coursefile { + my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_; + my $fetchresult; + if ($action eq 'propagate') { + $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file + ,$docuhome); + } elsif ($action eq 'copy') { + my $fetchresult = ''; + my $fpath = ''; + my $fname = $file; + ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/]+)$/); + $fpath=$docudom.'/'.$docuname.'/'.$fpath; + my $filepath=$perlvar{'lonDocRoot'}.'/userfiles'; + unless ($fpath eq '') { + my @parts=split(/\//,$fpath); + foreach my $part (@parts) { + $filepath.= '/'.$part; + if ((-e $filepath)!=1) { + mkdir($filepath,0777); + } + } + } + if ($source eq '') { + $fetchresult = 'no source file'; + } else { + my $destination = $filepath.'/'.$fname; + print STDERR "Getting ready to rename $source to $destination\n"; + rename($source,$destination); + $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, + $docuhome); + } + } + unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) { + &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. + ' to host '.$docuhome.': '.$fetchresult); + } + return $fetchresult; +} + # --------------- Take an uploaded file and put it into the userfiles directory # input: name of form element, coursedoc=1 means this is for the course # output: url of file in userspace sub userfileupload { - my ($formname,$coursedoc,$filename,$fpath,$source)=@_; - my $fname; - if (defined($filename)) { - $fname = $filename; - } else { - $fname=$ENV{'form.'.$formname.'.filename'}; - } + my ($formname,$coursedoc)=@_; + my $fname=$ENV{'form.'.$formname.'.filename'}; # Replace Windows backslashes by forward slashes $fname=~s/\\/\//g; # Get rid of everything but the actual filename @@ -1203,11 +1253,7 @@ sub userfileupload { $fname=~s/[^\w\.\-]//g; # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } - if ( defined($formname) ) { - if ( defined($ENV{'form.'.$formname}) ) { - chop($ENV{'form.'.$formname}); - } - } + chop($ENV{'form.'.$formname}); # Create the directory if not present my $docuname=''; my $docudom=''; @@ -1222,12 +1268,12 @@ sub userfileupload { $docuhome=$ENV{'user.home'}; } return - &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source); + &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); } sub finishuserfileupload { - my ($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source)=@_; - my $path=$docudom.'/'.$docuname.'/'.$fpath; + my ($docuname,$docudom,$docuhome,$formname,$fname)=@_; + my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; my @parts=split(/\//,$filepath.'/userfiles/'.$path); my $count; @@ -1239,20 +1285,14 @@ sub finishuserfileupload { } # Save the file { - if ($source eq '') { - open(my $fh,'>'.$filepath.'/'.$fname); - print $fh $ENV{'form.'.$formname}; - close($fh); - } else { - my $destination = $filepath.'/'.$fname; - rename($source,$destination); - } + open(my $fh,'>'.$filepath.'/'.$fname); + print $fh $ENV{'form.'.$formname}; + close($fh); } # Notify homeserver to grep it # - - my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname. - ':'.$fpath,$docuhome); + my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname, + $docuhome); if ($fetchresult eq 'ok') { # # Return the URL to it