version 1.26, 2003/02/10 23:26:15
|
version 1.129, 2024/05/21 02:57:16
|
Line 33
|
Line 33
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# |
|
# (Handler to retrieve an old version of a file |
|
# |
|
# (Publication Handler |
|
# |
|
# (TeX Content Handler |
|
# |
|
# 05/29/00,05/30,10/11 Gerd Kortemeyer) |
|
# |
|
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer |
|
# 03/23 Guy Albertelli |
|
# 03/24,03/29 Gerd Kortemeyer) |
|
# |
|
# 03/31,04/03,05/02,05/09,06/23,06/24 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 |
=pod |
|
|
=head1 NAME |
=head1 NAME |
|
|
Apache::loncfile - Construction space file management. |
Apache::loncfile - Authoring space file management. |
|
|
=head1 SYNOPSIS |
=head1 SYNOPSIS |
|
|
Content handler for buttons on the top frame of the construction space |
Content handler for buttons on the top frame of the construction space |
directory. |
directory. |
|
|
=head1 INTRODUCTION |
=head1 INTRODUCTION |
|
|
loncfile is invoked when buttons in the top frame of the construction |
loncfile is invoked when buttons in the top frame of the construction |
space directory listing are clicked. All operations proceed in two phases. |
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 |
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 |
confirms the operation, the second phase commits the operation and indicates |
Line 89 use File::Basename;
|
Line 68 use File::Basename;
|
use File::Copy; |
use File::Copy; |
use HTML::Entities(); |
use HTML::Entities(); |
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
use Apache::loncacc; |
|
use Apache::Log (); |
|
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::loncommon(); |
|
use Apache::lonhtmlcommon; |
|
use Apache::lonlocal; |
|
use LONCAPA qw(:DEFAULT :match); |
|
|
my $DEBUG=0; |
my $DEBUG=0; |
my $r; # Needs to be global for some stuff RF. |
my $r; # Needs to be global for some stuff RF. |
Line 107 my $r; # Needs to be global for some
|
Line 88 my $r; # Needs to be global for some
|
Parameters: |
Parameters: |
|
|
=over 4 |
=over 4 |
|
|
=item $request - The current request operation. |
=item $request - The current request operation. |
|
|
=item $message - The message to put in the log file. |
=item $message - The message to put in the log file. |
|
|
=back |
=back |
|
|
Returns: |
Returns: |
nothing. |
nothing. |
|
|
=cut |
=cut |
|
|
sub Debug { |
sub Debug { |
|
# Put out the indicated message but only if DEBUG is true. |
# Marshall the parameters. |
if ($DEBUG) { |
|
my ($r,$message) = @_; |
my $r = shift; |
$r->log_reason($message); |
my $log = $r->log; |
} |
my $message = shift; |
} |
|
|
# Put out the indicated message butonly if DEBUG is true. |
sub done { |
|
my ($destfn) = @_; |
if ($DEBUG) { |
return |
$log->debug($message); |
'<p>' |
} |
.&Apache::lonhtmlcommon::confirm_success(&mt("Done")) |
|
.'<br /><a href="'.&url($destfn).'">'.&mt("Continue").'</a>' |
|
.'<script type="text/javascript">' |
|
.'location.href="'.&url($destfn,'js').'";' |
|
.'</script>' |
|
.'</p>'; |
} |
} |
|
|
=pod |
=pod |
Line 139 sub Debug {
|
Line 125 sub Debug {
|
=item URLToPath($url) |
=item URLToPath($url) |
|
|
Convert a URL to a file system path. |
Convert a URL to a file system path. |
|
|
In order to manipulate the construction space objects, it is necessary |
In order to manipulate the construction space objects, it is necessary |
to access url identified objects a filespace objects. This function |
to access url identified objects a filespace objects. This function |
translates a construction space URL to a file system path. |
translates a construction space URL to a file system path. |
Line 148 sub Debug {
|
Line 134 sub Debug {
|
=over 4 |
=over 4 |
|
|
=item Url - string [in] The url to convert. |
=item Url - string [in] The url to convert. |
|
|
=back |
=back |
|
|
Returns: |
Returns: |
|
|
=over 4 |
=over 4 |
|
|
=item The corresponding file system path. |
=item The corresponding file system path. |
|
|
=back |
=back |
|
|
Line 170 Global References
|
Line 156 Global References
|
=cut |
=cut |
|
|
sub URLToPath { |
sub URLToPath { |
my $Url = shift; |
my $Url = shift; |
&Debug($r, "UrlToPath got: $Url"); |
&Debug($r, "UrlToPath got: $Url"); |
$Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
$Url=~ s{^https?\://[^/]+}{}; |
$Url=~ s/^http\:\/\/[^\/]+//; |
$Url=~ s{//+}{/}g; |
&Debug($r, "Returning $Url \n"); |
$Url=~ s{^/}{}; |
return $Url; |
$Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$Url"; |
|
&Debug($r, "Returning $Url \n"); |
|
return $Url; |
|
} |
|
|
|
sub url { |
|
my ($fn,$context) = @_; |
|
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
$fn=~ s/^\Q$londocroot\E//; |
|
$fn=~s{/\./}{/}g; |
|
if ($context eq 'js') { |
|
&js_escape(\$fn); |
|
} else { |
|
$fn=&HTML::Entities::encode($fn,'\'<>"&'); |
|
} |
|
return $fn; |
} |
} |
|
|
=pod |
sub display { |
|
my $fn=shift; |
=item PublicationPath($domain, $user, $dir, $file) |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
|
$fn=~s/^\Q$londocroot\E//; |
Determines the filesystem path corresponding to a published resource |
$fn=~s{/\./}{/}g; |
specification. The returned value is the path. |
return '<span class="LC_filename">'.$fn.'</span>'; |
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; |
# 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; |
|
} |
} |
} |
=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; |
|
|
|
|
# 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. |
|
# ignores a .DS_Store file put there when viewing directory via webDAV on MacOS. |
|
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|DS_Store)$/,@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 |
=pod |
|
|
=item exists($user, $domain, $directory, $file) |
=item exists($user, $domain, $file) |
|
|
Determine if a resource file name has been published or exists |
Determine if a resource filename has been published or exists |
in the construction space. |
in the construction space. |
|
|
Parameters: |
Parameters: |
|
|
=over 4 |
=over 4 |
|
|
=item $user - string [in] - Name of the user for which to check. |
=item $user - string [in] - Name of the user for which to check. |
|
|
=item $domain - string [in] - Name of the domain in which the resource |
=item $domain - string [in] - Name of the domain in which the resource |
might have been published. |
might have been published. |
|
|
=item $dir - string [in] - Path relative to construction or resource space |
=item $file - string [in] - Name of the file. |
in which the resource might live. |
|
|
|
=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 |
=back |
|
|
Line 310 Returns:
|
Line 263 Returns:
|
|
|
=over 4 |
=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 |
=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 |
be embedded in a dialog or an empty string if the resource |
does not exist. |
does not exist. |
|
|
=back |
=back |
|
|
=cut |
=cut |
|
|
sub exists { |
sub exists { |
my ($user, $domain, $dir, $file) = @_; |
my ($user, $domain, $construct, $creating) = @_; |
|
$creating ||= 'file'; |
|
|
# Create complete paths in publication and construction space. |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
my $relativedir=$dir; |
my $published=$construct; |
$relativedir=s|/home/\Q$user\E/public_html||; |
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
my $published = &PublicationPath($domain, $user, $relativedir, $file); |
my ($type,$result); |
my $construct = &ConstructionPath($user, $relativedir, $file); |
if ( -d $construct ) { |
|
return ('error','<p class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</p>'); |
# 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; |
if ( -e $published) { |
|
if ( -e $construct ) { |
|
$type = 'warning'; |
|
$result.='<p class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</p>'; |
|
} else { |
|
my $published_type = (-d $published) ? 'directory' : 'file'; |
|
|
|
if ($published_type eq $creating) { |
|
$type = 'warning'; |
|
$result.='<p class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</p>'; |
|
} else { |
|
$type = 'error'; |
|
$result.='<p class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</p>'; |
|
} |
|
} |
|
} elsif ( -e $construct) { |
|
$type = 'warning'; |
|
$result.='<p class="LC_warning">'.&mt('Warning: target file exists!').'</p>'; |
|
} |
|
|
|
return ($type,$result); |
} |
} |
|
|
=pod |
=pod |
|
|
=item checksuffix($old, $new) |
=item checksuffix($old, $new) |
|
|
Determine if a resource filename suffix (the stuff after the .) would change |
Determine if a resource filename suffix (the stuff after the .) would change |
as a result of this operation. |
as a result of this operation. |
|
|
Line 381 sub checksuffix {
|
Line 346 sub checksuffix {
|
my $newsuffix; |
my $newsuffix; |
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } |
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } |
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
if ($oldsuffix ne $newsuffix) { |
if (lc($oldsuffix) ne lc($newsuffix)) { |
$result.= |
$result.= |
'<p><font color="red">Warning: change of MIME type!</font></p>'; |
'<p class="LC_warning">'.&mt('Warning: change of MIME type!').'></p>'; |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
|
sub cleanDest { |
|
my ($dest,$subdir,$fn,$uname,$udom)=@_; |
|
#remove bad characters |
|
my $foundbad=0; |
|
my $warnings; |
|
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") { |
|
$warnings = '<p 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 filename." |
|
,&display($newpath)) |
|
.'</p>'; |
|
$dest=~s|.*/||; |
|
} |
|
} |
|
if ($dest =~ /\.(\d+)\.(\w+)$/) { |
|
$warnings .= '<p 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>') |
|
.'</p>'; |
|
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
|
} |
|
if ($foundbad) { |
|
$warnings .= '<p class="LC_warning">' |
|
.&mt('Invalid characters in requested name have been removed.') |
|
.'</p>'; |
|
} |
|
return ($dest,$error,$warnings); |
|
} |
|
|
|
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::lonnet::constructaccess($newfilename); |
|
unless (($authorname) && ($authordom)) { |
|
my $otherdir = &display($newfilename); |
|
$error = &mt('Access denied to [_1]',$otherdir); |
|
} |
|
return ($newfilename,$error); |
|
} |
|
|
=pod |
=pod |
|
|
=item CloseForm1($request, $user, $file) |
=item CloseForm1($request, $user, $file) |
Line 406 Parameters:
|
Line 440 Parameters:
|
=cut |
=cut |
|
|
sub CloseForm1 { |
sub CloseForm1 { |
my ($request, $cancelurl) = @_; |
my ($request, $fn) = @_; |
|
$request->print('<input type="submit" value="'.&mt('Continue').'" /></form>'); |
|
$request->print(' <form action="'.&url($fn).'" method="post">'. |
&Debug($request, "Cancel url is: ".$cancelurl); |
'<input type="submit" value="'.&mt('Cancel').'" /></form>'); |
$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>'); |
|
|
|
} |
} |
|
|
|
|
Line 433 Parameters:
|
Line 463 Parameters:
|
=item $user - string [in] - Name of the user that is initiating the |
=item $user - string [in] - Name of the user that is initiating the |
request. |
request. |
|
|
=item $directory - string [in] - Directory in which the operation is |
=item $directory - string [in] - Directory in which the operation is |
being done relative to the top level construction space |
being done relative to the top level construction space |
directory. |
directory. |
|
|
Line 442 Parameters:
|
Line 472 Parameters:
|
=cut |
=cut |
|
|
sub CloseForm2 { |
sub CloseForm2 { |
my ($request, $user, $directory) = @_; |
my ($request, $user, $fn) = @_; |
|
$request->print(&done($fn)); |
$request->print('<h3><a href="/priv/'.$user.$directory.'/">Done </a> </h3>'); |
|
} |
} |
|
|
=pod |
=pod |
|
|
=item Rename1($request, $filename, $user, $domain, $dir) |
=item Rename1($request, $filename, $user, $domain, $dir) |
|
|
Perform phase 1 processing of the file rename operation. |
Perform phase 1 processing of the file rename operation. |
|
|
Parameters: |
Parameters: |
|
|
=over 4 |
=over 4 |
|
|
=item $request - Apache Request Object [in] The request object for the |
=item $request - Apache Request Object [in] The request object for the |
current request. |
current request. |
|
|
=item $filename - The filename relative to construction space. |
=item $filename - The filename relative to construction space. |
Line 480 new filename relative to the current dir
|
Line 509 new filename relative to the current dir
|
|
|
=back |
=back |
|
|
=cut |
=cut |
|
|
sub Rename1 { |
sub Rename1 { |
my ($request, $filename, $user, $domain, $dir) = @_; |
my ($request, $user, $domain, $fn, $newfilename, $style) = @_; |
&Debug($request, "Username - ".$user." filename: ".$filename."\n"); |
|
my $conspace = $filename; |
if(-e $fn) { |
|
if($newfilename) { |
my $cancelurl = "/priv/".$filename; |
# is dest a dir |
$cancelurl =~ s/\/home\///; |
if ($style eq 'move') { |
$cancelurl =~ s/\/public_html//; |
if (-d $newfilename) { |
|
if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } |
if(-e $conspace) { |
} |
if($ENV{'form.newfilename'}) { |
} |
my $newfilename = $ENV{'form.newfilename'}; |
if ($newfilename =~ m|/[^\.]+$|) { |
if ($newfilename =~ m|^[^\.]+$|) { |
#no extension add on original extension |
#no extension add on orignal extension |
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { |
if ($filename =~ m|/[^\.]*\.([^\.]+)$|) { |
|
$newfilename.='.'.$1; |
$newfilename.='.'.$1; |
} |
} |
} |
} |
$request->print(&checksuffix($filename, $newfilename)); |
$request->print(&checksuffix($fn, $newfilename)); |
my $return=&exists($user, $domain, $dir, $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); |
$request->print($return); |
if ($return =~/^Error:/) { |
if ($type eq 'error') { |
$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>'); |
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
return; |
return; |
} |
} |
my $dest=&SimplifyDir($dir,$newfilename); |
unless (&obsolete_unpub($user,$domain,$fn)) { |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<p><span class="LC_error">' |
$newfilename. |
.&mt('Cannot rename or move non-obsolete published file.') |
'" /><p>Rename <tt>'.$filename. |
.'</span><br />' |
'</tt><br /> to <tt>'. |
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
$dest.'</tt>?</p>'); |
); |
&CloseForm1($request, $cancelurl); |
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 { |
} else { |
$request->print('<p>No new filename specified</p></form>'); |
$request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>'); |
return; |
return; |
} |
} |
} else { |
} else { |
$request->print('<p> No such File </p> </form>'); |
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
return; |
return; |
} |
} |
|
|
} |
} |
|
|
=pod |
=pod |
|
|
=item Delete1 |
=item Delete1 |
Line 538 Parameters:
|
Line 604 Parameters:
|
=item $request - Apache Request Object [in] request object for the current |
=item $request - Apache Request Object [in] request object for the current |
request. |
request. |
|
|
=item $user - string [in] Name of session user. |
=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] Name fo the file to be deleted: |
=item $filename - string [in] Source filename. |
Filename is the full filesystem path to the file. |
|
|
|
=back |
=back |
|
|
=cut |
=cut |
|
|
sub Delete1 { |
sub Delete1 { |
my ($request, $user, $filename) = @_; |
my ($request, $user, $domain, $fn) = @_; |
|
|
my $cancelurl = '/priv/'.$filename; |
if( -e $fn) { |
$cancelurl =~ s/\/home\///; |
$request->print('<input type="hidden" name="newfilename" value="'. |
$cancelurl =~ s/\/public_html//; |
$fn.'" />'); |
|
if (-d $fn) { |
|
unless (&empty_directory($fn,'Delete1')) { |
if( -e $filename) { |
$request->print('<p>' |
$request->print('<input type="hidden" name="newfilename" value="'. |
.'<span class="LC_error">' |
$filename.'"/>'); |
.&mt('Only empty directories may be deleted.') |
$request->print('<p> Delete <tt>'.$filename.'</tt>?</p>'); |
.'</span><br />' |
&CloseForm1($request, $cancelurl); |
.&mt('You must delete the contents of the directory first.') |
} else { |
.'</p>' |
$request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>'); |
.'<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 |
=pod |
Line 578 Parameters:
|
Line 669 Parameters:
|
|
|
=over 4 |
=over 4 |
|
|
=item $request - Apache Request Object [in] request object for the current |
=item $request - Apache Request Object [in] request object for the current |
request. |
request. |
|
|
=item $user - string [in] Name of the user initiating the 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 $domain - string [in] Domain the initiating user is logged in as |
|
|
=item $dir - string [in] Directory path. |
=item $fn - string [in] Source filename. |
|
|
=item $filename - string [in] Source filename. |
|
|
|
=item $newfilename-string [in] Destination filename. |
=item $newfilename-string [in] Destination filename. |
|
|
Line 596 Parameters:
|
Line 685 Parameters:
|
=cut |
=cut |
|
|
sub Copy1 { |
sub Copy1 { |
my ($request, $user, $domain, $dir, $filename, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
|
|
my $cancelurl = "/priv/".$filename; |
if(-e $fn) { |
$cancelurl =~ s/\/home\///; |
# is dest a dir |
$cancelurl =~ s/\/public_html//; |
if (-d $newfilename) { |
|
if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } |
|
} |
if(-e $filename) { |
if ($newfilename =~ m|/[^\.]+$|) { |
$request->print(&checksuffix($filename,$newfilename)); |
#no extension add on original extension |
my $return=&exists($user, $domain, $dir, $newfilename); |
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; } |
$request->print($return); |
} |
if ($return =~/^Error:/) { |
$newfilename=~s://+:/:g; # remove duplicate / |
$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>'); |
while ($newfilename=~m:/\.\./:) { |
return; |
$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></form>'); |
|
return; |
|
} |
|
# Check if there is enough space. |
|
my @fileinfo = stat($fn); |
|
my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$}); |
|
my $filesize = $fileinfo[7]; |
|
$filesize = int($filesize/1000); #expressed in kb |
|
my $output = &Apache::loncommon::excess_filesize_warning($user,$domain,'author', |
|
$fname,$filesize,'copy'); |
|
if ($output) { |
|
$request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>'); |
|
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>' |
|
); |
} |
} |
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 |
=pod |
|
|
=item NewDir1 |
=item NewDir1 |
|
|
Does all phase 1 processing of directory creation: |
Does all phase 1 processing of directory creation: |
Ensures that the user provides a new directory name, |
Ensures that the user provides a new directory name, |
and that the directory does not already exist. |
and that the directory does not already exist. |
Line 667 Parameters:
|
Line 754 Parameters:
|
|
|
=item $username - Name of the user that is requesting the directory creation. |
=item $username - Name of the user that is requesting the directory creation. |
|
|
=item $path - current directory relative to construction space. |
=item $domain - Domain user is in |
|
|
|
=item $fn - source file. |
|
|
=item $newdir - Name of the directory to be created; path relative to the |
=item $newdir - Name of the directory to be created; path relative to the |
top level of construction space. |
top level of construction space. |
=back |
=back |
|
|
Line 687 causes the newdir operation to transitio
|
Line 776 causes the newdir operation to transitio
|
=cut |
=cut |
|
|
|
|
sub NewDir1 |
sub NewDir1 { |
{ |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
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); |
|
|
|
} |
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>' |
|
); |
|
} |
|
} |
|
|
|
sub Archive1 { |
|
my ($request,$fn) = @_; |
|
my @posstypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other); |
|
my (%location_of,%defaults); |
|
my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext) = |
|
&archive_tools(\%location_of,\%defaults); |
|
if (!$canarchive) { |
|
$request->print('<p class="LC_error">'. |
|
&mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'."\n". |
|
'<span class="LC_warning">'. |
|
&mt('At least one of the two is needed in order to be able to create an archive file for: [_1].', |
|
&display($fn))."\n". |
|
'</span></form>'); |
|
} elsif (-e $fn) { |
|
$request->print('<input type="hidden" name="adload" value="" />'."\n". |
|
&Apache::lonhtmlcommon::start_pick_box(). |
|
&Apache::lonhtmlcommon::row_title(&mt('Directory')). |
|
&display($fn). |
|
&Apache::lonhtmlcommon::row_closure(). |
|
&Apache::lonhtmlcommon::row_title(&mt('Options'). |
|
&Apache::loncommon::help_open_topic('Archiving_Directory_Options')). |
|
'<fieldset><legend>'.&mt('Recurse').'</legend>'. |
|
'<span class="LC_nobreak"><label><input type="checkbox" name="recurse" /> '. |
|
&mt('include subdirectories').'</label></span>'. |
|
'</fieldset>'. |
|
'<fieldset><legend>'.&mt('File types (extensions) to include').(' 'x2). |
|
'<span style="text-decoration:line-through">'.(' 'x5).'</span>'.(' 'x2). |
|
'<input type="button" name="checkall" value="'.&mt('check all'). |
|
'" style="height:20px;" onclick="checkAll(document.phaseone.filetype);" />'. |
|
(' 'x2). |
|
'<input type="button" name="uncheckall" value="'.&mt('uncheck all'). |
|
'" style="height:20px;" onclick="uncheckAll(document.phaseone.filetype);" /></legend>'. |
|
'<table>'); |
|
my $rem; |
|
my $numinrow = 6; |
|
for (my $i=0; $i<@posstypes; $i++) { |
|
my $rem = $i%($numinrow); |
|
if ($rem == 0) { |
|
if ($i > 0) { |
|
$request->print('</tr>'."\n"); |
|
} |
|
$request->print('<tr>'."\n"); |
|
} |
|
$request->print('<td class="LC_left_item">'. |
|
'<span class="LC_nobreak"><label>'. |
|
'<input type="checkbox" name="filetype" '. |
|
'value="'.$posstypes[$i].'" /> '. |
|
$posstypes[$i].'</label></span></td>'."\n"); |
|
} |
|
$rem = scalar(@posstypes)%($numinrow); |
|
my $colsleft; |
|
if ($rem) { |
|
$colsleft = $numinrow - $rem; |
|
} |
|
if ($colsleft > 1 ) { |
|
$request->print('<td colspan="'.$colsleft.'" class="LC_left_item">'. |
|
' </td>'."\n"); |
|
} elsif ($colsleft == 1) { |
|
$request->print('<td class="LC_left_item"> </td>'."\n"); |
|
} |
|
$request->print('</tr></table>'."\n". |
|
'</fieldset>'. |
|
'<fieldset><legend>'.&mt('Archive file format').'</legend>'); |
|
foreach my $possfmt ('tar','zip') { |
|
if (exists($location_of{$possfmt})) { |
|
$request->print('<span class="LC_nobreak">'. |
|
'<label><input type="radio" name="format" value="'.$possfmt.'"'. |
|
$defaults{$possfmt}.' onclick="toggleCompression(this.form);" /> '. |
|
$possfmt.'</label></span> '); |
|
} |
|
} |
|
$request->print('</fieldset>'."\n". |
|
'<fieldset style="display:'.$compstyle.'" id="tar_compression">'. |
|
'<legend>'.&mt('Compression to apply to tar file').'</legend>'. |
|
'<span class="LC_nobreak">'); |
|
if ($cancompress) { |
|
foreach my $compress ('gzip','bzip2','xz') { |
|
if (exists($location_of{$compress})) { |
|
$request->print('<label><input type="radio" name="compress" value="'.$compress.'"'. |
|
$defaults{$compress}.' onclick="setArchiveExt(this.form);" />'. |
|
$compress.'</label> '); |
|
} |
|
} |
|
} else { |
|
$request->print('<span class="LC_warning">'. |
|
&mt('This LON-CAPA instance does not seem to have gzip, bzip2 or xz installed.'). |
|
'<br />'.&mt('No compression will be used.').'</span>'); |
|
} |
|
$request->print('</fieldset>'."\n". |
|
'<fieldset style="display:none" id="archive_saveas">'. |
|
'<legend>'.&mt('Filename to download').'</legend>'. |
|
'<table style="border-spacing:0"><tr><td style="padding:0;">'.&mt('Name').'<br />'."\n". |
|
'<input type="text" name="archivefname" value="" size="8" /></td><td style="padding:0;">'. |
|
&mt('Extension').'<br />'."\n". |
|
'<input type="text" name="archiveext" id="archiveext" value="" size="4" readonly="readonly" />'. |
|
'</td></tr></table></fieldset>'."\n". |
|
&Apache::lonhtmlcommon::row_closure(1). |
|
&Apache::lonhtmlcommon::end_pick_box().'<br />'."\n" |
|
); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p class="LC_error">' |
|
.&mt('No such directory: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
|
} |
|
return; |
|
} |
|
|
|
sub archive_tools { |
|
my ($location_of,$defaults) = @_; |
|
my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext); |
|
($numformat,$numcompress) = (0,0); |
|
if ((ref($location_of) eq 'HASH') && (ref($defaults) eq 'HASH')) { |
|
foreach my $program ('tar','gzip','bzip2','xz','zip') { |
|
foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/', |
|
'/usr/sbin/') { |
|
if (-x $dir.$program) { |
|
$location_of->{$program} = $dir.$program; |
|
last; |
|
} |
|
} |
|
} |
|
foreach my $format ('tar','zip') { |
|
if (exists($location_of->{$format})) { |
|
unless ($canarchive) { |
|
$defext = $format; |
|
$defaults->{$format} = ' checked="checked"'; |
|
if ($format eq 'tar') { |
|
$compstyle = 'block'; |
|
} else { |
|
$compstyle = 'none'; |
|
} |
|
} |
|
$canarchive = 1; |
|
$numformat ++; |
|
} |
|
} |
|
foreach my $compress ('gzip','bzip2','xz') { |
|
if (exists($location_of->{$compress})) { |
|
$numcompress ++; |
|
unless ($cancompress) { |
|
if ($defext eq 'tar') { |
|
if ($compress eq 'gzip') { |
|
$defext .= '.gz'; |
|
} elsif ($compress eq 'bzip2') { |
|
$defext .= '.bz2'; |
|
} else { |
|
$defext .= ".$compress"; |
|
} |
|
} |
|
$defaults->{$compress} = ' checked="checked"'; |
|
$cancompress = 1; |
|
} |
|
} |
|
} |
|
} |
|
if (wantarray) { |
|
return ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext); |
|
} else { |
|
return $defext; |
|
} |
|
} |
|
|
|
sub archive_in_progress { |
|
my ($earlyout,$idnum); |
|
if ($env{'cgi.author.archive'} =~ /^(\d+)_\d+_\d+$/) { |
|
my $timestamp = $1; |
|
$idnum = $env{'cgi.author.archive'}; |
|
if (exists($env{'cgi.'.$idnum.'.archive'})) { |
|
my $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$idnum.'.archive'}); |
|
my $lonprtdir = $Apache::lonnet::perlvar{'lonPrtDir'}; |
|
if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.'.txt') { |
|
$earlyout = $timestamp; |
|
} elsif (ref($hashref) eq 'HASH') { |
|
my $suffix = $hashref->{'extension'}; |
|
if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.$suffix) { |
|
$earlyout = $timestamp; |
|
} |
|
} |
|
unless ($earlyout) { |
|
&Apache::lonnet::delenv('cgi.'.$idnum.'.archive'); |
|
&Apache::lonnet::delenv('cgi.author.archive'); |
|
} |
|
} else { |
|
&Apache::lonnet::delenv('cgi.author.archive'); |
|
} |
|
} |
|
return ($earlyout,$idnum); |
|
} |
|
|
|
sub cancel_archive_form { |
|
my ($r,$title,$fname,$earlyout,$idnum) = @_; |
|
$r->print('<h2>'.$title.'</h2>'."\n". |
|
'<form action="/adm/cfile" method="post" onsubmit="return confirmation(this);">'."\n". |
|
'<input type="hidden" name="filename" value="'.$fname.'" />'."\n". |
|
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n". |
|
'<p>'.&mt('Each author may only have one archive request in process at a time.')."\n".'<ul>'. |
|
'<li>'.&mt('An incomplete archive request was begun: [_1].', |
|
&Apache::lonlocal::locallocaltime($earlyout)). |
|
'</li>'."\n". |
|
'<li>'.&mt('An archive request is considered complete when the archive file has been successfully downloaded.').'</li>'."\n". |
|
'<li>'. |
|
&mt('To submit a new archive request, either wait for the existing request (e.g., in another tab/window) to complete, or remove it.').'</li>'."\n". |
|
'</ul></p>'."\n". |
|
'<p><span class="LC_nobreak">'.&mt('Remove existing archive request?').' '."\n". |
|
'<label><input type="radio" name="remove_archive_request" value="'.$idnum.'" />'.&mt('Yes').'</label>'. |
|
(' 'x2)."\n". |
|
'<label><input type="radio" name="remove_archive_request" value="" checked="checked" />'.&mt('No').'</label></span></p>'."\n". |
|
'<br />'); |
} |
} |
|
|
=pod |
=pod |
|
|
=item NewFile1 |
=item NewFile1 |
|
|
Does all phase 1 processing of file creation: |
Does all phase 1 processing of file creation: |
Ensures that the user provides a new filename, adds proper extension |
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, |
if needed and that the file does not already exist, if it is a html, |
Line 731 Parameters:
|
Line 1053 Parameters:
|
|
|
=item $domain - Name of the domain of the user |
=item $domain - Name of the domain of the user |
|
|
=item $dir - current absolute diretory |
=item $fn - Source filename |
|
|
=item $newfilename |
=item $newfilename |
- Name of the file to be created; no path information |
- Name of the file to be created; no path information |
|
|
|
=item $warnings - Information about changes to filename made by cleanDest(). |
|
|
=back |
=back |
|
|
Side Effects: |
Side Effects: |
Line 743 Side Effects:
|
Line 1068 Side Effects:
|
|
|
=item 2 new forms are displayed. Clicking on the confirmation button |
=item 2 new forms are displayed. Clicking on the confirmation button |
causes the browser to attempt to load the specfied URL, allowing the |
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 |
proper handler to take care of file creation. There is also a Cancel |
button which returns you to the driectory listing you came from |
button which returns you to the directory listing you came from |
|
|
=back |
=back |
|
|
=cut |
=cut |
|
|
|
|
sub NewFile1 { |
sub NewFile1 { |
my ($request, $user, $domain, $dir, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename, $warnings) = @_; |
|
return if (&filename_check($newfilename,$warnings) ne 'ok'); |
&Debug($request, "Dir is : ".$dir); |
|
&Debug($request, "Newfile is : ".$newfilename); |
|
|
|
my $cancelurl = "/priv/".$dir; |
if ($env{'form.action'} =~ /new(.+)file/) { |
$cancelurl =~ s/\/home\///; |
|
$cancelurl =~ s/\/public_html//; |
|
|
|
if ($ENV{'form.action'} =~ /new(.+)file/) { |
|
my $extension=$1; |
my $extension=$1; |
if ($newfilename !~ /\Q.$extension\E$/) { |
if ($newfilename !~ /\Q.$extension\E$/) { |
if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) { |
if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) { |
#already has an extension strip it and add in expected one |
#already has an extension strip it and add in expected one |
$newfilename =~ s|.([^\.]+)$||; |
$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|; |
} |
} |
$newfilename.=".$extension"; |
$newfilename.=".$extension"; |
} |
} |
} |
} |
|
my ($type, $result)=&exists($user,$domain,$newfilename); |
|
if ($type eq 'error') { |
|
$request->print($warnings.$result); |
|
$request->print('</form>'); |
|
} else { |
|
my $extension; |
|
|
my $fullpath = $dir.'/'.$newfilename; |
if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) { |
|
$extension = $1; |
&Debug($request, "Full path is : ".$fullpath); |
} |
|
|
|
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($warnings.$result); |
|
$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 filename: ').'<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>'); |
|
} elsif (($type ne 'warning') && ($warnings eq '') && ($result eq '')) { |
|
my $query = ""; |
|
$query .= "?mode=" . $env{'form.mode'} unless (!exists($env{'form.mode'}) || !length($env{'form.mode'})); |
|
$request->print(' |
|
<script type="text/javascript"> |
|
window.location = "'.&url($newfilename,'js'). $query .'"; |
|
</script>'); |
|
} else { |
|
$request->print($warnings.$result); |
|
$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; |
|
} |
|
|
if(-e $fullpath) { |
sub filename_check { |
$request->print('<p>File exists.</p></form>'); |
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; |
} |
} |
else { |
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ |
$request->print('<p>Make new file <tt>'.$dir.'/'.$newfilename.'</tt>?</p>'); |
$r->print('<span class="LC_error">'.$newfilename. |
my $dest=&MakeFinalUrl($request,$fullpath); |
' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '. |
&Debug($request, "Cancel url is: ".$cancelurl); |
' '.&mt('Not Allowed').'</span>'); |
&Debug($request, "Dest url is: ".$dest); |
return; |
$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>'); |
|
} |
} |
|
return 'ok'; |
} |
} |
|
|
=pod |
=pod |
Line 800 sub NewFile1 {
|
Line 1162 sub NewFile1 {
|
are returned if the request cannot be performed (e.g. attempts to manipulate |
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 |
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 |
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 |
user confirms the request, then phase two is executed, the action |
performed and reported to the user. |
performed and reported to the user. |
|
|
Parameters: |
Parameters: |
Line 809 performed and reported to the user.
|
Line 1171 performed and reported to the user.
|
|
|
=item $r - request object [in] - The Apache request being executed. |
=item $r - request object [in] - The Apache request being executed. |
|
|
=item $fn = string [in] - The filename being manipulated by the |
=item $fn = string [in] - The filename being manipulated by the |
request. |
request. |
|
|
=item $uname - string [in] Name of user logged in and doing this action. |
=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. |
=item $udom - string [in] Domain name under which the user logged in. |
|
|
=back |
=back |
|
|
=cut |
=cut |
|
|
sub phaseone { |
sub phaseone { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
|
|
$fn=~m:(.*)/([^/]+)\.(\w+)$:; |
my $doingdir=0; |
my $dir=$1; |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
my $main=$2; |
my ($newfilename,$error,$warnings) = |
my $suffix=$3; |
&cleanDest($env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
|
unless ($error) { |
# my $conspace=ConstructionPathFromRelative($uname, $fn); |
($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
|
} |
|
if ($error) { |
$r->print('<form action="/adm/cfile" method="post">'. |
my $dirlist; |
'<input type="hidden" name="filename" value="/~'.$uname.$fn.'" />'. |
if ($fn=~m{^(.*/)[^/]+$}) { |
'<input type="hidden" name="phase" value="two" />'. |
$dirlist=$1; |
'<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />'); |
} else { |
|
$dirlist=$fn; |
if ($ENV{'form.action'} eq 'rename') { |
} |
|
if ($warnings) { |
&Rename1($r, $fn, $uname, $udom, $dir); |
$r->print($warnings); |
|
} |
} elsif ($ENV{'form.action'} eq 'delete') { |
$r->print('<div class="LC_error">'.$error.'</div>'. |
|
'<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
&Delete1($r, $uname, $fn); |
'</a></p>'); |
|
return; |
} elsif ($ENV{'form.action'} eq 'copy') { |
} |
if($ENV{'form.newfilename'}) { |
$r->print('<form action="/adm/cfile" method="post" name="phaseone">'."\n". |
my $newfilename = $ENV{'form.newfilename'}; |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'."\n". |
&Copy1($r, $uname, $udom, $dir, $fn, $newfilename); |
'<input type="hidden" name="phase" value="two" />'."\n". |
}else { |
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n"); |
$r->print('<p>No new filename specified.</p></form>'); |
|
} |
if ($env{'form.action'} eq 'newfile' || |
} elsif ($ENV{'form.action'} eq 'newdir') { |
$env{'form.action'} eq 'newhtmlfile' || |
&NewDir1($r, $uname, $dir, $ENV{'form.newfilename'}); |
$env{'form.action'} eq 'newproblemfile' || |
} elsif ($ENV{'form.action'} eq 'newfile' || |
$env{'form.action'} eq 'newpagefile' || |
$ENV{'form.action'} eq 'newhtmlfile' || |
$env{'form.action'} eq 'newsequencefile' || |
$ENV{'form.action'} eq 'newproblemfile') { |
$env{'form.action'} eq 'newrightsfile' || |
if($ENV{'form.newfilename'}) { |
$env{'form.action'} eq 'newstyfile' || |
my $newfilename = $ENV{'form.newfilename'}; |
$env{'form.action'} eq 'newtaskfile' || |
if (!defined($dir)) { |
$env{'form.action'} eq 'newlibraryfile' || |
$fn=~m:(.*)/:; |
$env{'form.action'} eq 'Select Action') { |
$dir=$1; |
my $empty=&mt('Type Name Here'); |
} |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
&NewFile1($r, $uname, $udom, $dir, $newfilename); |
&NewFile1($r, $uname, $udom, $fn, $newfilename, $warnings); |
} else { |
} else { |
$r->print('<p>No new filename specified.</p></form>'); |
if ($warnings) { |
} |
$r->print($warnings); |
} |
} |
|
$r->print('<p class="LC_error">' |
|
.&mt('No new filename specified.') |
|
.'</p></form>' |
|
); |
|
} |
|
} else { |
|
if ($warnings) { |
|
$r->print($warnings); |
|
} |
|
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 'archive') { |
|
&Archive1($r,$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); |
|
} |
|
} |
} |
} |
|
|
=pod |
=pod |
Line 905 Returns:
|
Line 1303 Returns:
|
|
|
sub Rename2 { |
sub Rename2 { |
|
|
my ($request, $user, $directory, $oldfile, $newfile) = @_; |
my ($request, $user, $directory, $oldfile, $newfile) = @_; |
|
|
&Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
&Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
" new file ".$newfile."\n"); |
" new file ".$newfile."\n"); |
&Debug($request, "Target is: ".$directory.'/'. |
&Debug($request, "Target is: ".$directory.'/'. |
$newfile); |
$newfile); |
|
if (-e $oldfile) { |
if(-e $oldfile) { |
|
unless(rename($oldfile, |
my $oRN=$oldfile; |
$directory.'/'.$newfile)) { |
my $nRN=$newfile; |
$request->print('<font color="red">Error: '.$!.'</font>'); |
unless (rename($oldfile,$newfile)) { |
return 0; |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
} else {} |
return 0; |
} else { |
} |
$request->print("<p> No such file: /home".$user.'/public_html'. |
## If old name.(extension) exits, move under new name. |
$oldfile.' </p></form>'); |
## If it doesn't exist and a new.(extension) exists |
return 0; |
## delete it (only concern when renaming over files) |
} |
my $tmp1=$oRN.'.meta'; |
return 1; |
my $tmp2=$nRN.'.meta'; |
|
if(-e $tmp1){ |
|
unless(rename($tmp1,$tmp2)){ } |
|
} elsif(-e $tmp2){ |
|
unlink $tmp2; |
|
} |
|
$tmp1=$oRN.'.save'; |
|
$tmp2=$nRN.'.save'; |
|
if(-e $tmp1){ |
|
unless(rename($tmp1,$tmp2)){ } |
|
} elsif(-e $tmp2){ |
|
unlink $tmp2; |
|
} |
|
$tmp1=$oRN.'.log'; |
|
$tmp2=$nRN.'.log'; |
|
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 class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($oldfile)) |
|
.'</p></form>' |
|
); |
|
return 0; |
|
} |
|
return 1; |
} |
} |
|
|
=pod |
=pod |
|
|
=item Delete2($request, $user, $filename) |
=item Delete2($request, $user, $filename) |
|
|
Performs phase two of a delete. The user has confirmed that they want |
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 |
to delete the selected file. The file is deleted and the results of the |
delete attempt are indicated. |
delete attempt are indicated. |
|
|
Line 955 Returns:
|
Line 1390 Returns:
|
=cut |
=cut |
|
|
sub Delete2 { |
sub Delete2 { |
my ($request, $user, $filename) = @_; |
my ($request, $user, $filename) = @_; |
|
if (-d $filename) { |
if(-e $filename) { |
unless (&empty_directory($filename,'Delete2')) { |
unless(unlink($filename)) { |
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
$request->print('<font color="red">Error: '.$!.'</font>'); |
return 0; |
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; |
|
} |
} |
} |
} else { |
return 1; |
$request->print('<p> No such file. </p></form'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
} |
|
|
=pod |
=pod |
|
|
=item Copy2($request, $username, $dir, $oldfile, $newfile) |
=item Copy2($request, $username, $dir, $oldfile, $newfile) |
|
|
Performs phase 2 of a copy. The file is copied and the status |
Performs phase 2 of a copy. The file is copied and the status |
of that copy is reported back to the user. |
of that copy is reported back to the user. |
|
|
=over 4 |
=over 4 |
Line 993 sub Delete2 {
|
Line 1444 sub Delete2 {
|
|
|
=back |
=back |
|
|
Returns 0 failure, and 0 successs. |
Returns 0 failure, and 1 successs. |
|
|
=cut |
=cut |
|
|
Line 1001 sub Copy2 {
|
Line 1452 sub Copy2 {
|
my ($request, $username, $dir, $oldfile, $newfile) = @_; |
my ($request, $username, $dir, $oldfile, $newfile) = @_; |
&Debug($request ,"Will try to copy $oldfile to $newfile"); |
&Debug($request ,"Will try to copy $oldfile to $newfile"); |
if(-e $oldfile) { |
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)) { |
unless (copy($oldfile, $newfile)) { |
$request->print('<font color="red"> copy Error: '.$!.'</font>'); |
$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; |
return 0; |
} else { |
} else { |
unless (chmod(0660, $newfile)) { |
|
$request->print('<font color="red"> chmod error: '.$!.'</font>'); |
|
return 0; |
|
} |
|
return 1; |
return 1; |
} |
} |
} else { |
} else { |
$request->print('<p> No such file </p>'); |
$request->print('<p class="LC_error">'.&mt('No such file').'</p>'); |
return 0; |
return 0; |
} |
} |
return 1; |
return 1; |
} |
} |
|
|
=pod |
=pod |
|
|
=item NewDir2($request, $user, $newdirectory) |
=item NewDir2($request, $user, $newdirectory) |
Line 1040 Returns 0 - failure 1 - success.
|
Line 1501 Returns 0 - failure 1 - success.
|
=cut |
=cut |
|
|
sub NewDir2 { |
sub NewDir2 { |
my ($request, $user, $newdirectory) = @_; |
my ($request, $user, $newdirectory) = @_; |
|
|
unless(mkdir($newdirectory, 02770)) { |
unless(mkdir($newdirectory, 02770)) { |
$request->print('<font color="red">Error: '.$!.'</font>'); |
$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; |
|
} |
|
|
|
sub Archive2 { |
|
my ($r,$uname,$udom,$fn,$identifier) = @_; |
|
my %options = ( |
|
dir => $fn, |
|
uname => $uname, |
|
udom => $udom, |
|
); |
|
if ($env{'form.adload'}) { |
|
$options{'adload'} = 1; |
|
if ($env{'form.archivefname'} ne '') { |
|
$env{'form.archivefname'} =~ s{\.+}{.}g; |
|
$options{'fname'} = $env{'form.archivefname'}; |
|
} |
|
if ($env{'form.archiveext'} ne '') { |
|
$options{'extension'} = $env{'form.archiveext'}; |
|
} |
|
} |
|
my @filetypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other); |
|
my (@include,%oktypes); |
|
map { $oktypes{$_} = 1; } @filetypes; |
|
my @posstypes = &Apache::loncommon::get_env_multiple('form.filetype'); |
|
foreach my $type (@posstypes) { |
|
if ($oktypes{$type}) { |
|
push(@include,$type); |
|
} |
|
} |
|
if (scalar(@include) == scalar(@filetypes)) { |
|
$options{'types'} = 'all'; |
|
} else { |
|
$options{'types'} = join(',',@include); |
|
} |
|
if (exists($env{'form.recurse'})) { |
|
$options{'recurse'} = 1; |
|
} |
|
if (exists($env{'form.encrypt'})) { |
|
if ($env{'form.enckey'} ne '') { |
|
$options{'encrypt'} = $env{'form.enckey'}; |
|
} |
|
} |
|
$options{'format'} = 'tar'; |
|
$options{'compress'} = 'gzip'; |
|
if ((exists($env{'form.format'})) && $env{'form.format'} =~ /^zip$/i) { |
|
$options{'format'} = 'zip'; |
|
delete($options{'compress'}); |
|
} elsif ((exists($env{'form.compress'})) && ($env{'form.compress'} =~ /^(xz|bzip2)$/i)) { |
|
$options{'compress'} = lc($env{'form.compress'}); |
|
} |
|
my $key = 'cgi.'.$identifier.'.archive'; |
|
my $storestring = &Apache::lonnet::freeze_escape(\%options); |
|
&Apache::lonnet::appenv({$key => $storestring, |
|
'cgi.author.archive' => $identifier}); |
|
return 1; |
|
} |
|
|
|
sub Archive3 { |
|
my ($hashref) = @_; |
|
if (ref($hashref) eq 'HASH') { |
|
if (($hashref->{'uname'} eq $env{'user.name'}) && |
|
($hashref->{'udom'} eq $env{'user.domain'}) && |
|
($env{'environment.canarchive'}) && |
|
($env{'form.delarchive'})) { |
|
my $filesdest = $Apache::lonnet::perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$env{'form.delarchive'}; |
|
if (-e $filesdest) { |
|
my $size = (stat($filesdest))[7]; |
|
if (unlink($filesdest)) { |
|
my ($identifier,$suffix) = split(/\./,$env{'form.delarchive'},2); |
|
if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) { |
|
my $delres = &Apache::lonnet::delenv('cgi.'.$identifier.'.archive'); |
|
if (($delres eq 'ok') && |
|
(exists($env{'cgi.author.archive'})) && |
|
($env{'cgi.author.archive'} eq $identifier)) { |
|
&Apache::lonnet::authorarchivelog($hashref,$size,$filesdest,'delete'); |
|
&Apache::lonnet::delenv('cgi.author.archive'); |
|
} |
|
} |
|
return 1; |
|
} |
|
} |
|
} |
|
} |
return 0; |
return 0; |
} |
|
unless(chmod(02770, ($newdirectory))) { |
|
$request->print('<font color="red"> Error: '.$!.'</font>'); |
|
return 0; |
|
} |
|
return 1; |
|
} |
} |
|
|
=pod |
=pod |
|
|
=item phasetwo($r, $fn, $uname, $udom) |
=item phasetwo($r, $fn, $uname, $udom,$identifier) |
|
|
Controls the phase 2 processing of file management |
Controls the phase 2 processing of file management |
requests for construction space. In phase one, the user |
requests for construction space. In phase one, the user |
Line 1063 sub NewDir2 {
|
Line 1618 sub NewDir2 {
|
is performed and the result is shown. |
is performed and the result is shown. |
|
|
The strategy is to break out the processing into specific action processors |
The strategy is to break out the processing into specific action processors |
named action2 where action is the requested action and the 2 denotes |
named action2 where action is the requested action and the 2 denotes |
phase 2 processing. |
phase 2 processing. |
|
|
Parameters: |
Parameters: |
Line 1086 Parameters:
|
Line 1641 Parameters:
|
=cut |
=cut |
|
|
sub phasetwo { |
sub phasetwo { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom,$identifier)=@_; |
|
|
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
|
|
# Break down the file into it's component pieces. |
# Break down the file into its component pieces. |
|
|
$fn=~/(.*)\/([^\/]+)\.(\w+)$/; |
my $dir; # Directory path |
my $dir=$1; # Directory path |
my $main; # Filename. |
my $main=$2; # Filename. |
my $suffix; # Extension. |
my $suffix=$3; # Extension. |
if ($fn=~m:(.*)/([^/]+):) { |
|
$dir=$1; # Directory path |
my $dest; # On success this is where we'll go. |
$main=$2; # Filename. |
|
} |
&Debug($r, |
if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions |
"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
$suffix=$1; #This is the actually filename extension if it exists |
&Debug($r, |
$main=~s/\.\w+$//; #strip the extension |
" newfilename = ".$ENV{'form.newfilename'}); |
} |
|
my $dest; # |
|
my $dest_dir; # On success this is where we'll go. |
|
my $disp_newname; # |
|
my $dest_newname; # |
|
&Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
|
&Debug($r," newfilename = ".$env{'form.newfilename'}); |
|
|
my $conspace=$fn; |
my $conspace=$fn; |
|
|
&Debug($r, |
&Debug($r,"loncfile::phase2 Full construction space name: $conspace"); |
"loncfile::phase2 Full construction space name: $conspace"); |
|
|
&Debug($r,"loncfie::phase2 action is $env{'form.action'}"); |
&Debug($r, |
|
"loncfie::phase2 action is $ENV{'form.action'}"); |
|
|
|
# Select the appropriate processing sub. |
# Select the appropriate processing sub. |
|
if ($env{'form.action'} eq 'decompress') { |
if ($ENV{'form.action'} eq 'rename') { # Rename. |
$main .= '.'.$suffix; |
if($ENV{'form.newfilename'}) { |
if(!&decompress2($r, $uname, $dir, $main)) { |
if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
return ; |
|
} |
|
$dest = $dir."/."; |
|
} elsif ($env{'form.action'} eq 'archive') { |
|
&Archive2($r,$uname,$udom,$fn,$identifier); |
|
return; |
|
} 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; |
return; |
} |
} |
# Prepend the directory to the new name to form the basis of the |
$dest = $dir."/"; |
# url of the new resource. |
$dest_newname = $env{'form.newfilename'}; |
# |
$env{'form.newfilename'} =~ /.+(\/.+$)/; |
$dest = $dir."/".$ENV{'form.newfilename'}; |
$disp_newname = $1; |
|
$disp_newname =~ s/\///; |
} |
} |
} elsif ($ENV{'form.action'} eq 'delete') { |
} elsif ($env{'form.action'} eq 'delete') { |
if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) { |
if(!&Delete2($r, $uname, $env{'form.newfilename'})) { |
return ; |
return ; |
} |
} |
# Once a resource is deleted, we just list the directory that |
# Once a resource is deleted, we just list the directory that |
# previously held it. |
# previously held it. |
# |
# |
$dest = $dir."/."; # Parent dir. |
$dest = $dir."/."; # Parent dir. |
} elsif ($ENV{'form.action'} eq 'copy') { |
} elsif ($env{'form.action'} eq 'copy') { |
if($ENV{'form.newfilename'}) { |
if($env{'form.newfilename'}) { |
if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
return |
return ; |
} |
} |
$dest = $ENV{'form.newfilename'}; |
$dest = $env{'form.newfilename'}; |
|
} else { |
} else { |
$r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>'); |
$r->print('<p>No New filename specified</p></form>'); |
|
return; |
return; |
} |
} |
|
|
} elsif ($ENV{'form.action'} eq 'newdir') { |
} elsif ($env{'form.action'} eq 'newdir') { |
# |
my $newdir= $env{'form.newfilename'}; |
# 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)) { |
if(!&NewDir2($r, $uname, $newdir)) { |
return; |
return; |
} |
} |
$dest = $newdir."/" |
$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( |
|
'<p>' |
|
.&Apache::lonhtmlcommon::confirm_success(&mt('Done')) |
|
.'<br /><a href="javascript:self.close()">'.&mt('Continue').'</a>' |
|
.'</p>' |
|
); |
|
} else { |
|
if ($env{'form.action'} eq 'rename') { |
|
$r->print( |
|
'<p>'.&Apache::lonhtmlcommon::confirm_success(&mt('Done')).'</p>' |
|
.&Apache::lonhtmlcommon::actionbox( |
|
['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>', |
|
'<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>'])); |
|
} else { |
|
$r->print(&done($dest)); |
|
} |
} |
} |
# |
|
# 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 { |
|
|
$r=shift; |
$r=shift; |
|
|
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename','mode']); |
|
|
|
&Debug($r, "loncfile.pm - handler entered"); |
|
&Debug($r, " filename: ".$env{'form.filename'}); |
|
&Debug($r, " newfilename: ".$env{'form.newfilename'}); |
|
# |
|
# Determine the root filename |
|
# This could come in as "filename", which actually is a URL, or |
|
# as "qualifiedfilename", which is indeed a real filename in filesystem, |
|
# or in value of decompress form element, or need to be extracted |
|
# from %env from hashref retrieved for cgi.<id>.archive key, where id |
|
# is a unique cgi_id created when an Author creates an archive of |
|
# Authoring Space for download. |
|
# |
|
my ($fn,$archiveref); |
|
|
|
if ($env{'form.filename'}) { |
|
&Debug($r, "test: $env{'form.filename'}"); |
|
$fn=&unescape($env{'form.filename'}); |
|
$fn=&URLToPath($fn); |
|
} elsif ($env{'form.delarchive'}) { |
|
my ($delarchive,$suffix) = split(/\./,$env{'form.delarchive'}); |
|
if (($delarchive) && (exists($env{'cgi.'.$delarchive.'.archive'}))) { |
|
$archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$delarchive.'.archive'}); |
|
if (ref($archiveref) eq 'HASH') { |
|
$fn = $archiveref->{'dir'}; |
|
} |
|
} |
|
} 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; |
|
} |
|
|
&Debug($r, "loncfile.pm - handler entered"); |
unless ($fn) { |
&Debug($r, " filename: ".$ENV{'form.filename'}); |
&Debug($r, "loncfile::handler - doctored url is empty"); |
&Debug($r, " newfilename: ".$ENV{'form.newfilename'}); |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
|
' trying to cfile non-existing file', $r->filename); |
my $fn; |
return HTTP_NOT_FOUND; |
|
} |
if ($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\:\/\/[^\/]+//; |
|
$fn=URLToPath($fn); |
|
&Debug($r, "loncfile::handler - doctored url: $fn"); |
|
|
|
} 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::lonnet::constructaccess($fn); |
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
&Debug($r, |
&Debug($r, |
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
if (($uname eq '') || ($udom eq '')) { |
unless (($uname) && ($udom)) { |
$r->log_reason($uname.' at '.$udom. |
$r->log_reason($uname.' at '.$udom. |
' trying to manipulate 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; |
} |
} |
if (($env{'form.delarchive'}) && |
|
($env{'environment.canarchive'})) { |
$fn=~s/\/\~(\w+)//; |
&Apache::loncommon::content_type($r,'text/plain'); |
&Debug($r, "loncfile::handler ~ removed filename: $fn"); |
$r->send_http_header; |
|
$r->print(&Archive3($archiveref)); |
$r->content_type('text/html'); |
return OK; |
$r->send_http_header; |
} |
|
|
$r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
$r->print( |
|
'<body bgcolor="#FFFFFF"><img align="right" src="/adm/lonIcons/lonlogos.gif" />'); |
# Declarations for items used for directory archive requests |
|
my ($js,$identifier,$defext,$archive_earlyout,$archive_idnum); |
|
my $args = {}; |
$r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); |
|
|
if (($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && |
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
(($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport'))) { |
$r->print('<h3><font color="red">Co-Author: '.$uname.' at '.$udom. |
my $newdirname = $env{'form.newfilename'}; |
'</font></h3>'); |
&js_escape(\$newdirname); |
} |
$js = <<"ENDJS"; |
|
<script type="text/javascript"> |
|
// <![CDATA[ |
&Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); |
function writeDone() { |
if ($ENV{'form.action'} eq 'delete') { |
window.focus(); |
|
opener.document.info.newdir.value = "$newdirname"; |
$r->print('<h3>Delete</h3>'); |
setTimeout("self.close()",10000); |
} elsif ($ENV{'form.action'} eq 'rename') { |
} |
$r->print('<h3>Rename</h3>'); |
// ]]> |
} elsif ($ENV{'form.action'} eq 'newdir') { |
</script> |
$r->print('<h3>New Directory</h3>'); |
ENDJS |
} elsif ($ENV{'form.action'} eq 'copy') { |
$args->{'add_entries'} = { onload => "writeDone()" }; |
$r->print('<h3>Copy</h3>'); |
} elsif (($env{'form.action'} eq 'archive') && |
} elsif ($ENV{'form.action'} eq 'newfile' || |
($env{'environment.canarchive'})) { |
$ENV{'form.action'} eq 'newhtmlfile' || |
# Check if author already has an archive request in process |
$ENV{'form.action'} eq 'newproblemfile') { |
($archive_earlyout,$archive_idnum) = &archive_in_progress(); |
$r->print('<h3>New Resource</h3>'); |
# Check if archive request was in process which author wishes to terminate |
} else { |
if ($env{'form.remove_archive_request'}) { |
$r->print('<p>Unknown Action</p></body></html>'); |
if ($env{'form.remove_archive_request'} eq $archive_idnum) { |
return OK; |
if (exists($env{'cgi.'.$archive_idnum.'.archive'})) { |
} |
my $archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$archive_idnum.'.archive'}); |
if ($ENV{'form.phase'} eq 'two') { |
if (ref($archiveref) eq 'HASH') { |
&Debug($r, "loncfile::handler entering phase2"); |
$env{'form.delarchive'} = $archive_idnum.$archiveref->{'extension'}; |
&phasetwo($r,$fn,$uname,$udom); |
if (&Archive3($archiveref)) { |
} else { |
($archive_earlyout,$archive_idnum) = &archive_in_progress(); |
&Debug($r, "loncfile::handler entering phase1"); |
} |
&phaseone($r,$fn,$uname,$udom); |
delete($env{'form.delarchive'}); |
} |
} |
|
} |
|
} |
|
} |
|
if ($archive_earlyout) { |
|
my $conftext = |
|
&mt('Removing an existing request will terminate an active download of the archive file.'); |
|
&js_escape(\$conftext); |
|
$js = <<"ENDJS"; |
|
<script type="text/javascript"> |
|
// <![CDATA[ |
|
function confirmation(form) { |
|
if (form.remove_archive_request.length) { |
|
for (var i=0; i<form.remove_archive_request.length; i++) { |
|
if (form.remove_archive_request[i].checked) { |
|
if (form.remove_archive_request[i].value == '$archive_idnum') { |
|
if (!confirm('$conftext')) { |
|
return false; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return true; |
|
} |
|
// ]]> |
|
</script> |
|
|
|
ENDJS |
|
} else { |
|
if ($env{'form.phase'} eq 'two') { |
|
$identifier = &Apache::loncommon::get_cgi_id(); |
|
$args->{'redirect'} = [0.1,"/cgi-bin/archive.pl?$identifier"]; |
|
} else { |
|
my (%location_of,%defaults); |
|
$defext = &archive_tools(\%location_of,\%defaults); |
|
my $check_uncheck_js = &Apache::loncommon::check_uncheck_jscript(); |
|
$js = <<"ENDJS"; |
|
<script type="text/javascript"> |
|
// <![CDATA[ |
|
function toggleCompression(form) { |
|
if (document.getElementById('tar_compression')) { |
|
if (form.format.length > 1) { |
|
for (var i=0; i<form.format.length; i++) { |
|
if (form.format[i].checked) { |
|
if (form.format[i].value == 'zip') { |
|
document.getElementById('tar_compression').style.display = 'none'; |
|
} else if (form.format[i].value == 'tar') { |
|
document.getElementById('tar_compression').style.display = 'block'; |
|
} |
|
break; |
|
} |
|
} |
|
} |
|
} |
|
setArchiveExt(form); |
|
return; |
|
} |
|
|
|
function setArchiveExt(form) { |
|
var newfmt; |
|
var newcomp; |
|
var newdef; |
|
if (document.getElementById('archiveext')) { |
|
if (form.format.length) { |
|
for (var i=0; i<form.format.length; i++) { |
|
if (form.format[i].checked) { |
|
newfmt = form.format[i].value; |
|
break; |
|
} |
|
} |
|
} else { |
|
newfmt = form.format[0]; |
|
} |
|
if (newfmt == 'tar') { |
|
if (document.getElementById('tar_compression')) { |
|
if (form.compress.length) { |
|
for (var i=0; i<form.compress.length; i++) { |
|
if (form.compress[i].checked) { |
|
newcomp = form.compress[i].value; |
|
break; |
|
} |
|
} |
|
} else { |
|
newcomp = form.compress[0]; |
|
} |
|
} |
|
if (newcomp == 'gzip') { |
|
newdef = newfmt+'.gz'; |
|
} else if (newcomp == 'bzip2') { |
|
newdef = newfmt+'.bz2'; |
|
} else if (newcomp == 'xz') { |
|
newdef = newfmt+'.'+newcomp; |
|
} else { |
|
newdef = newfmt; |
|
} |
|
} else if (newfmt == 'zip') { |
|
newdef = newfmt; |
|
} |
|
if ((newdef == '') || (newdef == undefined) || (newdef == null)) { |
|
newdef = '.$defext'; |
|
} |
|
document.getElementById('archiveext').value = newdef; |
|
} |
|
} |
|
|
|
function resetForm() { |
|
if (document.phaseone.filetype.length) { |
|
for (var i=0; i<document.phaseone.filetype.length; i++) { |
|
document.phaseone.filetype[i].checked = false; |
|
} |
|
} |
|
if (document.getElementById('tar_compression')) { |
|
if (document.phaseone.format.length) { |
|
document.getElementById('tar_compression').style.display = 'block'; |
|
for (var i=0; i<document.phaseone.format.length; i++) { |
|
if (document.phaseone.format[i].value == 'tar') { |
|
document.phaseone.format[i].checked = true; |
|
} else { |
|
document.phaseone.format[i].checked = false; |
|
} |
|
} |
|
} |
|
if (document.phaseone.compress.length) { |
|
for (var i=0; i<document.phaseone.compress.length; i++) { |
|
if (document.phaseone.compress[i].value == 'gzip') { |
|
document.phaseone.compress[i].checked = true; |
|
} else { |
|
document.phaseone.compress[i].checked = false; |
|
} |
|
} |
|
} |
|
} |
|
document.phaseone.recurse.checked = false; |
|
var a = document.createElement('a'); |
|
var vis; |
|
if (typeof a.download != "undefined") { |
|
document.phaseone.adload.value = '1'; |
|
if (document.getElementById('archive_saveas')) { |
|
document.getElementById('archive_saveas').style.display = 'block'; |
|
vis = '1'; |
|
} |
|
} |
|
if (vis == '1') { |
|
if (document.getElementById('archiveext')) { |
|
document.getElementById('archiveext').value='.$defext'; |
|
} |
|
} else { |
|
if (document.getElementById('archive_saveas')) { |
|
document.getElementById('archive_saveas').style.display = 'none'; |
|
} |
|
if (document.getElementById('archiveext')) { |
|
document.getElementById('archiveext').value=''; |
|
} |
|
} |
|
} |
|
|
|
$check_uncheck_js |
|
|
|
// ]]> |
|
</script> |
|
|
|
ENDJS |
|
$args->{'add_entries'} = { onload => "resetForm()" }; |
|
} |
|
} |
|
} |
|
my $londocroot = $r->dir_config('lonDocRoot'); |
|
my $trailfile = $fn; |
|
$trailfile =~ s{^/(priv/)}{$londocroot/$1}; |
|
|
|
# Breadcrumbs |
|
my $crsauthor; |
|
my $text = 'Authoring Space'; |
|
my $title = 'Authoring Space File Operation', |
|
my $href = &Apache::loncommon::authorspace(&url($fn)); |
|
if ($env{'request.course.id'}) { |
|
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
if ($href eq "/priv/$cdom/$cnum/") { |
|
$text = 'Course Authoring Space'; |
|
$title = 'Course Authoring Space File Operation', |
|
$crsauthor = 1; |
|
} |
|
} |
|
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => $text, |
|
'href' => $href, |
|
}); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => 'File Operation', |
|
'title' => $title, |
|
'href' => '', |
|
}); |
|
|
|
$r->print(&Apache::loncommon::start_page($title,$js,$args) |
|
.&Apache::lonhtmlcommon::breadcrumbs() |
|
.&Apache::loncommon::head_subbox( |
|
&Apache::loncommon::CSTR_pageheader($trailfile)) |
|
); |
|
|
|
unless ($env{'form.action'} eq 'archive') { |
|
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'); |
|
} |
|
|
|
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { |
|
unless ($crsauthor) { |
|
$r->print('<p class="LC_info">' |
|
.&mt('Co-Author [_1]',$uname.':'.$udom) |
|
.'</p>' |
|
); |
|
} |
|
} |
|
|
|
|
|
&Debug($r, "loncfile::handler Form action is $env{'form.action'} "); |
|
my %action = &Apache::lonlocal::texthash( |
|
'delete' => 'Delete', |
|
'rename' => 'Rename', |
|
'move' => 'Move', |
|
'newdir' => 'New Directory', |
|
'decompress' => 'Decompress', |
|
'archive' => 'Export directory to archive file', |
|
'copy' => 'Copy', |
|
'newfile' => 'New Resource', |
|
'newhtmlfile' => 'New Resource', |
|
'newproblemfile' => 'New Resource', |
|
'newpagefile' => 'New Resource', |
|
'newsequencefile' => 'New Resource', |
|
'newrightsfile' => 'New Resource', |
|
'newstyfile' => 'New Resource', |
|
'newtaskfile' => 'New Resource', |
|
'newlibraryfile' => 'New Resource', |
|
'Select Action' => 'New Resource', |
|
); |
|
if ($action{$env{'form.action'}}) { |
|
if ($crsauthor) { |
|
my @disallowed = qw(page sequence rights library); |
|
my $newtype; |
|
if ($env{'form.action'} =~ /^new(\w+)file$/) { |
|
$newtype = $1; |
|
} elsif ($env{'form.action'} eq 'newfile') { |
|
($newtype) = ($env{'form.newfilename'} =~ m{\.([^/.]+)$}); |
|
$newtype = lc($newtype); |
|
} |
|
if (($newtype ne '') && |
|
(grep(/^\Q$newtype\E$/,@disallowed))) { |
|
$r->print('<p class="LC_error">' |
|
.&mt('Creation of a new file of type: [_1] is not permitted in Course Authoring Space',$newtype) |
|
.'</p>' |
|
.&Apache::loncommon::end_page() |
|
); |
|
return OK; |
|
} |
|
if ($env{'form.action'} eq 'archive') { |
|
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n". |
|
'<p class="LC_error">'. |
|
&mt('Export to an archive file is not permitted in Course Authoring Space'). |
|
'</p>'."\n". |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
} elsif ($env{'form.action'} eq 'archive') { |
|
if ($env{'environment.canarchive'}) { |
|
if ($archive_earlyout) { |
|
my $fname = &url($fn); |
|
my $title = $action{$env{'form.action'}}; |
|
&cancel_archive_form($r,$title,$fname,$archive_earlyout,$archive_idnum); |
|
&CloseForm1($r,$fn); |
|
$r->print(&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
} else { |
|
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n". |
|
'<p class="LC_error">'. |
|
&mt('You do not have permission to export to an archive file in this Authoring Space'). |
|
'</p>'."\n". |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
} |
|
$r->print('<h2>'.$action{$env{'form.action'}}.'</h2>'."\n"); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt('Unknown Action: [_1]',$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,$identifier); |
|
} else { |
|
&Debug($r, "loncfile::handler entering phase1"); |
|
&phaseone($r,$fn,$uname,$udom); |
|
} |
|
|
$r->print('</body></html>'); |
$r->print(&Apache::loncommon::end_page()); |
return OK; |
return OK; |
} |
} |
|
|
1; |
1; |