--- loncom/publisher/loncfile.pm 2003/08/04 20:34:19 1.39 +++ loncom/publisher/loncfile.pm 2003/11/08 10:48:33 1.43 @@ -9,7 +9,7 @@ # and displays a page showing the results of the action. # # -# $Id: loncfile.pm,v 1.39 2003/08/04 20:34:19 www Exp $ +# $Id: loncfile.pm,v 1.43 2003/11/08 10:48:33 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -168,7 +168,7 @@ sub url { sub display { my $fn=shift; - $fn=~s/^\/home\/(\w+)\/public\_html//; + $fn=~s-^/home/(\w+)/public_html-/priv/$1-; return ''.$fn.''; } @@ -387,6 +387,10 @@ sub Rename1 { if(-e $fn) { if($newfilename) { + # is dest a dir + if (-d $newfilename) { + if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } + } if ($newfilename =~ m|/[^\.]+$|) { #no extension add on original extension if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { @@ -399,6 +403,10 @@ sub Rename1 { if (-d $fn) { $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; } + $newfilename=~s://+:/:g; # remove duplicate / + while ($newfilename=~m:/\.\./:) { + $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. + } my $return=&exists($user, $domain, $newfilename); $request->print($return); if ($return =~/^Error:/) { @@ -485,24 +493,36 @@ Parameters: =cut sub Copy1 { - my ($request, $user, $domain, $fn, $newfilename) = @_; + my ($request, $user, $domain, $fn, $newfilename) = @_; - if(-e $fn) { - $request->print(&checksuffix($fn,$newfilename)); - my $return=&exists($user, $domain, $newfilename); - $request->print($return); - if ($return =~/^Error:/) { - $request->print('
Cancel'); - return; + if(-e $fn) { + # is dest a dir + if (-d $newfilename) { + if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } + } + if ($newfilename =~ m|/[^\.]+$|) { + #no extension add on original extension + if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; } + } + $newfilename=~s://+:/:g; # remove duplicate / + while ($newfilename=~m:/\.\./:) { + $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. + } + $request->print(&checksuffix($fn,$newfilename)); + my $return=&exists($user, $domain, $newfilename); + $request->print($return); + if ($return =~/^Error:/) { + $request->print('
Cancel'); + return; + } + $request->print('

Copy '.&display($fn).'
to '. + &display($newfilename).'?

'); + &CloseForm1($request, $fn); + } else { + $request->print('

No such file: '.&display($fn).'

'); } - $request->print('

Copy '.&display($fn).'
to '. - &display($newfilename).'?

'); - &CloseForm1($request, $fn); - } else { - $request->print('

No such file: '.&display($fn).'

'); - } } =pod @@ -605,6 +625,14 @@ sub NewFile1 { if ($ENV{'form.action'} =~ /new(.+)file/) { my $extension=$1; + + ##Informs User (name).(number).(extension) not allowed + if($newfilename =~ /\.(\d+)\.(\w+)$/){ + $r->print(''.$newfilename. + ' - Bad Filename
(name).(number).(extension)'. + ' Not Allowed
'); + return; + } if ($newfilename !~ /\Q.$extension\E$/) { if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) { #already has an extension strip it and add in expected one @@ -736,10 +764,44 @@ sub Rename2 { &Debug($request, "Target is: ".$directory.'/'. $newfile); if (-e $oldfile) { + + my $oRN=$oldfile; + my $nRN=$newfile; unless (rename($oldfile,$newfile)) { $request->print('Error: '.$!.''); return 0; } + ## If old name.(extension) exits, move under new name. + ## If it doesn't exist and a new.(extension) exists + ## delete it (only concern when renaming over files) + my $tmp1=$oRN.'.meta'; + my $tmp2=$nRN.'.meta'; + if(-e $tmp1){ + unless(rename($tmp1,$tmp2)){ } + } elsif(-e $tmp2){ + unlink $tmp2; + } + $tmp1=$oRN.'.save'; + $tmp2=$nRN.'.save'; + if(-e $tmp1){ + unless(rename($tmp1,$tmp2)){ } + } elsif(-e $tmp2){ + unlink $tmp2; + } + $tmp1=$oRN.'.log'; + $tmp2=$nRN.'.log'; + if(-e $tmp1){ + unless(rename($tmp1,$tmp2)){ } + } elsif(-e $tmp2){ + unlink $tmp2; + } + $tmp1=$oRN.'.bak'; + $tmp2=$nRN.'.bak'; + if(-e $tmp1){ + unless(rename($tmp1,$tmp2)){ } + } elsif(-e $tmp2){ + unlink $tmp2; + } } else { $request->print("

No such file: ".&display($oldfile).'

'); return 0;