--- loncom/publisher/loncfile.pm 2002/09/02 20:06:57 1.17 +++ loncom/publisher/loncfile.pm 2003/02/04 21:54:17 1.22 @@ -10,7 +10,7 @@ # # -# $Id: loncfile.pm,v 1.17 2002/09/02 20:06:57 harris41 Exp $ +# $Id: loncfile.pm,v 1.22 2003/02/04 21:54:17 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 (); @@ -127,7 +128,7 @@ sub Debug { my $log = $r->log; my $message = shift; - # Put out the indicated message butonly if DEBUG is false. + # Put out the indicated message butonly if DEBUG is true. if ($DEBUG) { $log->debug($message); @@ -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; @@ -408,7 +413,7 @@ sub CloseForm1 { &Debug($request, "Cancel url is: ".$cancelurl); $request->print(''); $request->print(''); + '" method="GET">');
}
@@ -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('
Cancel');
+ return;
+ }
+ my $dest=&SimplifyDir($dir,$newfilename);
$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: @@ -662,6 +706,84 @@ sub NewDir1 =pod +=item NewFile1 + + Does all phase 1 processing of file creation: + Ensures that the user provides a new filename, adds proper extension + if needed and that the file does not already exist, if it is a html, + problem, page, or sequence, it then creates a form link to hand the + actual creation off to the proper handler. + +Parameters: + +=over 4 + +=item $request - Apache Request Object [in] - Server request object for the + current url. + +=item $username - Name of the user that is requesting the directory creation. + +=item $domain - Name of the domain of the user + +=item $dir - current absolute diretory + +=item $newfilename + - Name of the file to be created; no path information +=back + +Side Effects: + +=over 4 + +=item 2 new forms are displayed. Clicking on the confirmation button +causes the browser to attempt to load the specfied URL, allowing the +proper handler to take care of file creation. There is also a Cancle +button which returns you to the driectory listing you came from + +=back + +=cut + + +sub NewFile1 { + my ($request, $user, $domain, $dir, $newfilename) = @_; + + &Debug($request, "Dir is : ".$dir); + &Debug($request, "Newfile is : ".$newfilename); + + my $cancelurl = "/priv/".$dir; + $cancelurl =~ s/\/home\///; + $cancelurl =~ s/\/public_html//; + + if ($ENV{'form.action'} =~ /new(.+)file/) { + my $extension=$1; + if ($newfilename !~ /\Q.$extension\E$/) { + $newfilename.=".$extension"; + } + } + + my $fullpath = $dir.'/'.$newfilename; + + &Debug($request, "Full path is : ".$fullpath); + + if(-e $fullpath) { + $request->print('File exists.
'); + } + else { + $request->print('Make new file '.$newfilename.'?
'); + my $dest=&MakeFinalUrl($request,$fullpath); + &Debug($request, "Cancel url is: ".$cancelurl); + &Debug($request, "Dest url is: ".$dest); + $request->print(''); + $request->print(''); + $request->print(''); + } +} + +=pod + =item phaseone($r, $fn, $uname, $udom) Peforms phase one processing of the request. In phase one, error messages @@ -721,8 +843,20 @@ sub phaseone { } } elsif ($ENV{'form.action'} eq 'newdir') { &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'}); + } elsif ($ENV{'form.action'} eq 'newfile' || + $ENV{'form.action'} eq 'newhtmlfile' || + $ENV{'form.action'} eq 'newproblemfile') { + if($ENV{'form.newfilename'}) { + my $newfilename = $ENV{'form.newfilename'}; + if (!defined($dir)) { + $fn=~m:(.*)/:; + $dir=$1; + } + &NewFile1($r, $uname, $udom, $dir, $fn, $newfilename); + }else { + $r->print('No new filename specified.
'); + } } - } =pod @@ -987,7 +1121,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'})) { @@ -1015,18 +1149,24 @@ sub phasetwo { # Substitute for priv for the first home in $dir to get our # construction space path. # + $dest=&MakeFinalUrl($r,$dest); + + $r->print('Unknown Action