--- loncom/publisher/loncfile.pm 2002/09/02 20:06:57 1.17 +++ loncom/publisher/loncfile.pm 2003/01/09 22:11:52 1.21 @@ -10,7 +10,7 @@ # # -# $Id: loncfile.pm,v 1.17 2002/09/02 20:06:57 harris41 Exp $ +# $Id: loncfile.pm,v 1.21 2003/01/09 22:11:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -88,6 +88,7 @@ use strict; use Apache::File; use File::Basename; use File::Copy; +use HTML::Entities(); use Apache::Constants qw(:common :http :methods); use Apache::loncacc; use Apache::Log (); @@ -322,20 +323,24 @@ sub exists { my ($user, $domain, $dir, $file) = @_; # Create complete paths in publication and construction space. - - my $published = &PublicationPath($domain, $user, $dir, $file); - my $construct = &ConstructionPath($user, $dir, $file); + my $relativedir=$dir; + $relativedir=s|/home/\Q$user\E/public_html||; + my $published = &PublicationPath($domain, $user, $relativedir, $file); + my $construct = &ConstructionPath($user, $relativedir, $file); # If the resource exists in either space indicate this fact. # Note that the check for existence in resource space is stricter. my $result; + if ( -d $construct ) { + return 'Error: destination for operation is a directory.'; + } if ( -e $published) { - $result.='
Warning: target file exists, and has been published!
'; + $result.='Warning: target file exists, and has been published!
'; } elsif ( -e $construct) { - $result.='Warning: target file exists!
'; - } + $result.='Warning: target file exists!
'; + } return $result; @@ -491,11 +496,17 @@ sub Rename1 { if($ENV{'form.newfilename'}) { my $newfilename = $ENV{'form.newfilename'}; $request->print(&checksuffix($filename, $newfilename)); - $request->print(&exists($user, $domain, $dir, $newfilename)); + my $return=&exists($user, $domain, $dir, $newfilename); + $request->print($return); + if ($return =~/^Error:/) { + $request->print('Rename '.$filename.' to '. - $dir.'/'.$newfilename.'?
'); + '">Rename '.$filename.'
to '.
+ $dest.'?
No new filename specified
'); @@ -586,14 +597,19 @@ sub Copy1 { $cancelurl =~ s/\/public_html//; - if(-e $filename) { $request->print(&checksuffix($filename,$newfilename)); - $request->print(&exists($user, $domain, $dir, $newfilename)); + my $return=&exists($user, $domain, $dir, $newfilename); + $request->print($return); + if ($return =~/^Error:/) { + $request->print('Copy '.$filename.' to'. - ''.$dir.'/'.$newfilename.'/?
'); + '">Copy '.$filename.'
to '.
+ ''.$dest.'?
No such file '.$filename.'
'); @@ -602,6 +618,34 @@ sub Copy1 { =pod +=item SimplifyDir + + Removes all extra / and all .. references + +Parameters: + +=over 4 + +=item $dir - string [in] a directory name + +=item $file - string [in] a file reference relative to $dir + +=back + +Results: the concatenated path. + +=cut + +sub SimplifyDir { + my ($dir,$file) = @_; + my $location = $dir. '/'.$file; + $location=~s://+:/:g; # remove duplicate / + while ($location=~m:/\.\./:) {$location=~s:/[^/]+/\.\./:/:g;}#remove dir/.. + return $location; +} + +=pod + =item NewDir1 Does all phase 1 processing of directory creation: @@ -987,7 +1031,7 @@ sub phasetwo { # Once a resource is deleted, we just list the directory that # previously held it. # - $dest = $dir."/"; # Parent dir. + $dest = $dir."/."; # Parent dir. } elsif ($ENV{'form.action'} eq 'copy') { if($ENV{'form.newfilename'}) { if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { @@ -1016,12 +1060,13 @@ sub phasetwo { # construction space path. # &Debug($r, "Final url is: $dest"); - $dest =~ s/\/home\//\/priv\//; - $dest =~ s/\/public_html//; + $dest =~ s|/home/|/priv/|; + $dest =~ s|/public_html||; - my $base = &Apache::lonnet::escape(&File::Basename::basename($dest)); + my $base = &File::Basename::basename($dest); my $dpath= &File::Basename::dirname($dest); - $dest = $dpath.'/'.$base; + if ($base eq '.') { $base=''; } + $dest = &HTML::Entities::encode($dpath.'/'.$base); &Debug($r, "Final url after rewrite: $dest");