version 1.81, 2007/03/30 20:37:31
|
version 1.110, 2011/10/23 23:46:07
|
Line 109 sub Debug {
|
Line 109 sub Debug {
|
} |
} |
} |
} |
|
|
|
sub done { |
|
my ($url)=@_; |
|
my $done=&mt("Done"); |
|
return(<<ENDDONE); |
|
<a href="$url">$done</a> |
|
<script type="text/javascript"> |
|
location.href="$url"; |
|
</script> |
|
ENDDONE |
|
} |
|
|
=pod |
=pod |
|
|
=item URLToPath($url) |
=item URLToPath($url) |
Line 148 sub URLToPath {
|
Line 159 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\/)($match_username)\//\/home\/$2\/public_html\//; |
$Url='/home/httpd/html/'.$Url; |
&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\/($match_username)\/public\_html/\/priv\/$1/; |
$fn=~s/^\/home\/httpd\/html//; |
|
$fn=~s/\/\.\//\//g; |
$fn=&HTML::Entities::encode($fn,'<>"&'); |
$fn=&HTML::Entities::encode($fn,'<>"&'); |
return $fn; |
return $fn; |
} |
} |
|
|
sub display { |
sub display { |
my $fn=shift; |
my $fn=shift; |
$fn=~s-^/home/($match_username)/public_html-/priv/$1-; |
$fn=~s/^\/home\/httpd\/html//; |
return '<tt>'.$fn.'</tt>'; |
$fn=~s/\/\.\//\//g; |
|
return '<span class="LC_filename">'.$fn.'</span>'; |
} |
} |
|
|
|
|
Line 226 sub empty_directory {
|
Line 239 sub empty_directory {
|
|
|
=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 239 Returns:
|
Line 256 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 248 Returns:
|
Line 268 Returns:
|
=cut |
=cut |
|
|
sub exists { |
sub exists { |
my ($user, $domain, $construct) = @_; |
my ($user, $domain, $construct, $creating) = @_; |
|
$creating ||= 'file'; |
|
|
my $published=$construct; |
my $published=$construct; |
$published=~ |
$published=~s{^/home/httpd/html/priv/}{/home/httpd/html/res/}; |
s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//; |
my ($type,$result); |
my $result=''; |
|
if ( -d $construct ) { |
if ( -d $construct ) { |
return &mt('Error: destination for operation is an existing directory.'); |
return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>'); |
|
|
} |
} |
|
|
if ( -e $published) { |
if ( -e $published) { |
$result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>'; |
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) { |
} elsif ( -e $construct) { |
$result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>'; |
$type = 'warning'; |
|
$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>'; |
} |
} |
return $result; |
|
|
return ($type,$result); |
} |
} |
|
|
=pod |
=pod |
Line 300 sub checksuffix {
|
Line 338 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,$subdir,$fn,$uname)=@_; |
my ($request,$dest,$subdir,$fn,$uname,$udom)=@_; |
#remove bad characters |
#remove bad characters |
my $foundbad=0; |
my $foundbad=0; |
|
my $error=''; |
if ($subdir && $dest =~/\./) { |
if ($subdir && $dest =~/\./) { |
$foundbad=1; |
$foundbad=1; |
$dest=~s/\.//g; |
$dest=~s/\.//g; |
} |
} |
|
$dest =~ s/(\s+$|^\s+)//g; |
if ($dest=~/[\#\?&%\":]/) { |
if ($dest=~/[\#\?&%\":]/) { |
$foundbad=1; |
$foundbad=1; |
$dest=~s/[\#\?&%\":]//g; |
$dest=~s/[\#\?&%\":]//g; |
} |
} |
if ($dest=~m|/|) { |
if ($dest=~m|/|) { |
my ($newpath)=($dest=~m|(.*)/|); |
my ($newpath)=($dest=~m|(.*)/|); |
$newpath=&relativeDest($fn,$newpath,$uname); |
($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); |
if (! -d "$newpath") { |
if (! -d "$newpath") { |
$request->print("<p><font color=\"red\">".&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.','"<tt>'.$newpath.'</tt>"')."</font></p>"); |
$request->print('<p><span class="LC_warning">' |
|
.&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name." |
|
,&display($newpath)) |
|
.'</span></p>'); |
$dest=~s|.*/||; |
$dest=~s|.*/||; |
} |
} |
} |
} |
|
if ($dest =~ /\.(\d+)\.(\w+)$/){ |
|
$request->print('<p><span class="LC_warning">' |
|
.&mt('Bad filename [_1]',&display($dest)) |
|
.'<br />' |
|
.&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>') |
|
.'<br />' |
|
.&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>') |
|
.'</span></p>'); |
|
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
|
} |
if ($foundbad) { |
if ($foundbad) { |
$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>"); |
$request->print('<p><span class="LC_warning">' |
|
.&mt('Invalid characters in requested name have been removed.') |
|
.'</span></p>' |
|
); |
} |
} |
return $dest; |
return ($dest,$error); |
} |
} |
|
|
sub relativeDest { |
sub relativeDest { |
my ($fn,$newfilename,$uname)=@_; |
my ($fn,$newfilename,$uname,$udom)=@_; |
|
my $error = ''; |
if ($newfilename=~/^\//) { |
if ($newfilename=~/^\//) { |
# absolute, simply add path |
# absolute, simply add path |
$newfilename='/home/'.$uname.'/public_html/'; |
$newfilename='/home/httpd/html/res/'.$udom.'/'.$uname.'/'; |
} else { |
} else { |
my $dir=$fn; |
my $dir=$fn; |
$dir=~s/\/[^\/]+$//; |
$dir=~s/\/[^\/]+$//; |
Line 347 sub relativeDest {
|
Line 404 sub relativeDest {
|
while ($newfilename=~m:/\.\./:) { |
while ($newfilename=~m:/\.\./:) { |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
} |
} |
return $newfilename; |
if ($newfilename =~ m{^/home/($match_username)/(?:public\_html|priv)/}) { |
|
my $otheruname = $1; |
|
unless ($otheruname eq $uname) { |
|
my ($authorname,$authordom)= |
|
&Apache::loncacc::constructaccess($newfilename,$env{'request.role.domain'}); |
|
unless (($authorname eq $otheruname) && ($authordom ne '')) { |
|
my $otherdir = &display($newfilename); |
|
$error = &mt('Access denied to [_1]',$otherdir); |
|
} |
|
} |
|
} |
|
return ($newfilename,$error); |
} |
} |
|
|
=pod |
=pod |
Line 372 sub CloseForm1 {
|
Line 440 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 402 Parameters:
|
Line 470 Parameters:
|
|
|
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 463 sub Rename1 {
|
Line 531 sub Rename1 {
|
if (-d $fn) { |
if (-d $fn) { |
$newfilename=~/\.(\w+)$/; |
$newfilename=~/\.(\w+)$/; |
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
$request->print('<br /><font color="red">'. |
$request->print('<p><span class="LC_error">'. |
&mt('Cannot change MIME type of a directory'). |
&mt('Cannot change MIME type of a directory.'). |
'</font>'. |
'</span>'. |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'); |
return; |
return; |
} |
} |
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
Line 475 sub Rename1 {
|
Line 543 sub Rename1 {
|
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; |
} |
} |
unless (&obsolete_unpub($user,$domain,$fn)) { |
unless (&obsolete_unpub($user,$domain,$fn)) { |
$request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'. |
$request->print('<p><span class="LC_error">' |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
.&mt('Cannot rename or move non-obsolete published file.') |
|
.'</span><br />' |
|
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
return; |
return; |
} |
} |
my $action; |
my $action; |
if ($style eq 'rename') { |
if ($style eq 'rename') { |
$action=&mt('Rename'); |
$action='Rename'; |
} else { |
} else { |
$action=&mt('Move'); |
$action='Move'; |
} |
} |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<input type="hidden" name="newfilename" value="' |
$newfilename. |
.$newfilename.'" />' |
'" /><p>'.$action.' '.&display($fn). |
.'<p>' |
'</tt><br />to '.&display($newfilename).'?</p>'); |
.&mt($action.' [_1] to [_2]?', |
|
&display($fn), |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} else { |
} else { |
$request->print('<p>'.&mt('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> '.&mt('No such file').': '.&display($fn).'</p></form>'); |
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
return; |
return; |
} |
} |
|
|
Line 537 sub Delete1 {
|
Line 616 sub Delete1 {
|
|
|
if( -e $fn) { |
if( -e $fn) { |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print('<input type="hidden" name="newfilename" value="'. |
$fn.'"/>'); |
$fn.'" />'); |
if (-d $fn) { |
if (-d $fn) { |
unless (&empty_directory($fn,'Delete1')) { |
unless (&empty_directory($fn,'Delete1')) { |
$request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'. |
$request->print('<p>' |
'You must delete the contents of the directory first.<br />'. |
.'<span class="LC_error">' |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
.&mt('Only empty directories may be deleted.') |
|
.'</span><br />' |
|
.&mt('You must delete the contents of the directory first.') |
|
.'</p>' |
|
.'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
return; |
return; |
} |
} |
} else { |
} else { |
unless (&obsolete_unpub($user,$domain,$fn)) { |
unless (&obsolete_unpub($user,$domain,$fn)) { |
$request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'. |
$request->print('<p><span class="LC_error">' |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
.&mt('Cannot delete non-obsolete published file.') |
|
.'</span><br />' |
|
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
|
); |
return; |
return; |
} |
} |
} |
} |
$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>'); |
$request->print('<p>' |
|
.&mt('Delete [_1]?', |
|
&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 class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
} |
} |
} |
} |
|
|
Line 603 sub Copy1 {
|
Line 698 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; |
} |
} |
$request->print('<input type="hidden" name="newfilename" value="'. |
$request->print( |
$newfilename. |
'<input type="hidden" name="newfilename"' |
'" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '. |
.' value="'.$newfilename.'" />' |
&display($newfilename).'?</p>'); |
.'<p>' |
|
.&mt('Copy [_1] to [_2]?', |
|
&display($fn), |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} else { |
} else { |
$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>'); |
$request->print('<p class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
} |
} |
} |
} |
|
|
Line 661 causes the newdir operation to transitio
|
Line 765 causes the newdir operation to transitio
|
sub NewDir1 { |
sub NewDir1 { |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
|
|
my $result=&exists($username,$domain,$newfilename); |
my ($type, $result)=&exists($username,$domain,$newfilename,'directory'); |
if ($result) { |
$request->print($result); |
$request->print('<font color="red">'.$result.'</font></form>'); |
if ($type eq 'error') { |
|
$request->print('</form>'); |
} else { |
} else { |
if ($mode eq 'testbank') { |
if (($mode eq 'testbank') || ($mode eq 'imsimport')) { |
$request->print('<input type="hidden" name="callingmode" value="testbank">'); |
$request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n". |
} elsif ($mode eq 'imsimport') { |
'<input type="hidden" name="inhibitmenu" value="yes" />'); |
$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.'" />' |
$newfilename.'" /><p>'.&mt('Make new directory').' '. |
.'<p>' |
&display($newfilename).'?</p>'); |
.&mt('Make new directory [_1]?', |
|
&display($newfilename)) |
|
.'</p>' |
|
); |
&CloseForm1($request, $fn); |
&CloseForm1($request, $fn); |
} |
} |
} |
} |
Line 681 sub NewDir1 {
|
Line 789 sub NewDir1 {
|
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 [_1]?', |
|
&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 class="LC_error">' |
|
.&mt('No such file: [_1]', |
|
&display($fn)) |
|
.'</p></form>' |
|
); |
} |
} |
} |
} |
|
|
Line 731 button which returns you to the driector
|
Line 847 button which returns you to the driector
|
|
|
sub NewFile1 { |
sub NewFile1 { |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
|
return if (&filename_check($newfilename) ne 'ok'); |
|
|
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 |
|
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
|
$r->print('<font color="red">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. |
|
' '.&mt('Not Allowed').'</font>'); |
|
return; |
|
} |
|
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ |
|
$r->print('<font color="red">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '. |
|
' '.&mt('Not Allowed').'</font>'); |
|
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 |
Line 756 sub NewFile1 {
|
Line 859 sub NewFile1 {
|
$newfilename.=".$extension"; |
$newfilename.=".$extension"; |
} |
} |
} |
} |
my $result=&exists($user,$domain,$newfilename); |
my ($type, $result)=&exists($user,$domain,$newfilename); |
if($result) { |
$request->print($result); |
$request->print('<span class="LC_error">'.$result.'</span></form>'); |
if ($type eq 'error') { |
|
$request->print('</form>'); |
} else { |
} else { |
|
my $extension; |
|
|
|
if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) { |
|
$extension = $1; |
|
} |
|
|
|
my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt); |
|
if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) { |
|
my $validexts = '.'.join(', .',@okexts); |
|
$request->print('<p class="LC_warning">'. |
|
&mt('Invalid filename: ').&display($newfilename).'</p><p>'. |
|
&mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'. |
|
&mt('The following are valid extensions: [_1].',$validexts). |
|
'</p></form><p>'. |
|
'<form name="fileaction" action="/adm/cfile" method="post">'. |
|
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
|
'<input type="hidden" name="action" value="newfile" />'. |
|
'<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" /> <input type="submit" value="Go" />'. |
|
'</span></form></p>'. |
|
'<p><form action="'.&url($fn). |
|
'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>'); |
|
return; |
|
} |
|
|
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
$request->print('<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). |
'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>'); |
'" method="post"><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>'); |
} |
} |
|
return; |
|
} |
|
|
|
sub filename_check { |
|
my ($newfilename) = @_; |
|
##Informs User (name).(number).(extension) not allowed |
|
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
|
$r->print('<span class="LC_error">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. |
|
' '.&mt('Not Allowed').'</span>'); |
|
return; |
|
} |
|
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ |
|
$r->print('<span class="LC_error">'.$newfilename. |
|
' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '. |
|
' '.&mt('Not Allowed').'</span>'); |
|
return; |
|
} |
|
return 'ok'; |
} |
} |
|
|
=pod |
=pod |
Line 802 sub phaseone {
|
Line 950 sub phaseone {
|
|
|
my $doingdir=0; |
my $doingdir=0; |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname); |
my ($newfilename,$error) = |
$newfilename=&relativeDest($fn,$newfilename,$uname); |
&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
|
unless ($error) { |
|
($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
|
} |
|
if ($error) { |
|
my $dirlist; |
|
if ($fn=~m{^(.*/)[^/]+$}) { |
|
$dirlist=$1; |
|
} else { |
|
$dirlist=$fn; |
|
} |
|
$r->print('<div class="LC_error">'.$error.'</div>'. |
|
'<h3><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
|
'</a></h3>'); |
|
return; |
|
} |
$r->print('<form action="/adm/cfile" method="post">'. |
$r->print('<form action="/adm/cfile" method="post">'. |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
'<input type="hidden" name="phase" value="two" />'. |
'<input type="hidden" name="phase" value="two" />'. |
Line 821 sub phaseone {
|
Line 984 sub phaseone {
|
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 class="LC_error">' |
|
.&mt('No new filename specified.') |
|
.'</p></form>' |
|
); |
} |
} |
} elsif ($env{'form.action'} eq 'newdir') { |
} elsif ($env{'form.action'} eq 'newdir') { |
my $mode = ''; |
my $mode = ''; |
Line 836 sub phaseone {
|
Line 1002 sub phaseone {
|
$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 'newlibraryfile' || |
$env{'form.action'} eq 'newlibraryfile' || |
$env{'form.action'} eq 'Select Action') { |
$env{'form.action'} eq 'Select Action') { |
my $empty=&mt('Type Name Here'); |
my $empty=&mt('Type Name Here'); |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
&NewFile1($r, $uname, $udom, $fn, $newfilename); |
&NewFile1($r, $uname, $udom, $fn, $newfilename); |
} else { |
} else { |
$r->print('<p>'.&mt('No new filename specified.').'</p></form>'); |
$r->print('<p class="LC_error">' |
|
.&mt('No new filename specified.') |
|
.'</p></form>' |
|
); |
} |
} |
} |
} |
} |
} |
Line 894 sub Rename2 {
|
Line 1064 sub Rename2 {
|
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. |
Line 929 sub Rename2 {
|
Line 1099 sub Rename2 {
|
unlink $tmp2; |
unlink $tmp2; |
} |
} |
} else { |
} else { |
$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>'); |
$request->print( |
|
'<p>' |
|
.&mt('No such file: [_1]', |
|
&display($oldfile)) |
|
.'</p></form>' |
|
); |
return 0; |
return 0; |
} |
} |
return 1; |
return 1; |
Line 968 sub Delete2 {
|
Line 1143 sub Delete2 {
|
my ($request, $user, $filename) = @_; |
my ($request, $user, $filename) = @_; |
if (-d $filename) { |
if (-d $filename) { |
unless (&empty_directory($filename,'Delete2')) { |
unless (&empty_directory($filename,'Delete2')) { |
$request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
return 0; |
return 0; |
} else { |
} else { |
if(-e $filename) { |
if(-e $filename) { |
unless(rmdir($filename)) { |
unless(rmdir($filename)) { |
$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
return 0; |
return 0; |
} |
} |
} else { |
} else { |
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>'); |
return 0; |
return 0; |
} |
} |
} |
} |
} else { |
} else { |
if(-e $filename) { |
if(-e $filename) { |
unless(unlink($filename)) { |
unless(unlink($filename)) { |
$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
return 0; |
return 0; |
} |
} |
} else { |
} else { |
$request->print('<p> '.&mt('No such file').'. </p></form>'); |
$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>'); |
return 0; |
return 0; |
} |
} |
} |
} |
Line 1028 sub Copy2 {
|
Line 1203 sub Copy2 {
|
&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) { |
if ($oldfile eq $newfile) { |
$request->print('<font color="red"> '.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</font>'); |
$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; |
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; |
return 0; |
} elsif (!chmod(0660, $newfile)) { |
} elsif (!chmod(0660, $newfile)) { |
$request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>'); |
return 0; |
return 0; |
} elsif (-e $oldfile.'.meta' && |
} elsif (-e $oldfile.'.meta' && |
!copy($oldfile.'.meta', $newfile.'.meta') && |
!copy($oldfile.'.meta', $newfile.'.meta') && |
!chmod(0660, $newfile.'.meta')) { |
!chmod(0660, $newfile.'.meta')) { |
$request->print('<font color="red"> '.&mt('copy metadata error'). |
$request->print('<span class="LC_error">'.&mt('copy metadata error'). |
': '.$!.'</font>'); |
': '.$!.'</span>'); |
return 0; |
return 0; |
} else { |
} else { |
return 1; |
return 1; |
} |
} |
} else { |
} else { |
$request->print('<p> '.&mt('No such file').' </p>'); |
$request->print('<p class="LC_error">'.&mt('No such file').'</p>'); |
return 0; |
return 0; |
} |
} |
return 1; |
return 1; |
Line 1079 sub NewDir2 {
|
Line 1254 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; |
Line 1091 sub NewDir2 {
|
Line 1266 sub NewDir2 {
|
|
|
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'); |
Line 1201 sub phasetwo {
|
Line 1376 sub phasetwo {
|
} |
} |
$dest = $env{'form.newfilename'}; |
$dest = $env{'form.newfilename'}; |
} else { |
} else { |
$r->print('<p>'.&mt('No New filename specified').'</p></form>'); |
$r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>'); |
return; |
return; |
} |
} |
|
|
Line 1219 sub phasetwo {
|
Line 1394 sub phasetwo {
|
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>'); |
$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>'); |
$r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>'); |
} else { |
} else { |
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>'); |
$r->print(&done(&url($dest))); |
} |
} |
} |
} |
} |
} |
Line 1293 sub handler {
|
Line 1468 sub handler {
|
$js = qq| |
$js = qq| |
<script type="text/javascript"> |
<script type="text/javascript"> |
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> |
|; |
|; |
$loaditem{'onload'} = "writeDone()"; |
$loaditem{'onload'} = "writeDone()"; |
} |
} |
|
|
|
# Breadcrumbs |
|
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => 'Construction Space', |
|
'href' => &Apache::loncommon::authorspace(), |
|
}); |
|
&Apache::lonhtmlcommon::add_breadcrumb({ |
|
'text' => 'File Operation', |
|
'title' => 'Construction Space File Operation', |
|
'href' => '', |
|
}); |
|
|
$r->print(&Apache::loncommon::start_page('Construction Space File Operation', |
$r->print(&Apache::loncommon::start_page('Construction Space File Operation', |
$js, |
$js, |
{'add_entries' => \%loaditem,})); |
{'add_entries' => \%loaditem,}) |
|
.&Apache::lonhtmlcommon::breadcrumbs() |
|
.&Apache::loncommon::head_subbox( |
|
&Apache::loncommon::CSTR_pageheader()) |
|
); |
|
|
$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('<p class="LC_info">' |
'</font></h3>'); |
.&mt('Co-Author [_1]',$uname.':'.$udom) |
|
.'</p>' |
|
); |
} |
} |
|
|
|
|
Line 1335 function writeDone() {
|
Line 1527 function writeDone() {
|
$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 'newlibraryfile' || |
$env{'form.action'} eq 'newlibraryfile' || |
$env{'form.action'} eq 'Select Action' ) { |
$env{'form.action'} eq 'Select Action' ) { |
$r->print('<h3>'.&mt('New Resource').'</h3>'); |
$r->print('<h3>'.&mt('New Resource').'</h3>'); |
} else { |
} else { |
$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'. |
$r->print('<p class="LC_error">' |
&Apache::loncommon::end_page()); |
.&mt('Unknown Action').' '.$env{'form.action'} |
|
.'</p>' |
|
.&Apache::loncommon::end_page() |
|
); |
return OK; |
return OK; |
} |
} |
if ($env{'form.phase'} eq 'two') { |
if ($env{'form.phase'} eq 'two') { |