version 1.52, 2004/03/02 16:48:27
|
version 1.92, 2009/01/15 18:31:19
|
Line 69 use File::Copy;
|
Line 69 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::loncacc; |
use Apache::Log (); |
|
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonlocal; |
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 101 my $r; # Needs to be global for some
|
Line 102 my $r; # Needs to be global for some
|
=cut |
=cut |
|
|
sub Debug { |
sub Debug { |
|
# Put out the indicated message butonly 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 ($url)=@_; |
if ($DEBUG) { |
my $done=&mt("Done"); |
$r->log_reason($message); |
return(<<ENDDONE); |
} |
<a href="$url">$done</a> |
|
<script type="text/javascript"> |
|
location.href="$url"; |
|
</script> |
|
ENDDONE |
} |
} |
|
|
=pod |
=pod |
Line 151 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/\/+/\//g; |
$Url=~ s/\/+/\//g; |
$Url=~ s/^http\:\/\/[^\/]+//; |
$Url=~ s/^https?\:\/\/[^\/]+//; |
$Url=~ s/^\///; |
$Url=~ s/^\///; |
$Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//; |
$Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//; |
&Debug($r, "Returning $Url \n"); |
&Debug($r, "Returning $Url \n"); |
return $Url; |
return $Url; |
} |
} |
|
|
sub url { |
sub url { |
my $fn=shift; |
my $fn=shift; |
$fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/; |
$fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/; |
|
$fn=&HTML::Entities::encode($fn,'<>"&'); |
return $fn; |
return $fn; |
} |
} |
|
|
sub display { |
sub display { |
my $fn=shift; |
my $fn=shift; |
$fn=~s-^/home/(\w+)/public_html-/priv/$1-; |
$fn=~s-^/home/($match_username)/public_html-/priv/$1-; |
return '<tt>'.$fn.'</tt>'; |
return '<span class="LC_filename">'.$fn.'</span>'; |
} |
} |
|
|
|
|
Line 193 sub obsolete_unpub {
|
Line 199 sub obsolete_unpub {
|
} |
} |
} |
} |
|
|
|
# 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 |
=pod |
|
|
Line 206 sub obsolete_unpub {
|
Line 237 sub obsolete_unpub {
|
|
|
=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 $file - string [in] - Name of the file. |
=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 219 Returns:
|
Line 254 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. |
Line 228 Returns:
|
Line 266 Returns:
|
=cut |
=cut |
|
|
sub exists { |
sub exists { |
my ($user, $domain, $construct) = @_; |
my ($user, $domain, $construct, $creating) = @_; |
my $published=$construct; |
$creating ||= 'file'; |
$published=~ |
|
s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//; |
my $published=$construct; |
my $result=''; |
$published=~ |
if ( -d $construct ) { |
s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/}; |
return &mt('Error: destination for operation is an existing directory.'); |
my ($type,$result); |
} |
if ( -d $construct ) { |
if ( -e $published) { |
return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>'); |
$result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>'; |
|
} elsif ( -e $construct) { |
} |
$result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>'; |
|
} |
if ( -e $published) { |
return $result; |
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 |
=pod |
Line 281 sub checksuffix {
|
Line 337 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">'.&mt('Warning: change of MIME type!').'</font></p>'; |
'<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>'; |
} |
} |
return $result; |
return $result; |
} |
} |
|
|
sub cleanDest { |
sub cleanDest { |
my ($request,$dest)=@_; |
my ($request,$dest,$subdir,$fn,$uname)=@_; |
#remove bad characters |
#remove bad characters |
if ($dest=~/[\#\?&]/) { |
my $foundbad=0; |
$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>"); |
if ($subdir && $dest =~/\./) { |
$dest=~s/[\#\?&]//g; |
$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=&relativeDest($fn,$newpath,$uname); |
|
if (! -d "$newpath") { |
|
$request->print("<p><span class=\"LC_error\">" |
|
.&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('<span class="LC_error">' |
|
.&mt('Bad filename [_1].<br /> <tt>(name).(number).(extension)</tt> not allowed. <br /> Removing the <tt>.number.</tt> from requested filename.',&display($dest)) |
|
.'</span>'); |
|
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
|
} |
|
if ($foundbad) { |
|
$request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>"); |
} |
} |
return $dest; |
return $dest; |
} |
} |
Line 334 Parameters:
|
Line 416 Parameters:
|
=cut |
=cut |
|
|
sub CloseForm1 { |
sub CloseForm1 { |
my ($request, $fn) = @_; |
my ($request, $fn) = @_; |
$request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>'); |
$request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>'); |
$request->print('<form action="'.&url($fn). |
$request->print('<form action="'.&url($fn). |
'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>'); |
'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>'); |
} |
} |
|
|
|
|
Line 366 Parameters:
|
Line 448 Parameters:
|
=cut |
=cut |
|
|
sub CloseForm2 { |
sub CloseForm2 { |
my ($request, $user, $fn) = @_; |
my ($request, $user, $fn) = @_; |
$request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>'); |
$request->print(&done(&url($fn))); |
} |
} |
|
|
=pod |
=pod |
Line 426 sub Rename1 {
|
Line 508 sub Rename1 {
|
#renaming a dir, delete the trailing / |
#renaming a dir, delete the trailing / |
#remove second to last element for current dir |
#remove second to last element for current dir |
if (-d $fn) { |
if (-d $fn) { |
|
$newfilename=~/\.(\w+)$/; |
|
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
|
$request->print('<br /><span classr="LC_warning">'. |
|
&mt('Cannot change MIME type of a directory'). |
|
'</span>'. |
|
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
|
return; |
|
} |
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
} |
} |
$newfilename=~s://+:/:g; # remove duplicate / |
$newfilename=~s://+:/:g; # remove duplicate / |
while ($newfilename=~m:/\.\./:) { |
while ($newfilename=~m:/\.\./:) { |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
} |
} |
my $return=&exists($user, $domain, $newfilename); |
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="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
return; |
return; |
} |
} |
Line 452 sub Rename1 {
|
Line 542 sub Rename1 {
|
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<input type="hidden" name="newfilename" value="'. |
$newfilename. |
$newfilename. |
'" /><p>'.$action.' '.&display($fn). |
'" /><p>'.$action.' '.&display($fn). |
'</tt><br />to '.&display($newfilename).'?</p>'); |
'</p><br />to '.&display($newfilename).'?</p>'); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} else { |
} else { |
$request->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
$request->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
Line 464 sub Rename1 {
|
Line 554 sub Rename1 {
|
} |
} |
|
|
} |
} |
|
|
=pod |
=pod |
|
|
=item Delete1 |
=item Delete1 |
Line 489 Parameters:
|
Line 580 Parameters:
|
=cut |
=cut |
|
|
sub Delete1 { |
sub Delete1 { |
my ($request, $user, $domain, $fn) = @_; |
my ($request, $user, $domain, $fn) = @_; |
|
|
if( -e $fn) { |
if( -e $fn) { |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<input type="hidden" name="newfilename" value="'. |
$fn.'"/>'); |
$fn.'"/>'); |
unless (&obsolete_unpub($user,$domain,$fn)) { |
if (-d $fn) { |
$request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'. |
unless (&empty_directory($fn,'Delete1')) { |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
$request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'. |
return; |
'You must delete the contents of the directory first.<br />'. |
|
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
|
return; |
|
} |
|
} else { |
|
unless (&obsolete_unpub($user,$domain,$fn)) { |
|
$request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'. |
|
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
|
return; |
|
} |
|
} |
|
$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>'); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>'); |
} |
} |
$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>'); |
|
&CloseForm1($request, $fn); |
|
} else { |
|
$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>'); |
|
} |
|
} |
} |
|
|
=pod |
=pod |
Line 550 sub Copy1 {
|
Line 650 sub Copy1 {
|
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
} |
} |
$request->print(&checksuffix($fn,$newfilename)); |
$request->print(&checksuffix($fn,$newfilename)); |
my $return=&exists($user, $domain, $newfilename); |
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="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
return; |
return; |
} |
} |
Line 605 causes the newdir operation to transitio
|
Line 705 causes the newdir operation to transitio
|
=cut |
=cut |
|
|
|
|
sub NewDir1 |
sub NewDir1 { |
{ |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
|
|
my ($type, $result)=&exists($username,$domain,$newfilename,'directory'); |
my $result=&exists($username,$domain,$newfilename); |
$request->print($result); |
if ($result) { |
if ($type eq 'error') { |
$request->print('<font color="red">'.$result.'</font></form>'); |
$request->print('</form>'); |
} else { |
} else { |
if ($mode eq 'testbank') { |
if ($mode eq 'testbank') { |
$request->print('<input type="hidden" name="callingmode" value="testbank">'); |
$request->print('<input type="hidden" name="callingmode" value="testbank">'); |
} elsif ($mode eq 'imsimport') { |
} elsif ($mode eq 'imsimport') { |
$request->print('<input type="hidden" name="callingmode" value="imsimport">'); |
$request->print('<input type="hidden" name="callingmode" value="imsimport">'); |
} |
} |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<input type="hidden" name="newfilename" value="'. |
$newfilename.'" /><p>'.&mt('Make new directory').' '. |
$newfilename.'" /><p>'.&mt('Make new directory').' '. |
&display($newfilename).'?</p>'); |
&display($newfilename).'?</p>'); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} |
} |
} |
} |
|
|
|
|
sub Decompress1 { |
sub Decompress1 { |
my ($request, $user, $domain, $fn) = @_; |
my ($request, $user, $domain, $fn) = @_; |
if( -e $fn) { |
if( -e $fn) { |
$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>'); |
$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>'); |
$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>'); |
$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>'); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} else { |
} else { |
$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>'); |
$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>'); |
} |
} |
} |
} |
|
|
=pod |
=pod |
|
|
=item NewFile1 |
=item NewFile1 |
Line 676 button which returns you to the driector
|
Line 777 button which returns you to the driector
|
|
|
=cut |
=cut |
|
|
|
|
sub NewFile1 { |
sub NewFile1 { |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
|
|
if ($ENV{'form.action'} =~ /new(.+)file/) { |
if ($env{'form.action'} =~ /new(.+)file/) { |
my $extension=$1; |
my $extension=$1; |
|
|
##Informs User (name).(number).(extension) not allowed |
##Informs User (name).(number).(extension) not allowed |
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
$r->print('<font color="red">'.$newfilename. |
$r->print('<span class="LC_error">'.$newfilename. |
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').')'. |
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. |
' '.&mt('Not Allowed').'</font>'); |
' '.&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; |
} |
} |
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 $result=&exists($user,$domain,$newfilename); |
my ($type, $result)=&exists($user,$domain,$newfilename); |
if($result) { |
$request->print($result); |
$request->print('<font color="red">'.$result.'</font></form>'); |
if ($type eq 'error') { |
|
$request->print('</form>'); |
} else { |
} else { |
|
|
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
$request->print('</form>'); |
$request->print('</form>'); |
$request->print('<form action="'.&url($newfilename). |
$request->print('<form action="'.&url($newfilename). |
Line 740 performed and reported to the user.
|
Line 848 performed and reported to the user.
|
=cut |
=cut |
|
|
sub phaseone { |
sub phaseone { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
|
|
my $newfilename=&cleanDest($r,$ENV{'form.newfilename'}); |
my $doingdir=0; |
$newfilename=&relativeDest($fn,$newfilename,$uname); |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
$r->print('<form action="/adm/cfile" method="post">'. |
my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname); |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
$newfilename=&relativeDest($fn,$newfilename,$uname); |
'<input type="hidden" name="phase" value="two" />'. |
$r->print('<form action="/adm/cfile" method="post">'. |
'<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />'); |
'<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') { |
if ($env{'form.action'} eq 'rename') { |
&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename'); |
&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename'); |
} elsif ($ENV{'form.action'} eq 'move') { |
} elsif ($env{'form.action'} eq 'move') { |
&Rename1($r, $uname, $udom, $fn, $newfilename, 'move'); |
&Rename1($r, $uname, $udom, $fn, $newfilename, 'move'); |
} elsif ($ENV{'form.action'} eq 'delete') { |
} elsif ($env{'form.action'} eq 'delete') { |
&Delete1($r, $uname, $udom, $fn); |
&Delete1($r, $uname, $udom, $fn); |
} elsif ($ENV{'form.action'} eq 'decompress') { |
} elsif ($env{'form.action'} eq 'decompress') { |
&Decompress1($r, $uname, $udom, $fn); |
&Decompress1($r, $uname, $udom, $fn); |
} elsif ($ENV{'form.action'} eq 'copy') { |
} elsif ($env{'form.action'} eq 'copy') { |
if($newfilename) { |
if($newfilename) { |
&Copy1($r, $uname, $udom, $fn, $newfilename); |
&Copy1($r, $uname, $udom, $fn, $newfilename); |
} else { |
} else { |
$r->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
$r->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
} |
} |
} elsif ($ENV{'form.action'} eq 'newdir') { |
} elsif ($env{'form.action'} eq 'newdir') { |
my $mode = ''; |
my $mode = ''; |
if (exists($ENV{'form.callingmode'}) ) { |
if (exists($env{'form.callingmode'}) ) { |
$mode = $ENV{'form.callingmode'}; |
$mode = $env{'form.callingmode'}; |
} |
} |
&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode); |
&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode); |
} elsif ($ENV{'form.action'} eq 'newfile' || |
} elsif ($env{'form.action'} eq 'newfile' || |
$ENV{'form.action'} eq 'newhtmlfile' || |
$env{'form.action'} eq 'newhtmlfile' || |
$ENV{'form.action'} eq 'newproblemfile' || |
$env{'form.action'} eq 'newproblemfile' || |
$ENV{'form.action'} eq 'newpagefile' || |
$env{'form.action'} eq 'newpagefile' || |
$ENV{'form.action'} eq 'newsequencefile' || |
$env{'form.action'} eq 'newsequencefile' || |
$ENV{'form.action'} eq 'newrightsfile' || |
$env{'form.action'} eq 'newrightsfile' || |
$ENV{'form.action'} eq 'newstyfile' || |
$env{'form.action'} eq 'newstyfile' || |
$ENV{'form.action'} eq 'Select Action') { |
$env{'form.action'} eq 'newtaskfile' || |
if ($newfilename) { |
$env{'form.action'} eq 'newlibraryfile' || |
&NewFile1($r, $uname, $udom, $fn, $newfilename); |
$env{'form.action'} eq 'Select Action') { |
} else { |
my $empty=&mt('Type Name Here'); |
$r->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
} |
&NewFile1($r, $uname, $udom, $fn, $newfilename); |
} |
} else { |
|
$r->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
|
} |
|
} |
} |
} |
|
|
=pod |
=pod |
Line 821 Returns:
|
Line 934 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) { |
|
|
my $oRN=$oldfile; |
my $oRN=$oldfile; |
my $nRN=$newfile; |
my $nRN=$newfile; |
unless (rename($oldfile,$newfile)) { |
unless (rename($oldfile,$newfile)) { |
$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
return 0; |
return 0; |
} |
} |
## If old name.(extension) exits, move under new name. |
## If old name.(extension) exits, move under new name. |
## If it doesn't exist and a new.(extension) exists |
## If it doesn't exist and a new.(extension) exists |
## delete it (only concern when renaming over files) |
## delete it (only concern when renaming over files) |
my $tmp1=$oRN.'.meta'; |
my $tmp1=$oRN.'.meta'; |
my $tmp2=$nRN.'.meta'; |
my $tmp2=$nRN.'.meta'; |
if(-e $tmp1){ |
if(-e $tmp1){ |
unless(rename($tmp1,$tmp2)){ } |
unless(rename($tmp1,$tmp2)){ } |
} elsif(-e $tmp2){ |
} elsif(-e $tmp2){ |
unlink $tmp2; |
unlink $tmp2; |
} |
} |
$tmp1=$oRN.'.save'; |
$tmp1=$oRN.'.save'; |
$tmp2=$nRN.'.save'; |
$tmp2=$nRN.'.save'; |
if(-e $tmp1){ |
if(-e $tmp1){ |
unless(rename($tmp1,$tmp2)){ } |
unless(rename($tmp1,$tmp2)){ } |
} elsif(-e $tmp2){ |
} elsif(-e $tmp2){ |
unlink $tmp2; |
unlink $tmp2; |
} |
} |
$tmp1=$oRN.'.log'; |
$tmp1=$oRN.'.log'; |
$tmp2=$nRN.'.log'; |
$tmp2=$nRN.'.log'; |
if(-e $tmp1){ |
if(-e $tmp1){ |
unless(rename($tmp1,$tmp2)){ } |
unless(rename($tmp1,$tmp2)){ } |
} elsif(-e $tmp2){ |
} elsif(-e $tmp2){ |
unlink $tmp2; |
unlink $tmp2; |
} |
} |
$tmp1=$oRN.'.bak'; |
$tmp1=$oRN.'.bak'; |
$tmp2=$nRN.'.bak'; |
$tmp2=$nRN.'.bak'; |
if(-e $tmp1){ |
if(-e $tmp1){ |
unless(rename($tmp1,$tmp2)){ } |
unless(rename($tmp1,$tmp2)){ } |
} elsif(-e $tmp2){ |
} elsif(-e $tmp2){ |
unlink $tmp2; |
unlink $tmp2; |
} |
} |
} else { |
} else { |
$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>'); |
$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>'); |
return 0; |
return 0; |
} |
} |
return 1; |
return 1; |
} |
} |
|
|
=pod |
=pod |
|
|
=item Delete2($request, $user, $filename) |
=item Delete2($request, $user, $filename) |
Line 902 Returns:
|
Line 1016 Returns:
|
=cut |
=cut |
|
|
sub Delete2 { |
sub Delete2 { |
my ($request, $user, $filename) = @_; |
my ($request, $user, $filename) = @_; |
if(opendir DIR, $filename) { |
if (-d $filename) { |
my @files=readdir(DIR); |
unless (&empty_directory($filename,'Delete2')) { |
shift @files; shift @files; # takes off . and .. |
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
if(@files) { |
return 0; |
$request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); |
} else { |
return 0; |
if(-e $filename) { |
} else { |
unless(rmdir($filename)) { |
if(-e $filename) { |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
unless(rmdir($filename)) { |
return 0; |
$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>'); |
} |
return 0; |
} else { |
} |
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
} else { |
return 0; |
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
} |
return 0; |
} |
} |
|
} |
|
} else { |
|
if(-e $filename) { |
|
unless(unlink($filename)) { |
|
$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>'); |
|
return 0; |
|
} |
|
} else { |
} else { |
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
if(-e $filename) { |
return 0; |
unless(unlink($filename)) { |
} |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
return 0; |
|
} |
|
} else { |
|
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
|
return 0; |
} |
} |
return 1; |
} |
|
return 1; |
} |
} |
|
|
=pod |
=pod |
Line 958 sub Delete2 {
|
Line 1070 sub Delete2 {
|
|
|
=back |
=back |
|
|
Returns 0 failure, and 0 successs. |
Returns 0 failure, and 1 successs. |
|
|
=cut |
=cut |
|
|
Line 966 sub Copy2 {
|
Line 1078 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"> '.&mt('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"> '.&mt('chmod error').': '.$!.'</font>'); |
|
return 0; |
|
} |
|
return 1; |
return 1; |
} |
} |
} else { |
} else { |
Line 982 sub Copy2 {
|
Line 1103 sub Copy2 {
|
} |
} |
return 1; |
return 1; |
} |
} |
|
|
=pod |
=pod |
|
|
=item NewDir2($request, $user, $newdirectory) |
=item NewDir2($request, $user, $newdirectory) |
Line 1005 Returns 0 - failure 1 - success.
|
Line 1127 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">'.&mt('Error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
return 0; |
return 0; |
} |
} |
unless(chmod(02770, ($newdirectory))) { |
unless(chmod(02770, ($newdirectory))) { |
$request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
return 0; |
return 0; |
} |
} |
return 1; |
return 1; |
} |
} |
|
|
sub decompress2 { |
sub decompress2 { |
my ($r, $user, $dir, $file) = @_; |
my ($r, $user, $dir, $file) = @_; |
&Apache::lonnet::appenv('cgi.file' => $file); |
&Apache::lonnet::appenv({'cgi.file' => $file}); |
&Apache::lonnet::appenv('cgi.dir' => $dir); |
&Apache::lonnet::appenv({'cgi.dir' => $dir}); |
my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); |
my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); |
$r->print($result); |
$r->print($result); |
&Apache::lonnet::delenv('cgi.file'); |
&Apache::lonnet::delenv('cgi.file'); |
&Apache::lonnet::delenv('cgi.dir'); |
&Apache::lonnet::delenv('cgi.dir'); |
return 1; |
return 1; |
} |
} |
|
|
=pod |
=pod |
|
|
=item phasetwo($r, $fn, $uname, $udom) |
=item phasetwo($r, $fn, $uname, $udom) |
Line 1064 sub phasetwo {
|
Line 1188 sub phasetwo {
|
|
|
&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. |
|
|
my $dir; # Directory path |
my $dir; # Directory path |
my $main; # Filename. |
my $main; # Filename. |
Line 1072 sub phasetwo {
|
Line 1196 sub phasetwo {
|
if ($fn=~m:(.*)/([^/]+):) { |
if ($fn=~m:(.*)/([^/]+):) { |
$dir=$1; # Directory path |
$dir=$1; # Directory path |
$main=$2; # Filename. |
$main=$2; # Filename. |
} |
} |
if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions |
if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions |
$main=$`; #This is what is before the match (.) so it's just the main filename, yea it's nasty |
$suffix=$1; #This is the actually filename extension if it exists |
$suffix=$1; #This is the actually filename extension if it exists |
$main=~s/\.\w+$//; #strip the extension |
} |
} |
my $dest; # On success this is where we'll go. |
my $dest; # |
|
my $dest_dir; # On success this is where we'll go. |
&Debug($r, |
my $disp_newname; # |
"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
my $dest_newname; # |
&Debug($r, |
&Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
" newfilename = ".$ENV{'form.newfilename'}); |
&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, |
&Debug($r,"loncfie::phase2 action is $env{'form.action'}"); |
"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 'decompress') { |
$main .= '.'; |
$main .= '.'.$suffix; |
$main .= $suffix; |
if(!&decompress2($r, $uname, $dir, $main)) { |
if(!&decompress2($r, $uname, $dir, $main)) { |
return ; |
return ; |
} |
} |
$dest = $dir."/."; |
$dest = $dir."/."; |
} elsif ($env{'form.action'} eq 'rename' || |
|
$env{'form.action'} eq 'move') { |
|
if($env{'form.newfilename'}) { |
} elsif ($ENV{'form.action'} eq 'rename') { # Rename. |
|
if($ENV{'form.newfilename'}) { |
|
if (!defined($dir)) { |
if (!defined($dir)) { |
$fn=~m:^(.*)/:; |
$fn=~m:^(.*)/:; |
$dir=$1; |
$dir=$1; |
} |
} |
if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
return; |
return; |
} |
} |
$dest = &url($ENV{'form.newfilename'}); |
$dest = $dir."/"; |
|
$dest_newname = $env{'form.newfilename'}; |
|
$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>'.&mt('No New filename specified').'</p></form>'); |
$r->print('<p>'.&mt('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'}; |
my $newdir= $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') ) ) { |
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>'); |
$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>'); |
} else { |
} else { |
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>'); |
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 { |
|
$r->print(&done(&url($dest))); |
|
} |
} |
} |
} |
} |
|
|
sub handler { |
sub handler { |
|
|
$r=shift; |
$r=shift; |
|
|
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']); |
|
|
&Debug($r, "loncfile.pm - handler entered"); |
&Debug($r, "loncfile.pm - handler entered"); |
&Debug($r, " filename: ".$ENV{'form.filename'}); |
&Debug($r, " filename: ".$env{'form.filename'}); |
&Debug($r, " newfilename: ".$ENV{'form.newfilename'}); |
&Debug($r, " newfilename: ".$env{'form.newfilename'}); |
# |
# |
# Determine the root filename |
# Determine the root filename |
# This could come in as "filename", which actually is a URL, or |
# This could come in as "filename", which actually is a URL, or |
# as "qualifiedfilename", which is indeed a real filename in filesystem |
# as "qualifiedfilename", which is indeed a real filename in filesystem |
# |
# |
my $fn; |
my $fn; |
|
|
if ($ENV{'form.filename'}) { |
if ($env{'form.filename'}) { |
|
&Debug($r, "test: $env{'form.filename'}"); |
&Debug($r, "test: $ENV{'form.filename'}"); |
$fn=&unescape($env{'form.filename'}); |
$fn=&Apache::lonnet::unescape($ENV{'form.filename'}); |
|
$fn=&URLToPath($fn); |
|
} |
|
#Just hijack the script only the first time around to inject the correct information for further processing |
|
elsif($ENV{'QUERY_STRING'} && $ENV{'form.phase'} ne 'two') { |
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress']); |
|
$fn=&Apache::lonnet::unescape($ENV{'form.decompress'}); |
|
$fn=&URLToPath($fn); |
$fn=&URLToPath($fn); |
$ENV{'form.action'}="decompress"; |
} 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; |
|
} |
|
|
elsif ($ENV{'form.qualifiedfilename'}) { |
unless ($fn) { |
$fn=$ENV{'form.qualifiedfilename'}; |
&Debug($r, "loncfile::handler - doctored url is empty"); |
} else { |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
&Debug($r, "loncfile::handler - no form.filename"); |
' trying to cfile non-existing file', $r->filename); |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
return HTTP_NOT_FOUND; |
' 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 $uname; |
my $udom; |
my $udom; |
|
|
|
($uname,$udom)= |
|
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
|
&Debug($r, |
|
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
|
unless (($uname) && ($udom)) { |
|
$r->log_reason($uname.' at '.$udom. |
|
' trying to manipulate file '.$env{'form.filename'}. |
|
' ('.$fn.') - not authorized', |
|
$r->filename); |
|
return HTTP_NOT_ACCEPTABLE; |
|
} |
|
|
|
|
($uname,$udom)= |
&Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
$r->send_http_header; |
&Debug($r, |
|
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
my (%loaditem,$js); |
unless (($uname) && ($udom)) { |
|
$r->log_reason($uname.' at '.$udom. |
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { |
' trying to manipulate file '.$ENV{'form.filename'}. |
my $newdirname = $env{'form.newfilename'}; |
' ('.$fn.') - not authorized', |
$js = qq| |
$r->filename); |
<script type="text/javascript"> |
return HTTP_NOT_ACCEPTABLE; |
|
} |
|
|
|
|
|
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
|
|
|
if ( ($ENV{'form.action'} eq 'newdir') && ($ENV{'form.phase'} eq 'two') && ( ($ENV{'form.callingmode'} eq 'testbank') || ($ENV{'form.callingmode'} eq 'imsimport') ) ) { |
|
my $newdirname = $ENV{'form.newfilename'}; |
|
$r->print('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">'); |
|
$r->print(qq| |
|
function writeDone() { |
function writeDone() { |
var winName = window.opener |
|
window.focus(); |
window.focus(); |
winName.document.dataForm.newdir.value = "$newdirname" |
opener.document.info.newdir.value = "$newdirname"; |
setTimeout("self.close()",10000) |
setTimeout("self.close()",10000); |
} |
} |
</script> |
</script> |
</head>|); |
|; |
my $loaditem = 'onLoad="writeDone()"'; |
$loaditem{'onload'} = "writeDone()"; |
$r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem)); |
} |
} else { |
|
$r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
$r->print(&Apache::loncommon::start_page('Construction Space File Operation', |
$r->print(&Apache::loncommon::bodytag('Construction Space File Operation')); |
$js, |
} |
{'add_entries' => \%loaditem,})); |
|
|
|
|
$r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>'); |
$r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>'); |
|
|
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { |
$r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom. |
$r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.' at '.$udom. |
'</font></h3>'); |
'</span></h3>'); |
} |
} |
|
|
|
|
&Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); |
&Debug($r, "loncfile::handler Form action is $env{'form.action'} "); |
if ($ENV{'form.action'} eq 'delete') { |
if ($env{'form.action'} eq 'delete') { |
|
$r->print('<h3>'.&mt('Delete').'</h3>'); |
$r->print('<h3>'.&mt('Delete').'</h3>'); |
} elsif ($env{'form.action'} eq 'rename') { |
} elsif ($ENV{'form.action'} eq 'rename') { |
$r->print('<h3>'.&mt('Rename').'</h3>'); |
$r->print('<h3>'.&mt('Rename').'</h3>'); |
} elsif ($env{'form.action'} eq 'move') { |
} elsif ($ENV{'form.action'} eq 'move') { |
$r->print('<h3>'.&mt('Move').'</h3>'); |
$r->print('<h3>'.&mt('Move').'</h3>'); |
} elsif ($env{'form.action'} eq 'newdir') { |
} elsif ($ENV{'form.action'} eq 'newdir') { |
$r->print('<h3>'.&mt('New Directory').'</h3>'); |
$r->print('<h3>'.&mt('New Directory').'</h3>'); |
} elsif ($env{'form.action'} eq 'decompress') { |
} elsif ($ENV{'form.action'} eq 'decompress') { |
$r->print('<h3>'.&mt('Decompress').'</h3>'); |
$r->print('<h3>'.&mt('Decompress').'</h3>'); |
} elsif ($env{'form.action'} eq 'copy') { |
} elsif ($ENV{'form.action'} eq 'copy') { |
$r->print('<h3>'.&mt('Copy').'</h3>'); |
$r->print('<h3>'.&mt('Copy').'</h3>'); |
} elsif ($env{'form.action'} eq 'newfile' || |
} elsif ($ENV{'form.action'} eq 'newfile' || |
$env{'form.action'} eq 'newhtmlfile' || |
$ENV{'form.action'} eq 'newhtmlfile' || |
$env{'form.action'} eq 'newproblemfile' || |
$ENV{'form.action'} eq 'newproblemfile' || |
$env{'form.action'} eq 'newpagefile' || |
$ENV{'form.action'} eq 'newpagefile' || |
$env{'form.action'} eq 'newsequencefile' || |
$ENV{'form.action'} eq 'newsequencefile' || |
$env{'form.action'} eq 'newrightsfile' || |
$ENV{'form.action'} eq 'newrightsfile' || |
$env{'form.action'} eq 'newstyfile' || |
$ENV{'form.action'} eq 'newstyfile' || |
$env{'form.action'} eq 'newtaskfile' || |
$ENV{'form.action'} eq 'Select Action' ) { |
$env{'form.action'} eq 'newlibraryfile' || |
$r->print('<h3>'.&mt('New Resource').'</h3>'); |
$env{'form.action'} eq 'Select Action' ) { |
} else { |
$r->print('<h3>'.&mt('New Resource').'</h3>'); |
$r->print('<p>'.&mt('Unknown Action').' '.$ENV{'form.action'}.' </p></body></html>'); |
} else { |
return OK; |
$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'. |
} |
&Apache::loncommon::end_page()); |
if ($ENV{'form.phase'} eq 'two') { |
return OK; |
&Debug($r, "loncfile::handler entering phase2"); |
} |
&phasetwo($r,$fn,$uname,$udom); |
if ($env{'form.phase'} eq 'two') { |
} else { |
&Debug($r, "loncfile::handler entering phase2"); |
&Debug($r, "loncfile::handler entering phase1"); |
&phasetwo($r,$fn,$uname,$udom); |
&phaseone($r,$fn,$uname,$udom); |
} 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; |