version 1.3, 2001/06/23 20:09:06
|
version 1.29, 2003/03/10 18:34:14
|
Line 1
|
Line 1
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Handler to rename files, etc, in construction space |
# Handler to rename files, etc, in construction space |
# |
# |
|
# This file responds to the various buttons and events |
|
# in the top frame of the construction space directory. |
|
# Each event is processed in two phases. The first phase |
|
# presents a page that describes the proposed action to the user |
|
# and requests confirmation. The second phase commits the action |
|
# and displays a page showing the results of the action. |
|
# |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
# |
# (Handler to retrieve an old version of a file |
# (Handler to retrieve an old version of a file |
# |
# |
# (Publication Handler |
# (Publication Handler |
Line 13
|
Line 46
|
# 03/23 Guy Albertelli |
# 03/23 Guy Albertelli |
# 03/24,03/29 Gerd Kortemeyer) |
# 03/24,03/29 Gerd Kortemeyer) |
# |
# |
# 03/31,04/03,05/02,05/09,06/23 Gerd Kortemeyer) |
# 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer) |
# |
# |
# 06/23 Gerd Kortemeyer |
# 06/23 Gerd Kortemeyer |
|
# 05/07/02 Ron Fox: |
|
# - Added Debug log output so that I can trace what the heck this |
|
# undocumented thingy does. |
|
# 05/28/02 Ron Fox: |
|
# - Started putting in pod in standard format. |
|
=pod |
|
|
|
=head1 NAME |
|
|
|
Apache::loncfile - Construction space file management. |
|
|
|
=head1 SYNOPSIS |
|
|
|
Content handler for buttons on the top frame of the construction space |
|
directory. |
|
|
|
=head1 INTRODUCTION |
|
|
|
loncfile is invoked when buttons in the top frame of the construction |
|
space directory listing are clicked. All operations proceed in two phases. |
|
The first phase describes to the user exactly what will be done. If the user |
|
confirms the operation, the second phase commits the operation and indicates |
|
completion. When the user dismisses the output of phase2, they are returned to |
|
an "appropriate" directory listing in general. |
|
|
|
This is part of the LearningOnline Network with CAPA project |
|
described at http://www.lon-capa.org. |
|
|
|
=head2 Subroutines |
|
|
|
=cut |
|
|
package Apache::loncfile; |
package Apache::loncfile; |
|
|
use strict; |
use strict; |
use Apache::File; |
use Apache::File; |
|
use File::Basename; |
use File::Copy; |
use File::Copy; |
|
use HTML::Entities(); |
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
use Apache::loncacc; |
use Apache::loncacc; |
|
use Apache::Log (); |
|
use Apache::lonnet; |
|
|
|
my $DEBUG=0; |
|
my $r; # Needs to be global for some stuff RF. |
|
|
|
=pod |
|
|
|
=item Debug($request, $message) |
|
|
|
If debugging is enabled puts out a debugging message determined by the |
|
caller. The debug message goes to the Apache error log file. Debugging |
|
is enabled by setting the module global DEBUG variable to nonzero (TRUE). |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - The current request operation. |
|
|
|
=item $message - The message to put in the log file. |
|
|
|
=back |
|
|
|
Returns: |
|
nothing. |
|
|
|
=cut |
|
|
|
sub Debug { |
|
|
|
# Marshall the parameters. |
|
|
|
my $r = shift; |
|
my $log = $r->log; |
|
my $message = shift; |
|
|
|
# Put out the indicated message butonly if DEBUG is true. |
|
|
|
if ($DEBUG) { |
|
$log->debug($message); |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=item URLToPath($url) |
|
|
|
Convert a URL to a file system path. |
|
|
|
In order to manipulate the construction space objects, it is necessary |
|
to access url identified objects a filespace objects. This function |
|
translates a construction space URL to a file system path. |
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item Url - string [in] The url to convert. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item The corresponding file system path. |
|
|
|
=back |
|
|
|
Global References |
|
|
|
=over 4 |
|
|
|
=item $r - Request object [in] Referenced in the &Debug calls. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub URLToPath { |
|
my $Url = shift; |
|
&Debug($r, "UrlToPath got: $Url"); |
|
$Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
|
$Url=~ s/^http\:\/\/[^\/]+//; |
|
&Debug($r, "Returning $Url \n"); |
|
return $Url; |
|
} |
|
|
|
=pod |
|
|
|
=item PublicationPath($domain, $user, $dir, $file) |
|
|
|
Determines the filesystem path corresponding to a published resource |
|
specification. The returned value is the path. |
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $domain - string [in] Name of the domain within which the resource is |
|
stored. |
|
|
|
=item $user - string [in] Name of the user asking about the resource. |
|
|
|
=item $dir - Directory path relative to the top of the resource space. |
|
|
|
=item $file - name of the resource file itself without path info. |
|
|
|
=back |
|
|
|
=over 4 |
|
|
|
Returns: |
|
|
|
=item string - full path to the file if it exists in publication space. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub PublicationPath |
|
{ |
|
my ($domain, $user, $dir, $file)=@_; |
|
|
|
return '/home/httpd/html/res/'.$domain.'/'.$user.'/'.$dir.'/'. |
|
$file; |
|
} |
|
|
|
=pod |
|
|
|
=item ConstructionPath($domain, $user, $dir, $file) |
|
|
|
Determines the filesystem path corresponding to a construction space |
|
resource specification. The returned value is the path |
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $user - string [in] Name of the user asking about the resource. |
|
|
|
=item $dir - Directory path relative to the top of the resource space. |
|
|
|
=item $file - name of the resource file itself without path info. |
|
|
|
Returns: |
|
|
|
=item string - full path to the file if it exists in Construction space. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub ConstructionPath { |
|
my ($user, $dir, $file) = @_; |
|
|
|
return '/home/'.$user.'/public_html/'.$dir.'/'.$file; |
|
|
|
} |
|
=pod |
|
|
|
=item ConstructionPathFromRelative($user, $relname) |
|
|
|
Determines the path to a construction space file given |
|
the username and the path relative to the root of construction space. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $user - string [in] Name of the user in whose construction space the |
|
file [will] live. |
|
|
|
=item $relname - string[in] Path to the file relative to the root of the |
|
construction space. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item string - Full path to the file. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub ConstructionPathFromRelative { |
|
|
|
my ($user, $relname) = @_; |
|
return '/home/'.$user.'/public_html'.$relname; |
|
|
|
} |
|
|
|
=pod |
|
|
|
=item exists($user, $domain, $directory, $file) |
|
|
|
Determine if a resource file name has been published or exists |
|
in the construction space. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $user - string [in] - Name of the user for which to check. |
|
|
|
=item $domain - string [in] - Name of the domain in which the resource |
|
might have been published. |
|
|
|
=item $dir - string [in] - Path relative to construction or resource space |
|
in which the resource might live. |
|
|
|
=item $file - string [in] - Name of the file. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item string - Either where the resource exists as an html string that can |
|
be embedded in a dialog or an empty string if the resource |
|
does not exist. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub exists { |
|
my ($user, $domain, $dir, $file) = @_; |
|
|
|
# Create complete paths in publication and construction space. |
|
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.='<p><font color="red">Warning: target file exists, and has been published!</font></p>'; |
|
} |
|
elsif ( -e $construct) { |
|
$result.='<p><font color="red">Warning: target file exists!</font></p>'; |
|
} |
|
|
|
return $result; |
|
|
|
} |
|
|
|
=pod |
|
|
|
=item checksuffix($old, $new) |
|
|
|
Determine if a resource filename suffix (the stuff after the .) would change |
|
as a result of this operation. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $old = string [in] Previous filename. |
|
|
|
=item $new = string [in] Resultant filename. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item Empty string if everything worked. |
|
|
|
=item String containing an error message if there was a problem. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub checksuffix { |
|
my ($old,$new) = @_; |
|
my $result; |
|
my $oldsuffix; |
|
my $newsuffix; |
|
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } |
|
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
|
if ($oldsuffix ne $newsuffix) { |
|
$result.= |
|
'<p><font color="red">Warning: change of MIME type!</font></p>'; |
|
} |
|
return $result; |
|
} |
|
=pod |
|
|
|
=item CloseForm1($request, $user, $file) |
|
|
|
Close of a form on the successful completion of phase 1 processing |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request Object [in] - Apache server request object. |
|
|
|
=item $cancelurl - the url to go to on cancel. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub CloseForm1 { |
|
my ($request, $cancelurl) = @_; |
|
|
|
|
|
&Debug($request, "Cancel url is: ".$cancelurl); |
|
$request->print('<p><input type="submit" value="Continue" /></p></form>'); |
|
$request->print('<form action="'.$cancelurl. |
|
'" method="GET"><p><input type="submit" value="Cancel" /></p></form>'); |
|
|
|
} |
|
|
|
|
|
=pod |
|
|
|
=item CloseForm2($request, $user, $directory) |
|
|
|
Successfully close off the phase 2 form. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request object [in] - The request that is being |
|
executed. |
|
|
|
=item $user - string [in] - Name of the user that is initiating the |
|
request. |
|
|
|
=item $directory - string [in] - Directory in which the operation is |
|
being done relative to the top level construction space |
|
directory. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub CloseForm2 { |
|
my ($request, $user, $directory) = @_; |
|
|
|
$request->print('<h3><a href="/priv/'.$user.$directory.'/">Done </a> </h3>'); |
|
} |
|
|
|
=pod |
|
|
|
=item Rename1($request, $filename, $user, $domain, $dir) |
|
|
|
Perform phase 1 processing of the file rename operation. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request Object [in] The request object for the |
|
current request. |
|
|
|
=item $filename - The filename relative to construction space. |
|
|
|
=item $user - Name of the user making the request. |
|
|
|
=item $domain - User login domain. |
|
|
|
=item $dir - Directory specification of the path to the file. |
|
|
|
=back |
|
|
|
Side effects: |
|
|
|
=over 4 |
|
|
|
=item A new form is displayed prompting for confirmation. The newfilename |
|
hidden field of this form is loaded with |
|
new filename relative to the current directory ($dir). |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub Rename1 { |
|
my ($request, $filename, $user, $domain, $dir) = @_; |
|
&Debug($request, "Username - ".$user." filename: ".$filename."\n"); |
|
my $conspace = $filename; |
|
|
|
my $cancelurl = "/priv/".$filename; |
|
$cancelurl =~ s/\/home\///; |
|
$cancelurl =~ s/\/public_html//; |
|
|
|
if(-e $conspace) { |
|
if($ENV{'form.newfilename'}) { |
|
my $newfilename = $ENV{'form.newfilename'}; |
|
if ($newfilename =~ m|/[^\.]+$|) { |
|
#no extension add on orignal extension |
|
if ($filename =~ m|/[^\.]*\.([^\.]+)$|) { |
|
$newfilename.='.'.$1; |
|
} |
|
} |
|
$request->print(&checksuffix($filename, $newfilename)); |
|
#renaming a dir, delete the trailing / |
|
#remove last element for current dir |
|
if ($filename =~ m|/$|) { |
|
$filename =~ s|/$||; |
|
$dir =~ s|/[^/]*$||; |
|
} |
|
my $return=&exists($user, $domain, $dir, $newfilename); |
|
$request->print($return); |
|
if ($return =~/^Error:/) { |
|
$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>'); |
|
return; |
|
} |
|
my $dest=&SimplifyDir($dir,$newfilename); |
|
$request->print('<input type="hidden" name="newfilename" value="'. |
|
$newfilename. |
|
'" /><p>Rename <tt>'.$filename. |
|
'</tt><br /> to <tt>'. |
|
$dest.'</tt>?</p>'); |
|
&CloseForm1($request, $cancelurl); |
|
} else { |
|
$request->print('<p>No new filename specified</p></form>'); |
|
return; |
|
} |
|
} else { |
|
$request->print('<p> No such File </p> </form>'); |
|
return; |
|
} |
|
|
|
} |
|
=pod |
|
|
|
=item Delete1 |
|
|
|
Performs phase 1 processing of the delete operation. In phase one |
|
we just check to be sure the file exists. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request Object [in] request object for the current |
|
request. |
|
|
|
=item $user - string [in] Name of session user. |
|
|
|
|
|
=item $filename - string [in] Name fo the file to be deleted: |
|
Filename is the full filesystem path to the file. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub Delete1 { |
|
my ($request, $user, $filename) = @_; |
|
|
|
my $cancelurl = '/priv/'.$filename; |
|
$cancelurl =~ s/\/home\///; |
|
$cancelurl =~ s/\/public_html//; |
|
|
|
|
|
if( -e $filename) { |
|
$request->print('<input type="hidden" name="newfilename" value="'. |
|
$filename.'"/>'); |
|
$request->print('<p> Delete <tt>'.$filename.'</tt>?</p>'); |
|
&CloseForm1($request, $cancelurl); |
|
} else { |
|
$request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>'); |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=item Copy1($request, $user, $domain, $filename, $newfilename) |
|
|
|
Performs phase 1 processing of the construction space copy command. |
|
Ensure that the source file exists. Ensure that a destination exists, |
|
also warn if the destination already exists. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request Object [in] request object for the current |
|
request. |
|
|
|
=item $user - string [in] Name of the user initiating the request. |
|
|
|
=item $domain - string [in] Domain the initiating user is logged in as |
|
|
|
=item $dir - string [in] Directory path. |
|
|
|
=item $filename - string [in] Source filename. |
|
|
|
=item $newfilename-string [in] Destination filename. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub Copy1 { |
|
my ($request, $user, $domain, $dir, $filename, $newfilename) = @_; |
|
|
|
my $cancelurl = "/priv/".$filename; |
|
$cancelurl =~ s/\/home\///; |
|
$cancelurl =~ s/\/public_html//; |
|
|
|
|
|
if(-e $filename) { |
|
$request->print(&checksuffix($filename,$newfilename)); |
|
my $return=&exists($user, $domain, $dir, $newfilename); |
|
$request->print($return); |
|
if ($return =~/^Error:/) { |
|
$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>'); |
|
return; |
|
} |
|
my $dest=&SimplifyDir($dir,$newfilename); |
|
$request->print('<input type = "hidden" name = "newfilename" value = "'. |
|
$dir.'/'.$newfilename. |
|
'" /><p>Copy <tt>'.$filename.'</tt><br /> to '. |
|
'<tt>'.$dest.'</tt>?</p>'); |
|
&CloseForm1($request, $cancelurl); |
|
} else { |
|
$request->print('<p>No such file <tt>'.$filename.'</p></form>'); |
|
} |
|
} |
|
|
|
=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: |
|
Ensures that the user provides a new directory name, |
|
and that the directory does not already exist. |
|
|
|
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 $path - current directory relative to construction space. |
|
|
|
=item $newdir - Name of the directory to be created; path relative to the |
|
top level of construction space. |
|
=back |
|
|
|
Side Effects: |
|
|
|
=over 4 |
|
|
|
=item A new form is displayed. Clicking on the confirmation button |
|
causes the newdir operation to transition into phase 2. The hidden field |
|
"newfilename" is set with the construction space path to the new directory. |
|
|
|
|
|
=back |
|
|
|
=cut |
|
|
|
|
|
sub NewDir1 |
|
{ |
|
my ($request, $username, $path, $newdir) = @_; |
|
|
|
my $fullpath = '/home/'.$username.'/public_html/'. |
|
$path.'/'.$newdir; |
|
|
|
my $cancelurl = '/priv/'.$username.'/'.$path; |
|
|
|
&Debug($request, "Full path is : ".$fullpath); |
|
|
|
if(-e $fullpath) { |
|
$request->print('<p>Directory exists.</p></form>'); |
|
} |
|
else { |
|
$request->print('<input type="hidden" name="newfilename" value="'. |
|
$newdir.'" /><p>Make new directory <tt>'. |
|
$path."/".$newdir.'</tt>?</p>'); |
|
&CloseForm1($request, $cancelurl); |
|
|
|
} |
|
} |
|
|
|
=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$/) { |
|
if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) { |
|
#already has an extension strip it and add in expected one |
|
$newfilename =~ s|.([^\.]+)$||; |
|
} |
|
$newfilename.=".$extension"; |
|
} |
|
} |
|
|
|
my $fullpath = $dir.'/'.$newfilename; |
|
|
|
&Debug($request, "Full path is : ".$fullpath); |
|
|
|
if(-e $fullpath) { |
|
$request->print('<p>File exists.</p></form>'); |
|
} |
|
else { |
|
$request->print('<p>Make new file <tt>'.$dir.'/'.$newfilename.'</tt>?</p>'); |
|
my $dest=&MakeFinalUrl($request,$fullpath); |
|
&Debug($request, "Cancel url is: ".$cancelurl); |
|
&Debug($request, "Dest url is: ".$dest); |
|
$request->print('</form>'); |
|
$request->print('<form action="'.$dest. |
|
'" method="GET"><p><input type="submit" value="Continue" /></p></form>'); |
|
$request->print('<form action="'.$cancelurl. |
|
'" method="GET"><p><input type="submit" value="Cancel" /></p></form>'); |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=item phaseone($r, $fn, $uname, $udom) |
|
|
|
Peforms phase one processing of the request. In phase one, error messages |
|
are returned if the request cannot be performed (e.g. attempts to manipulate |
|
files that are nonexistent). If the operation can be performed, what is |
|
about to be done will be presented to the user for confirmation. If the |
|
user confirms the request, then phase two is executed, the action |
|
performed and reported to the user. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $r - request object [in] - The Apache request being executed. |
|
|
|
=item $fn = string [in] - The filename being manipulated by the |
|
request. |
|
|
|
=item $uname - string [in] Name of user logged in and doing this action. |
|
|
|
=item $udom - string [in] Domain name under which the user logged in. |
|
|
|
=back |
|
|
|
=cut |
|
|
sub phaseone { |
sub phaseone { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
|
|
|
$fn=~m:(.*)/([^/]+)\.(\w+)$:; |
|
my $dir=$1; |
|
my $main=$2; |
|
my $suffix=$3; |
|
|
|
# my $conspace=ConstructionPathFromRelative($uname, $fn); |
|
|
|
|
|
$r->print('<form action="/adm/cfile" method="post">'. |
|
'<input type="hidden" name="filename" value="/~'.$uname.$fn.'" />'. |
|
'<input type="hidden" name="phase" value="two" />'. |
|
'<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />'); |
|
|
|
if ($ENV{'form.action'} eq 'rename') { |
|
if (!defined($dir)) { |
|
$fn=~m:(.*)/:; |
|
$dir=$1; |
|
} |
|
&Rename1($r, $fn, $uname, $udom, $dir); |
|
} elsif ($ENV{'form.action'} eq 'delete') { |
|
|
|
&Delete1($r, $uname, $fn); |
|
|
|
} elsif ($ENV{'form.action'} eq 'copy') { |
|
if($ENV{'form.newfilename'}) { |
|
my $newfilename = $ENV{'form.newfilename'}; |
|
&Copy1($r, $uname, $udom, $dir, $fn, $newfilename); |
|
}else { |
|
$r->print('<p>No new filename specified.</p></form>'); |
|
} |
|
} 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' || |
|
$ENV{'form.action'} eq 'newpagefile' || |
|
$ENV{'form.action'} eq 'newsequencefile') { |
|
if($ENV{'form.newfilename'}) { |
|
my $newfilename = $ENV{'form.newfilename'}; |
|
if (!defined($dir)) { |
|
$fn=~m:(.*)/:; |
|
$dir=$1; |
|
} |
|
&NewFile1($r, $uname, $udom, $dir, $newfilename); |
|
} else { |
|
$r->print('<p>No new filename specified.</p></form>'); |
|
} |
|
} |
|
} |
|
|
$fn=~/(.*)\/([^\/]+)\.(\w+)$/; |
=pod |
my $dir=$1; |
|
my $main=$2; |
=item Rename2($request, $user, $directory, $oldfile, $newfile) |
my $suffix=$3; |
|
|
Performs phase 2 processing of a rename reequest. This is where the |
my $conspace='/home/'.$uname.'/public_html'.$fn; |
actual rename is performed. |
|
|
$r->print('<form action=/adm/cfile method=post>'. |
Parameters |
'<input type=hidden name=filename value="/~'.$uname.$fn.'">'. |
|
'<input type=hidden name=phase value=two>'. |
=over 4 |
'<input type=hidden name=action value='.$ENV{'form.action'}.'>'); |
|
if ($ENV{'form.action'} eq 'rename') { |
=item $request - Apache request object [in] The request being processed. |
if (-e $conspace) { |
|
if ($ENV{'form.newfilename'}) { |
=item $user - string [in] The name of the user initiating the request. |
$ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/; |
|
if ($3 ne $suffix) { |
=item $directory - string [in] The name of the directory relative to the |
$r->print( |
construction space top level of the renamed file. |
'<p><font color=red>Warning: change of MIME type!</font>'); |
|
} |
=item $oldfile - Name of the file. |
if (-e |
|
'/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) { |
=item $newfile - Name of the new file. |
$r->print( |
|
'<p><font color=red>Warning: target file exists!</font>'); |
=back |
} |
|
$r->print('<p>Rename <tt>'.$fn.'</tt> to <tt>'. |
Returns: |
$dir.'/'.$ENV{'form.newfilename'}.'</tt>?'); |
|
} else { |
=over 4 |
$r->print('<p>No new filename specified.</form>'); |
|
return; |
=item 1 Success. |
} |
|
} else { |
=item 0 Failure. |
$r->print('<p>No such file.</form>'); |
|
return; |
=cut |
} |
|
} elsif ($ENV{'form.action'} eq 'delete') { |
sub Rename2 { |
if (-e $conspace) { |
|
$r->print('<p>Delete <tt>'.$fn.'</tt>?'); |
my ($request, $user, $directory, $oldfile, $newfile) = @_; |
} else { |
|
$r->print('<p>No such file.</form>'); |
&Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
return; |
" new file ".$newfile."\n"); |
} |
&Debug($request, "Target is: ".$directory.'/'. |
} elsif ($ENV{'form.action'} eq 'copy') { |
$newfile); |
if (-e $conspace) { |
|
if ($ENV{'form.newfilename'}) { |
if(-e $oldfile) { |
$ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/; |
my $dest; |
if ($3 ne $suffix) { |
|
$r->print( |
if ($oldfile =~ m|/$|) { |
'<p><font color=red>Warning: change of MIME type!</font>'); |
#renaming a dir |
} |
$oldfile =~ s|/$||; |
if (-e |
$dest=$directory; |
'/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) { |
$dest=~s|(/)([^/]*)$|$1|; |
$r->print( |
$dest.='/'.$newfile; |
'<p><font color=red>Warning: target file exists!</font>'); |
} else { |
} |
$dest=$directory.'/'.$newfile; |
$r->print('<p>Copy <tt>'.$fn.'</tt> to <tt>'. |
} |
$dir.'/'.$ENV{'form.newfilename'}.'</tt>?'); |
|
} else { |
unless(rename($oldfile,$dest)) { |
$r->print('<p>No new filename specified.</form>'); |
$request->print('<font color="red">Error: '.$!.'</font>'); |
return; |
return 0; |
} |
} else {} |
} else { |
} else { |
$r->print('<p>No such file.</form>'); |
$request->print("<p> No such file: /home".$user.'/public_html'. |
return; |
$oldfile.' </p></form>'); |
} |
return 0; |
} elsif ($ENV{'form.action'} eq 'newdir') { |
} |
if (-e $conspace) { |
return 1; |
$r->print('<p>Directory exists.</form>'); |
} |
return; |
=pod |
} |
|
|
=item Delete2($request, $user, $filename) |
|
|
|
Performs phase two of a delete. The user has confirmed that they want |
|
to delete the selected file. The file is deleted and the results of the |
|
delete attempt are indicated. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $request - Apache Request object [in] the request object for the current |
|
delete operation. |
|
|
|
=item $user - string [in] The name of the user initiating the delete |
|
request. |
|
|
|
=item $filename - string [in] The name of the file, relative to construction |
|
space, to delete. |
|
|
|
=back |
|
|
|
Returns: |
|
1 - success. |
|
0 - Failure. |
|
|
|
=cut |
|
|
|
sub Delete2 { |
|
my ($request, $user, $filename) = @_; |
|
|
|
if(-e $filename) { |
|
unless(unlink($filename)) { |
|
$request->print('<font color="red">Error: '.$!.'</font>'); |
|
return 0; |
} |
} |
$r->print('<p><input type=submit value=Continue></form>'); |
} else { |
|
$request->print('<p> No such file. </p></form'); |
|
return 0; |
|
} |
|
return 1; |
} |
} |
|
|
|
=pod |
|
|
|
=item Copy2($request, $username, $dir, $oldfile, $newfile) |
|
|
|
Performs phase 2 of a copy. The file is copied and the status |
|
of that copy is reported back to the user. |
|
|
|
=over 4 |
|
|
|
=item $request - Apache request object [in]; the apache request currently |
|
being executed. |
|
|
|
=item $username - string [in] Name of the user who is requesting the copy. |
|
|
|
=item $dir - string [in] Directory path relative to the construction space |
|
of the destination file. |
|
|
|
=item $oldfile - string [in] Name of the source file. |
|
|
|
=item $newfile - string [in] Name of the destination file. |
|
|
|
|
|
=back |
|
|
|
Returns 0 failure, and 0 successs. |
|
|
|
=cut |
|
|
|
sub Copy2 { |
|
my ($request, $username, $dir, $oldfile, $newfile) = @_; |
|
&Debug($request ,"Will try to copy $oldfile to $newfile"); |
|
if(-e $oldfile) { |
|
unless (copy($oldfile, $newfile)) { |
|
$request->print('<font color="red"> copy Error: '.$!.'</font>'); |
|
return 0; |
|
} else { |
|
unless (chmod(0660, $newfile)) { |
|
$request->print('<font color="red"> chmod error: '.$!.'</font>'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
|
} else { |
|
$request->print('<p> No such file </p>'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
|
=pod |
|
|
|
=item NewDir2($request, $user, $newdirectory) |
|
|
|
Performs phase 2 processing of directory creation. This involves creating the directory and |
|
reporting the results of that creation to the user. |
|
|
|
Parameters: |
|
=over 4 |
|
|
|
=item $request - Apache request object [in]. Object representing the current HTTP request. |
|
|
|
=item $user - string [in] The name of the user that is initiating the request. |
|
|
|
=item $newdirectory - string [in] The full path of the directory being created. |
|
|
|
=back |
|
|
|
Returns 0 - failure 1 - success. |
|
|
|
=cut |
|
|
|
sub NewDir2 { |
|
my ($request, $user, $newdirectory) = @_; |
|
|
|
unless(mkdir($newdirectory, 02770)) { |
|
$request->print('<font color="red">Error: '.$!.'</font>'); |
|
return 0; |
|
} |
|
unless(chmod(02770, ($newdirectory))) { |
|
$request->print('<font color="red"> Error: '.$!.'</font>'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
|
|
|
=pod |
|
|
|
=item phasetwo($r, $fn, $uname, $udom) |
|
|
|
Controls the phase 2 processing of file management |
|
requests for construction space. In phase one, the user |
|
was asked to confirm the operation. In phase 2, the operation |
|
is performed and the result is shown. |
|
|
|
The strategy is to break out the processing into specific action processors |
|
named action2 where action is the requested action and the 2 denotes |
|
phase 2 processing. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item $r - Apache Request object [in] The request object for this httpd |
|
transaction. |
|
|
|
=item $fn - string [in] A filename indicating the object that is being |
|
manipulated. |
|
|
|
=item $uname - string [in] The name of the user initiating the file management |
|
request. |
|
|
|
=item $udom - string [in] The login domain of the user initiating the |
|
file management request. |
|
=back |
|
|
|
=cut |
|
|
sub phasetwo { |
sub phasetwo { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
if ($ENV{'form.action'} eq 'rename') { |
|
|
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
|
|
|
# Break down the file into it's component pieces. |
|
|
|
my $dir; # Directory path |
|
my $main; # Filename. |
|
my $suffix; # Extension. |
|
|
|
if ($fn=~m:(.*)/([^/]+)\.(\w+)$:) { |
|
$dir=$1; # Directory path |
|
$main=$2; # Filename. |
|
$suffix=$3; # Extension. |
|
} |
|
|
|
my $dest; # On success this is where we'll go. |
|
|
|
&Debug($r, |
|
"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
|
&Debug($r, |
|
" newfilename = ".$ENV{'form.newfilename'}); |
|
|
|
my $conspace=$fn; |
|
|
|
&Debug($r, |
|
"loncfile::phase2 Full construction space name: $conspace"); |
|
|
|
&Debug($r, |
|
"loncfie::phase2 action is $ENV{'form.action'}"); |
|
|
|
# Select the appropriate processing sub. |
|
|
|
if ($ENV{'form.action'} eq 'rename') { # Rename. |
|
if($ENV{'form.newfilename'}) { |
|
if (!defined($dir)) { |
|
$fn=~m:^(.*)/:; |
|
$dir=$1; |
|
} |
|
if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
|
return; |
|
} |
|
# Prepend the directory to the new name to form the basis of the |
|
# url of the new resource. |
|
# |
|
#renaming a dir |
|
#remove last element for current dir |
|
if ($fn =~ m|/$|) { $dir =~ s|/[^/]*$||; } |
|
$dest = $dir."/".$ENV{'form.newfilename'}; |
|
} |
} elsif ($ENV{'form.action'} eq 'delete') { |
} elsif ($ENV{'form.action'} eq 'delete') { |
|
if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) { |
|
return ; |
|
} |
|
# Once a resource is deleted, we just list the directory that |
|
# previously held it. |
|
# |
|
$dest = $dir."/."; # Parent dir. |
} elsif ($ENV{'form.action'} eq 'copy') { |
} elsif ($ENV{'form.action'} eq 'copy') { |
|
if($ENV{'form.newfilename'}) { |
|
if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
|
return |
|
} |
|
$dest = $ENV{'form.newfilename'}; |
|
|
|
} else { |
|
$r->print('<p>No New filename specified</p></form>'); |
|
return; |
|
} |
|
|
} elsif ($ENV{'form.action'} eq 'newdir') { |
} elsif ($ENV{'form.action'} eq 'newdir') { |
} |
# |
|
# Since the newfilename form field is construction space |
|
# relative, ew need to prepend the current path; now in $fn. |
|
# |
|
my $newdir= $fn.$ENV{'form.newfilename'}; |
|
if(!&NewDir2($r, $uname, $newdir)) { |
|
return; |
|
} |
|
$dest = $newdir."/" |
|
} |
|
# |
|
# Substitute for priv for the first home in $dir to get our |
|
# construction space path. |
|
# |
|
$dest=&MakeFinalUrl($r,$dest); |
|
|
|
$r->print('<h3><a href="'.$dest.'">Done</a></h3>'); |
|
} |
|
|
|
sub MakeFinalUrl { |
|
my($r,$dest)=@_; |
|
&Debug($r, "Final url is: $dest"); |
|
$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"); |
|
return $dest; |
} |
} |
|
|
sub handler { |
sub handler { |
|
|
my $r=shift; |
$r=shift; |
|
|
|
|
|
&Debug($r, "loncfile.pm - handler entered"); |
|
&Debug($r, " filename: ".$ENV{'form.filename'}); |
|
&Debug($r, " newfilename: ".$ENV{'form.newfilename'}); |
|
|
my $fn; |
my $fn; |
|
|
if ($ENV{'form.filename'}) { |
if ($ENV{'form.filename'}) { |
$fn=$ENV{'form.filename'}; |
$fn=&Apache::lonnet::unescape($ENV{'form.filename'}); |
$fn=~s/^http\:\/\/[^\/]+//; |
&Debug($r, "loncfile::handler - raw url: $fn"); |
|
# $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
|
# $fn=~s/^http\:\/\/[^\/]+//; |
|
$fn=URLToPath($fn); |
|
&Debug($r, "loncfile::handler - doctored url: $fn"); |
|
|
} else { |
} else { |
|
&Debug($r, "loncfile::handler - no form.filename"); |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
' unspecified filename for cfile', $r->filename); |
' unspecified filename for cfile', $r->filename); |
return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
} |
} |
|
|
unless ($fn) { |
unless ($fn) { |
|
&Debug($r, "loncfile::handler - doctored url is empty"); |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
' trying to cfile non-existing file', $r->filename); |
' trying to cfile non-existing file', $r->filename); |
return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
Line 138 sub handler {
|
Line 1251 sub handler {
|
|
|
($uname,$udom)= |
($uname,$udom)= |
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
|
&Debug($r, |
|
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
unless (($uname) && ($udom)) { |
unless (($uname) && ($udom)) { |
$r->log_reason($uname.' at '.$udom. |
$r->log_reason($uname.' at '.$udom. |
' trying to publish file '.$ENV{'form.filename'}. |
' trying to manipulate file '.$ENV{'form.filename'}. |
' ('.$fn.') - not authorized', |
' ('.$fn.') - not authorized', |
$r->filename); |
$r->filename); |
return HTTP_NOT_ACCEPTABLE; |
return HTTP_NOT_ACCEPTABLE; |
} |
} |
|
|
$fn=~s/\/\~(\w+)//; |
$fn=~s/\/\~(\w+)//; |
|
&Debug($r, "loncfile::handler ~ removed filename: $fn"); |
|
|
$r->content_type('text/html'); |
$r->content_type('text/html'); |
$r->send_http_header; |
$r->send_http_header; |
Line 154 sub handler {
|
Line 1270 sub handler {
|
$r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
$r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
|
|
$r->print( |
$r->print( |
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
'<body bgcolor="#FFFFFF"><img align="right" src="/adm/lonIcons/lonlogos.gif" />'); |
|
|
|
|
$r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); |
$r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); |
|
|
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
$r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. |
$r->print('<h3><font color="red">Co-Author: '.$uname.' at '.$udom. |
'</font></h3>'); |
'</font></h3>'); |
} |
} |
|
|
|
|
|
&Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); |
if ($ENV{'form.action'} eq 'delete') { |
if ($ENV{'form.action'} eq 'delete') { |
|
|
$r->print('<h3>Delete</h3>'); |
$r->print('<h3>Delete</h3>'); |
} elsif ($ENV{'form.action'} eq 'rename') { |
} elsif ($ENV{'form.action'} eq 'rename') { |
$r->print('<h3>Rename</h3>'); |
$r->print('<h3>Rename</h3>'); |
Line 172 sub handler {
|
Line 1291 sub handler {
|
$r->print('<h3>New Directory</h3>'); |
$r->print('<h3>New Directory</h3>'); |
} elsif ($ENV{'form.action'} eq 'copy') { |
} elsif ($ENV{'form.action'} eq 'copy') { |
$r->print('<h3>Copy</h3>'); |
$r->print('<h3>Copy</h3>'); |
|
} elsif ($ENV{'form.action'} eq 'newfile' || |
|
$ENV{'form.action'} eq 'newhtmlfile' || |
|
$ENV{'form.action'} eq 'newproblemfile' || |
|
$ENV{'form.action'} eq 'newpagefile' || |
|
$ENV{'form.action'} eq 'newsequencefile' ) { |
|
$r->print('<h3>New Resource</h3>'); |
} else { |
} else { |
$r->print('<p>Unknown Action</body></html>'); |
$r->print('<p>Unknown Action</p></body></html>'); |
return OK; |
return OK; |
} |
} |
if ($ENV{'form.phase'} eq 'two') { |
if ($ENV{'form.phase'} eq 'two') { |
# &phasetwo($r,$fn,$uname,$udom); |
&Debug($r, "loncfile::handler entering phase2"); |
|
&phasetwo($r,$fn,$uname,$udom); |
} else { |
} else { |
|
&Debug($r, "loncfile::handler entering phase1"); |
&phaseone($r,$fn,$uname,$udom); |
&phaseone($r,$fn,$uname,$udom); |
} |
} |
|
|
Line 188 sub handler {
|
Line 1315 sub handler {
|
|
|
1; |
1; |
__END__ |
__END__ |
|
|