--- 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.'?

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

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('
Cancel'); + return; + } + my $dest=&SimplifyDir($dir,$newfilename); $request->print('

Copy '.$filename.' to'. - ''.$dir.'/'.$newfilename.'/?

'); + '">

Copy '.$filename.'
to '. + ''.$dest.'?

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

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('

Done

'); +} + +sub MakeFinalUrl { + my($r,$dest)=@_; &Debug($r, "Final url is: $dest"); - $dest =~ s/\/home\//\/priv\//; - $dest =~ s/\/public_html//; - - my $base = &Apache::lonnet::escape(&File::Basename::basename($dest)); - my $dpath= &File::Basename::dirname($dest); - $dest = $dpath.'/'.$base; + $dest =~ s|/home/|/priv/|; + $dest =~ s|/public_html||; + my $base = &File::Basename::basename($dest); + my $dpath= &File::Basename::dirname($dest); + if ($base eq '.') { $base=''; } + $dest = &HTML::Entities::encode($dpath.'/'.$base); &Debug($r, "Final url after rewrite: $dest"); - - $r->print('

Done

'); + return $dest; } sub handler { @@ -1041,7 +1181,7 @@ sub handler { my $fn; if ($ENV{'form.filename'}) { - $fn=$ENV{'form.filename'}; + $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); &Debug($r, "loncfile::handler - raw url: $fn"); # $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; # $fn=~s/^http\:\/\/[^\/]+//; @@ -1108,6 +1248,10 @@ sub handler { $r->print('

New Directory

'); } elsif ($ENV{'form.action'} eq 'copy') { $r->print('

Copy

'); + } elsif ($ENV{'form.action'} eq 'newfile' || + $ENV{'form.action'} eq 'newhtmlfile' || + $ENV{'form.action'} eq 'newproblemfile') { + $r->print('

New Resource

'); } else { $r->print('

Unknown Action'); return OK;