version 1.2, 2001/06/23 18:51:32
|
version 1.113, 2011/11/02 19:12:40
|
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 |
# |
# |
# (Handler to retrieve an old version of a file |
# 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. |
# |
# |
# (Publication Handler |
|
# |
|
# (TeX Content Handler |
|
# |
# |
# 05/29/00,05/30,10/11 Gerd Kortemeyer) |
# $Id$ |
# |
# |
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer |
# Copyright Michigan State University Board of Trustees |
# 03/23 Guy Albertelli |
|
# 03/24,03/29 Gerd Kortemeyer) |
|
# |
# |
# 03/31,04/03,05/02,05/09,06/23 Gerd Kortemeyer) |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# |
# |
# 06/23 Gerd Kortemeyer |
# 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/ |
|
# |
|
=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::lonnet; |
|
use Apache::loncommon(); |
|
use Apache::lonlocal; |
|
use LONCAPA qw(:DEFAULT :match); |
|
|
|
|
|
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 { |
|
# Put out the indicated message butonly if DEBUG is true. |
|
if ($DEBUG) { |
|
my ($r,$message) = @_; |
|
$r->log_reason($message); |
|
} |
|
} |
|
|
|
sub done { |
|
my ($url)=@_; |
|
my $done=&mt("Done"); |
|
return(<<ENDDONE); |
|
<a href="$url">$done</a> |
|
<script type="text/javascript"> |
|
location.href="$url"; |
|
</script> |
|
ENDDONE |
|
} |
|
|
|
=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{^https?\://[^/]+}{}; |
|
$Url=~ s{//+}{/}g; |
|
$Url=~ s{^/}{}; |
|
$Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$Url"; |
|
&Debug($r, "Returning $Url \n"); |
|
return $Url; |
|
} |
|
|
|
sub url { |
|
my $fn=shift; |
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
$fn=~ s/^\Q$londocroot\E//; |
|
$fn=~s{/\./}{/}g; |
|
$fn=&HTML::Entities::encode($fn,'<>"&'); |
|
return $fn; |
|
} |
|
|
|
sub display { |
|
my $fn=shift; |
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
$fn=~s/^\Q$londocroot\E//; |
|
$fn=~s{/\./}{/}g; |
|
return '<span class="LC_filename">'.$fn.'</span>'; |
|
} |
|
|
|
|
|
# see if the file is |
|
# a) published (return 0 if not) |
|
# b) if, so obsolete (return 0 if not) |
|
|
|
sub obsolete_unpub { |
|
my ($user,$domain,$construct)=@_; |
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
my $published=$construct; |
|
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
|
if (-e $published) { |
|
if (&Apache::lonnet::metadata($published,'obsolete')) { |
|
return 1; |
|
} |
|
return 0; |
|
} else { |
|
return 1; |
|
} |
|
} |
|
|
|
# see if directory is empty |
|
# ignores any .meta, .save, .bak, and .log files created for a previously |
|
# published file, which has since been marked obsolete and deleted. |
|
sub empty_directory { |
|
my ($dirname,$phase) = @_; |
|
if (opendir DIR, $dirname) { |
|
my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and .. |
|
if (@files) { |
|
my @orphans = grep(/\.(meta|save|log|bak)$/,@files); |
|
if (scalar(@files) - scalar(@orphans) > 0) { |
|
return 0; |
|
} else { |
|
if (($phase eq 'Delete2') && (@orphans > 0)) { |
|
foreach my $file (@orphans) { |
|
if ($file =~ /\.(meta|save|log|bak)$/) { |
|
unlink($dirname.$file); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
closedir(DIR); |
|
return 1; |
|
} |
|
return 0; |
|
} |
|
|
|
=pod |
|
|
|
=item exists($user, $domain, $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 $file - string [in] - Name of the file. |
|
|
|
=item $creating - string [in] - optional, type of object being created, |
|
either 'directory' or 'file'. Defaults to |
|
'file' if unspecified. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item string - Either undef, 'warning' or 'error' depending on the |
|
type of problem |
|
|
|
=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, $construct, $creating) = @_; |
|
$creating ||= 'file'; |
|
|
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
my $published=$construct; |
|
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
|
my ($type,$result); |
|
if ( -d $construct ) { |
|
return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>'); |
|
|
|
} |
|
|
|
if ( -e $published) { |
|
if ( -e $construct ) { |
|
$type = 'warning'; |
|
$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>'; |
|
} else { |
|
my $published_type = (-d $published) ? 'directory' : 'file'; |
|
|
|
if ($published_type eq $creating) { |
|
$type = 'warning'; |
|
$result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>'; |
|
} else { |
|
$type = 'error'; |
|
$result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>'; |
|
} |
|
} |
|
} elsif ( -e $construct) { |
|
$type = 'warning'; |
|
$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>'; |
|
} |
|
|
|
return ($type,$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 (lc($oldsuffix) ne lc($newsuffix)) { |
|
$result.= |
|
'<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>'; |
|
} |
|
return $result; |
|
} |
|
|
|
sub cleanDest { |
|
my ($request,$dest,$subdir,$fn,$uname,$udom)=@_; |
|
#remove bad characters |
|
my $foundbad=0; |
|
my $error=''; |
|
if ($subdir && $dest =~/\./) { |
|
$foundbad=1; |
|
$dest=~s/\.//g; |
|
} |
|
$dest =~ s/(\s+$|^\s+)//g; |
|
if ($dest=~/[\#\?&%\":]/) { |
|
$foundbad=1; |
|
$dest=~s/[\#\?&%\":]//g; |
|
} |
|
if ($dest=~m|/|) { |
|
my ($newpath)=($dest=~m|(.*)/|); |
|
($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); |
|
if (! -d "$newpath") { |
|
$request->print('<p><span class="LC_warning">' |
|
.&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name." |
|
,&display($newpath)) |
|
.'</span></p>'); |
|
$dest=~s|.*/||; |
|
} |
|
} |
|
if ($dest =~ /\.(\d+)\.(\w+)$/){ |
|
$request->print('<p><span class="LC_warning">' |
|
.&mt('Bad filename [_1]',&display($dest)) |
|
.'<br />' |
|
.&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>') |
|
.'<br />' |
|
.&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>') |
|
.'</span></p>'); |
|
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
|
} |
|
if ($foundbad) { |
|
$request->print('<p><span class="LC_warning">' |
|
.&mt('Invalid characters in requested name have been removed.') |
|
.'</span></p>' |
|
); |
|
} |
|
return ($dest,$error); |
|
} |
|
|
|
sub relativeDest { |
|
my ($fn,$newfilename,$uname,$udom)=@_; |
|
my $error = ''; |
|
if ($newfilename=~/^\//) { |
|
# absolute, simply add path |
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
$newfilename="$londocroot/res/$udom/$uname/"; |
|
} else { |
|
my $dir=$fn; |
|
$dir=~s{/[^/]+$}{}; |
|
$newfilename=$dir.'/'.$newfilename; |
|
} |
|
$newfilename=~s{//+}{/}g; # remove duplicate / |
|
while ($newfilename=~m{/\.\./}) { |
|
$newfilename=~ s{/[^/]+/\.\./}{/}g; #remove dir/.. |
|
} |
|
my ($authorname,$authordom)=&Apache::loncacc::constructaccess($newfilename); |
|
unless (($authorname) && ($authordom)) { |
|
my $otherdir = &display($newfilename); |
|
$error = &mt('Access denied to [_1]',$otherdir); |
|
} |
|
return ($newfilename,$error); |
|
} |
|
|
|
=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, $fn) = @_; |
|
$request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>'); |
|
$request->print('<form action="'.&url($fn). |
|
'" method="post"><p><input type="submit" value="'.&mt('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, $fn) = @_; |
|
$request->print(&done(&url($fn))); |
|
} |
|
|
|
=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, $user, $domain, $fn, $newfilename, $style) = @_; |
|
|
|
if(-e $fn) { |
|
if($newfilename) { |
|
# is dest a dir |
|
if ($style eq 'move') { |
|
if (-d $newfilename) { |
|
if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } |
|
} |
|
} |
|
if ($newfilename =~ m|/[^\.]+$|) { |
|
#no extension add on original extension |
|
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { |
|
$newfilename.='.'.$1; |
|
} |
|
} |
|
$request->print(&checksuffix($fn, $newfilename)); |
|
#renaming a dir, delete the trailing / |
|
#remove second to last element for current dir |
|
if (-d $fn) { |
|
$newfilename=~/\.(\w+)$/; |
|
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
|
$request->print('<p><span class="LC_error">'. |
|
&mt('Cannot change MIME type of a directory.'). |
|
'</span>'. |
|
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'); |
|
return; |
|
} |
|
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
|
} |
|
$newfilename=~s://+:/:g; # remove duplicate / |
|
while ($newfilename=~m:/\.\./:) { |
|
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
|
} |
|
my ($type, $return)=&exists($user, $domain, $newfilename); |
|
$request->print($return); |
|
if ($type eq 'error') { |
|
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
|
return; |
|
} |
|
unless (&obsolete_unpub($user,$domain,$fn)) { |
|
$request->print('<p><span class="LC_error">' |
|
.&mt('Cannot rename or move non-obsolete published file.') |
|
.'</span><br />' |
|
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
|
return; |
|
} |
|
my $action; |
|
if ($style eq 'rename') { |
|
$action='Rename'; |
|
} else { |
|
$action='Move'; |
|
} |
|
$request->print('<input type="hidden" name="newfilename" value="' |
|
.$newfilename.'" />' |
|
.'<p>' |
|
.&mt($action.' [_1] to [_2]?', |
|
&display($fn), |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>'); |
|
return; |
|
} |
|
} else { |
|
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</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 the user initiating the request. |
|
|
|
=item $domain - string [in] Domain the initiating user is logged in as |
|
|
|
=item $filename - string [in] Source filename. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub Delete1 { |
|
my ($request, $user, $domain, $fn) = @_; |
|
|
|
if( -e $fn) { |
|
$request->print('<input type="hidden" name="newfilename" value="'. |
|
$fn.'" />'); |
|
if (-d $fn) { |
|
unless (&empty_directory($fn,'Delete1')) { |
|
$request->print('<p>' |
|
.'<span class="LC_error">' |
|
.&mt('Only empty directories may be deleted.') |
|
.'</span><br />' |
|
.&mt('You must delete the contents of the directory first.') |
|
.'</p>' |
|
.'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
|
return; |
|
} |
|
} else { |
|
unless (&obsolete_unpub($user,$domain,$fn)) { |
|
$request->print('<p><span class="LC_error">' |
|
.&mt('Cannot delete non-obsolete published file.') |
|
.'</span><br />' |
|
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
|
return; |
|
} |
|
} |
|
$request->print('<p>' |
|
.&mt('Delete [_1]?', |
|
&display($fn)) |
|
.'</p>' |
|
); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</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 $fn - string [in] Source filename. |
|
|
|
=item $newfilename-string [in] Destination filename. |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub Copy1 { |
|
my ($request, $user, $domain, $fn, $newfilename) = @_; |
|
|
|
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 ($type,$return)=&exists($user, $domain, $newfilename); |
|
$request->print($return); |
|
if ($type eq 'error') { |
|
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
|
return; |
|
} |
|
$request->print( |
|
'<input type="hidden" name="newfilename"' |
|
.' value="'.$newfilename.'" />' |
|
.'<p>' |
|
.&mt('Copy [_1] to [_2]?', |
|
&display($fn), |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
|
} |
|
} |
|
|
|
=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 $domain - Domain user is in |
|
|
|
=item $fn - source file. |
|
|
|
=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, $domain, $fn, $newfilename, $mode) = @_; |
|
|
|
my ($type, $result)=&exists($username,$domain,$newfilename,'directory'); |
|
$request->print($result); |
|
if ($type eq 'error') { |
|
$request->print('</form>'); |
|
} else { |
|
if (($mode eq 'testbank') || ($mode eq 'imsimport')) { |
|
$request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n". |
|
'<input type="hidden" name="inhibitmenu" value="yes" />'); |
|
} |
|
$request->print('<input type="hidden" name="newfilename" value="' |
|
.$newfilename.'" />' |
|
.'<p>' |
|
.&mt('Make new directory [_1]?', |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
|
&CloseForm1($request, $fn); |
|
} |
|
} |
|
|
|
|
|
sub Decompress1 { |
|
my ($request, $user, $domain, $fn) = @_; |
|
if( -e $fn) { |
|
$request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />'); |
|
$request->print('<p>' |
|
.&mt('Decompress [_1]?', |
|
&display($fn)) |
|
.'</p>' |
|
); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
|
} |
|
} |
|
|
|
=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 $fn - Source file name |
|
|
|
=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 Cancel |
|
button which returns you to the driectory listing you came from |
|
|
|
=back |
|
|
|
=cut |
|
|
|
sub NewFile1 { |
|
my ($request, $user, $domain, $fn, $newfilename) = @_; |
|
return if (&filename_check($newfilename) ne 'ok'); |
|
|
|
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|(/[^./])\.(?:[^.]+)$|$1|; |
|
} |
|
$newfilename.=".$extension"; |
|
} |
|
} |
|
my ($type, $result)=&exists($user,$domain,$newfilename); |
|
$request->print($result); |
|
if ($type eq 'error') { |
|
$request->print('</form>'); |
|
} else { |
|
my $extension; |
|
|
|
if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) { |
|
$extension = $1; |
|
} |
|
|
|
my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt); |
|
if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) { |
|
my $validexts = '.'.join(', .',@okexts); |
|
$request->print('<p class="LC_warning">'. |
|
&mt('Invalid filename: ').&display($newfilename).'</p><p>'. |
|
&mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'. |
|
&mt('The following are valid extensions: [_1].',$validexts). |
|
'</p></form><p>'. |
|
'<form name="fileaction" action="/adm/cfile" method="post">'. |
|
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
|
'<input type="hidden" name="action" value="newfile" />'. |
|
'<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" /> <input type="submit" value="Go" />'. |
|
'</span></form></p>'. |
|
'<p><form action="'.&url($fn). |
|
'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>'); |
|
return; |
|
} |
|
|
|
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
|
$request->print('</form>'); |
|
|
|
$request->print('<form action="'.&url($newfilename). |
|
'" method="post"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>'); |
|
$request->print('<form action="'.&url($fn). |
|
'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>'); |
|
} |
|
return; |
|
} |
|
|
|
sub filename_check { |
|
my ($newfilename) = @_; |
|
##Informs User (name).(number).(extension) not allowed |
|
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
|
$r->print('<span class="LC_error">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. |
|
' '.&mt('Not Allowed').'</span>'); |
|
return; |
|
} |
|
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ |
|
$r->print('<span class="LC_error">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '. |
|
' '.&mt('Not Allowed').'</span>'); |
|
return; |
|
} |
|
return 'ok'; |
|
} |
|
|
|
=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)=@_; |
my $docroot=$r->dir_config('lonDocRoot'); |
|
|
my $doingdir=0; |
|
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
|
my ($newfilename,$error) = |
|
&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
|
unless ($error) { |
|
($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
|
} |
|
if ($error) { |
|
my $dirlist; |
|
if ($fn=~m{^(.*/)[^/]+$}) { |
|
$dirlist=$1; |
|
} else { |
|
$dirlist=$fn; |
|
} |
|
$r->print('<div class="LC_error">'.$error.'</div>'. |
|
'<h3><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
|
'</a></h3>'); |
|
return; |
|
} |
|
$r->print('<form action="/adm/cfile" method="post">'. |
|
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
|
'<input type="hidden" name="phase" value="two" />'. |
|
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'); |
|
|
|
if ($env{'form.action'} eq 'rename') { |
|
&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename'); |
|
} elsif ($env{'form.action'} eq 'move') { |
|
&Rename1($r, $uname, $udom, $fn, $newfilename, 'move'); |
|
} elsif ($env{'form.action'} eq 'delete') { |
|
&Delete1($r, $uname, $udom, $fn); |
|
} elsif ($env{'form.action'} eq 'decompress') { |
|
&Decompress1($r, $uname, $udom, $fn); |
|
} elsif ($env{'form.action'} eq 'copy') { |
|
if($newfilename) { |
|
&Copy1($r, $uname, $udom, $fn, $newfilename); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt('No new filename specified.') |
|
.'</p></form>' |
|
); |
|
} |
|
} elsif ($env{'form.action'} eq 'newdir') { |
|
my $mode = ''; |
|
if (exists($env{'form.callingmode'}) ) { |
|
$mode = $env{'form.callingmode'}; |
|
} |
|
&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode); |
|
} 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' || |
|
$env{'form.action'} eq 'newrightsfile' || |
|
$env{'form.action'} eq 'newstyfile' || |
|
$env{'form.action'} eq 'newtaskfile' || |
|
$env{'form.action'} eq 'newlibraryfile' || |
|
$env{'form.action'} eq 'Select Action') { |
|
my $empty=&mt('Type Name Here'); |
|
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
|
&NewFile1($r, $uname, $udom, $fn, $newfilename); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt('No new filename specified.') |
|
.'</p></form>' |
|
); |
|
} |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=item Rename2($request, $user, $directory, $oldfile, $newfile) |
|
|
|
Performs phase 2 processing of a rename reequest. This is where the |
|
actual rename is performed. |
|
|
my $urldir='/res/'.$udom.'/'.$uname.$fn; |
Parameters |
$urldir=~s/\/[^\/]+$/\//; |
|
|
|
my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; |
=over 4 |
my $resdir=$resfn; |
|
$resdir=~s/\/[^\/]+$/\//; |
=item $request - Apache request object [in] The request being processed. |
|
|
$fn=~/\/([^\/]+)\.(\w+)$/; |
=item $user - string [in] The name of the user initiating the request. |
my $main=$1; |
|
my $suffix=$2; |
=item $directory - string [in] The name of the directory relative to the |
|
construction space top level of the renamed file. |
if (-e $resfn) { |
|
$r->print('<form action=/adm/retrieve method=post>'. |
=item $oldfile - Name of the file. |
'<input type=hidden name=filename value="/~'.$uname.$fn.'">'. |
|
'<input type=hidden name=phase value=two>'. |
=item $newfile - Name of the new file. |
'<table border=2><tr><th>Select</th><th>Version</th>'. |
|
'<th>Became this version on ...</th>'. |
=back |
'<th>Metadata</th></tr>'); |
|
my $filename; |
Returns: |
opendir(DIR,$resdir); |
|
while ($filename=readdir(DIR)) { |
=over 4 |
if ($filename=~/^$main\.(\d+)\.$suffix$/) { |
|
my $version=$1; |
=item 1 Success. |
my ($rdev,$rino,$rmode,$rnlink, |
|
$ruid,$rgid,$rrdev,$rsize, |
=item 0 Failure. |
$ratime,$rmtime,$rctime, |
|
$rblksize,$rblocks)=stat($resdir.'/'.$filename); |
=cut |
$r->print('<tr><td><input type=radio name=version value="'. |
|
$version.'"></td><th>'.$version.'</th><td>'. |
sub Rename2 { |
localtime($rmtime).'</td><td>'. |
|
'<a href="'.$urldir.$filename.'.meta" target=cat>'. |
my ($request, $user, $directory, $oldfile, $newfile) = @_; |
'Metadata Version '.$version.'</a>'); |
|
if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') { |
&Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
$r->print( |
" new file ".$newfile."\n"); |
' <a target=cat href="/adm/diff?filename=/~'. |
&Debug($request, "Target is: ".$directory.'/'. |
$uname.$fn. |
$newfile); |
'&versionone=priv&versiontwo='.$version. |
if (-e $oldfile) { |
'">Diffs with Version '.$version.'</a>'); |
|
} |
my $oRN=$oldfile; |
$r->print('</a></td></tr>'); |
my $nRN=$newfile; |
} |
unless (rename($oldfile,$newfile)) { |
} |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
closedir(DIR); |
return 0; |
my ($rdev,$rino,$rmode,$rnlink, |
} |
$ruid,$rgid,$rrdev,$rsize, |
## If old name.(extension) exits, move under new name. |
$ratime,$rmtime,$rctime, |
## If it doesn't exist and a new.(extension) exists |
$rblksize,$rblocks)=stat($resfn); |
## delete it (only concern when renaming over files) |
$r->print('<tr><td><input type=radio name=version value="new"></td>'. |
my $tmp1=$oRN.'.meta'; |
'<th>Current</th><td>'.localtime($rmtime). |
my $tmp2=$nRN.'.meta'; |
'</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'. |
if(-e $tmp1){ |
'Metadata current version</a>'); |
unless(rename($tmp1,$tmp2)){ } |
if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') { |
} elsif(-e $tmp2){ |
$r->print( |
unlink $tmp2; |
' <a target=cat href="/adm/diff?filename=/~'. |
} |
$uname.$fn. |
$tmp1=$oRN.'.save'; |
'&versionone=priv'. |
$tmp2=$nRN.'.save'; |
'">Diffs with current Version</a>'); |
if(-e $tmp1){ |
} |
unless(rename($tmp1,$tmp2)){ } |
$r->print('</td></tr></table><p>'. |
} elsif(-e $tmp2){ |
'<font size=+1 color=red>Retrieval of an old version will '. |
unlink $tmp2; |
'overwrite the file currently in construction space</font><p>'. |
} |
'<input type=submit value="Retrieve version"></form>'); |
$tmp1=$oRN.'.log'; |
} else { |
$tmp2=$nRN.'.log'; |
$r->print('<h3>No previous versions published.</h3>'); |
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( |
|
'<p>' |
|
.&mt('No such file: [_1]', |
|
&display($oldfile)) |
|
.'</p></form>' |
|
); |
|
return 0; |
|
} |
|
return 1; |
} |
} |
|
|
|
=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 (-d $filename) { |
|
unless (&empty_directory($filename,'Delete2')) { |
|
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
|
return 0; |
|
} else { |
|
if(-e $filename) { |
|
unless(rmdir($filename)) { |
|
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
return 0; |
|
} |
|
} else { |
|
$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>'); |
|
return 0; |
|
} |
|
} |
|
} else { |
|
if(-e $filename) { |
|
unless(unlink($filename)) { |
|
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
return 0; |
|
} |
|
} else { |
|
$request->print('<p class="LC_error">'.&mt('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 1 successs. |
|
|
|
=cut |
|
|
|
sub Copy2 { |
|
my ($request, $username, $dir, $oldfile, $newfile) = @_; |
|
&Debug($request ,"Will try to copy $oldfile to $newfile"); |
|
if(-e $oldfile) { |
|
if ($oldfile eq $newfile) { |
|
$request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>'); |
|
return 1; |
|
} |
|
unless (copy($oldfile, $newfile)) { |
|
$request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>'); |
|
return 0; |
|
} elsif (!chmod(0660, $newfile)) { |
|
$request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>'); |
|
return 0; |
|
} elsif (-e $oldfile.'.meta' && |
|
!copy($oldfile.'.meta', $newfile.'.meta') && |
|
!chmod(0660, $newfile.'.meta')) { |
|
$request->print('<span class="LC_error">'.&mt('copy metadata error'). |
|
': '.$!.'</span>'); |
|
return 0; |
|
} else { |
|
return 1; |
|
} |
|
} else { |
|
$request->print('<p class="LC_error">'.&mt('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('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
return 0; |
|
} |
|
unless(chmod(02770, ($newdirectory))) { |
|
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
|
|
|
sub decompress2 { |
|
my ($r, $user, $dir, $file) = @_; |
|
&Apache::lonnet::appenv({'cgi.file' => $file}); |
|
&Apache::lonnet::appenv({'cgi.dir' => $dir}); |
|
my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); |
|
$r->print($result); |
|
&Apache::lonnet::delenv('cgi.file'); |
|
&Apache::lonnet::delenv('cgi.dir'); |
|
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.version'}) { |
|
my $version=$ENV{'form.version'}; |
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
if ($version eq 'new') { |
|
$r->print('<h3>Retrieving current (most recent) version</h3>'); |
# Break down the file into its component pieces. |
} else { |
|
$r->print('<h3>Retrieving old version '.$version.'</h3>'); |
my $dir; # Directory path |
} |
my $main; # Filename. |
my $logfile; |
my $suffix; # Extension. |
my $ctarget='/home/'.$uname.'/public_html'.$fn; |
if ($fn=~m:(.*)/([^/]+):) { |
my $vfn=$fn; |
$dir=$1; # Directory path |
if ($version ne 'new') { |
$main=$2; # Filename. |
$vfn=~s/\.(\w+)$/\.$version\.$1/; |
} |
} |
if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions |
my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn; |
$suffix=$1; #This is the actually filename extension if it exists |
unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) { |
$main=~s/\.\w+$//; #strip the extension |
$r->print( |
} |
'<font color=red>No write permission to user directory, FAIL</font>'); |
my $dest; # |
} |
my $dest_dir; # On success this is where we'll go. |
print $logfile |
my $disp_newname; # |
"\n\n================= Retrieve ".localtime()." ================\n". |
my $dest_newname; # |
"Version: $version\nSource: $csource\nTarget: $ctarget\n"; |
&Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
$r->print('<p>Copying file: '); |
&Debug($r," newfilename = ".$env{'form.newfilename'}); |
if (copy($csource,$ctarget)) { |
|
$r->print('ok<p>'); |
my $conspace=$fn; |
print $logfile "Copied sucessfully.\n\n"; |
|
|
&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 'decompress') { |
|
$main .= '.'.$suffix; |
|
if(!&decompress2($r, $uname, $dir, $main)) { |
|
return ; |
|
} |
|
$dest = $dir."/."; |
|
} elsif ($env{'form.action'} eq 'rename' || |
|
$env{'form.action'} eq 'move') { |
|
if($env{'form.newfilename'}) { |
|
if (!defined($dir)) { |
|
$fn=~m:^(.*)/:; |
|
$dir=$1; |
|
} |
|
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
|
return; |
|
} |
|
$dest = $dir."/"; |
|
$dest_newname = $env{'form.newfilename'}; |
|
$env{'form.newfilename'} =~ /.+(\/.+$)/; |
|
$disp_newname = $1; |
|
$disp_newname =~ s/\///; |
|
} |
|
} 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') { |
|
if($env{'form.newfilename'}) { |
|
if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
|
return ; |
|
} |
|
$dest = $env{'form.newfilename'}; |
|
} else { |
|
$r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>'); |
|
return; |
|
} |
|
|
|
} elsif ($env{'form.action'} eq 'newdir') { |
|
my $newdir= $env{'form.newfilename'}; |
|
if(!&NewDir2($r, $uname, $newdir)) { |
|
return; |
|
} |
|
$dest = $newdir."/"; |
|
} |
|
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { |
|
$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>'); |
|
} else { |
|
if ($env{'form.action'} eq 'rename') { |
|
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>'); |
|
$r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>'); |
} else { |
} else { |
my $error=$!; |
$r->print(&done(&url($dest))); |
$r->print('fail, '.$error.'<p>'); |
} |
print $logfile "Copy failed: $error\n\n"; |
|
} |
|
$r->print('<font size=+2><a href="/priv/'.$uname.$fn. |
|
'">Back to '.$fn.'</a></font>'); |
|
} else { |
|
$r->print( |
|
'<font size=+1 color=red>Please pick a version to retrieve</font><p>'); |
|
&phaseone($r,$fn,$uname,$udom); |
|
} |
} |
} |
} |
|
|
sub handler { |
sub handler { |
|
|
my $r=shift; |
$r=shift; |
|
|
my $fn; |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']); |
|
|
if ($ENV{'form.filename'}) { |
&Debug($r, "loncfile.pm - handler entered"); |
$fn=$ENV{'form.filename'}; |
&Debug($r, " filename: ".$env{'form.filename'}); |
$fn=~s/^http\:\/\/[^\/]+//; |
&Debug($r, " newfilename: ".$env{'form.newfilename'}); |
} else { |
# |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
# Determine the root filename |
' unspecified filename for cfile', $r->filename); |
# This could come in as "filename", which actually is a URL, or |
return HTTP_NOT_FOUND; |
# as "qualifiedfilename", which is indeed a real filename in filesystem |
} |
# |
|
my $fn; |
unless ($fn) { |
|
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
if ($env{'form.filename'}) { |
' trying to cfile non-existing file', $r->filename); |
&Debug($r, "test: $env{'form.filename'}"); |
return HTTP_NOT_FOUND; |
$fn=&unescape($env{'form.filename'}); |
} |
$fn=&URLToPath($fn); |
|
} elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') { |
|
#Just hijack the script only the first time around to inject the |
|
#correct information for further processing |
|
$fn=&unescape($env{'form.decompress'}); |
|
$fn=&URLToPath($fn); |
|
$env{'form.action'}="decompress"; |
|
} elsif ($env{'form.qualifiedfilename'}) { |
|
$fn=$env{'form.qualifiedfilename'}; |
|
} else { |
|
&Debug($r, "loncfile::handler - no form.filename"); |
|
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
|
' unspecified filename for cfile', $r->filename); |
|
return HTTP_NOT_FOUND; |
|
} |
|
|
|
unless ($fn) { |
|
&Debug($r, "loncfile::handler - doctored url is empty"); |
|
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
|
' trying to cfile non-existing file', $r->filename); |
|
return HTTP_NOT_FOUND; |
|
} |
|
|
# ----------------------------------------------------------- Start page output |
# ----------------------------------------------------------- Start page output |
my $uname; |
|
my $udom; |
|
|
|
($uname,$udom)= |
my ($uname,$udom) = &Apache::loncacc::constructaccess($fn); |
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
&Debug($r, |
unless (($uname) && ($udom)) { |
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
$r->log_reason($uname.' at '.$udom. |
if (($uname eq '') || ($udom eq '')) { |
' trying to publish file '.$ENV{'form.filename'}. |
$r->log_reason($uname.' at '.$udom. |
' ('.$fn.') - not authorized', |
' trying to manipulate file '.$env{'form.filename'}. |
$r->filename); |
' ('.$fn.') - not authorized', |
return HTTP_NOT_ACCEPTABLE; |
$r->filename); |
} |
return HTTP_NOT_ACCEPTABLE; |
|
} |
$fn=~s/\/\~(\w+)//; |
|
|
|
$r->content_type('text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->send_http_header; |
$r->send_http_header; |
|
|
$r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
my (%loaditem,$js); |
|
|
$r->print( |
|
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
|
|
|
|
|
$r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); |
|
|
|
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
|
$r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. |
|
'</font></h3>'); |
|
} |
|
|
|
if ($ENV{'form.action'} eq 'delete') { |
|
$r->print('<h3>Delete</h3>'); |
|
} elsif ($ENV{'form.action'} eq 'rename') { |
|
$r->print('<h3>Rename</h3>'); |
|
} elsif ($ENV{'form.action'} eq 'newdir') { |
|
$r->print('<h3>New Directory</h3>'); |
|
} elsif ($ENV{'form.action'} eq 'copy') { |
|
$r->print('<h3>Copy</h3>'); |
|
} else { |
|
$r->print('<p>Unknown Action</body></html>'); |
|
return OK; |
|
} |
|
if ($ENV{'form.phase'} eq 'two') { |
|
# &phasetwo($r,$fn,$uname,$udom); |
|
} else { |
|
# &phaseone($r,$fn,$uname,$udom); |
|
} |
|
|
|
$r->print('</body></html>'); |
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { |
return OK; |
my $newdirname = $env{'form.newfilename'}; |
|
$js = qq| |
|
<script type="text/javascript"> |
|
function writeDone() { |
|
window.focus(); |
|
opener.document.info.newdir.value = "$newdirname"; |
|
setTimeout("self.close()",10000); |
|
} |
|
</script> |
|
|; |
|
$loaditem{'onload'} = "writeDone()"; |
|
} |
|
|
|
my $londocroot = $r->dir_config('lonDocRoot'); |
|
my $trailfile = $fn; |
|
$trailfile =~ s{^/(priv/)}{$londocroot/$1}; |
|
|
|
# Breadcrumbs |
|
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => 'Construction Space', |
|
'href' => &Apache::loncommon::authorspace(), |
|
}); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => 'File Operation', |
|
'title' => 'Construction Space File Operation', |
|
'href' => '', |
|
}); |
|
|
|
$r->print(&Apache::loncommon::start_page('Construction Space File Operation', |
|
$js, |
|
{'add_entries' => \%loaditem,}) |
|
.&Apache::lonhtmlcommon::breadcrumbs() |
|
.&Apache::loncommon::head_subbox( |
|
&Apache::loncommon::CSTR_pageheader($trailfile)) |
|
); |
|
|
|
$r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>'); |
|
|
|
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { |
|
$r->print('<p class="LC_info">' |
|
.&mt('Co-Author [_1]',$uname.':'.$udom) |
|
.'</p>' |
|
); |
|
} |
|
|
|
|
|
&Debug($r, "loncfile::handler Form action is $env{'form.action'} "); |
|
if ($env{'form.action'} eq 'delete') { |
|
$r->print('<h3>'.&mt('Delete').'</h3>'); |
|
} elsif ($env{'form.action'} eq 'rename') { |
|
$r->print('<h3>'.&mt('Rename').'</h3>'); |
|
} elsif ($env{'form.action'} eq 'move') { |
|
$r->print('<h3>'.&mt('Move').'</h3>'); |
|
} elsif ($env{'form.action'} eq 'newdir') { |
|
$r->print('<h3>'.&mt('New Directory').'</h3>'); |
|
} elsif ($env{'form.action'} eq 'decompress') { |
|
$r->print('<h3>'.&mt('Decompress').'</h3>'); |
|
} elsif ($env{'form.action'} eq 'copy') { |
|
$r->print('<h3>'.&mt('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' || |
|
$env{'form.action'} eq 'newrightsfile' || |
|
$env{'form.action'} eq 'newstyfile' || |
|
$env{'form.action'} eq 'newtaskfile' || |
|
$env{'form.action'} eq 'newlibraryfile' || |
|
$env{'form.action'} eq 'Select Action' ) { |
|
$r->print('<h3>'.&mt('New Resource').'</h3>'); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt('Unknown Action').' '.$env{'form.action'} |
|
.'</p>' |
|
.&Apache::loncommon::end_page() |
|
); |
|
return OK; |
|
} |
|
if ($env{'form.phase'} eq 'two') { |
|
&Debug($r, "loncfile::handler entering phase2"); |
|
&phasetwo($r,$fn,$uname,$udom); |
|
} else { |
|
&Debug($r, "loncfile::handler entering phase1"); |
|
&phaseone($r,$fn,$uname,$udom); |
|
} |
|
|
|
$r->print(&Apache::loncommon::end_page()); |
|
return OK; |
} |
} |
|
|
1; |
1; |
__END__ |
__END__ |
|
|