--- loncom/publisher/loncfile.pm 2004/08/24 21:21:41 1.62
+++ loncom/publisher/loncfile.pm 2006/04/10 22:47:18 1.75
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.62 2004/08/24 21:21:41 albertel Exp $
+# $Id: loncfile.pm,v 1.75 2006/04/10 22:47:18 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -69,7 +69,6 @@ use File::Copy;
use HTML::Entities();
use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;
-use Apache::Log ();
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;
@@ -101,16 +100,9 @@ my $r; # Needs to be global for some
=cut
sub Debug {
-
- # Marshall the parameters.
-
- my $r = shift;
- my $log = $r->log;
- my $message = shift;
-
# Put out the indicated message butonly if DEBUG is true.
-
if ($DEBUG) {
+ my ($r,$message) = @_;
$r->log_reason($message);
}
}
@@ -194,7 +186,32 @@ 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
@@ -289,16 +306,24 @@ sub checksuffix {
}
sub cleanDest {
- my ($request,$dest,$subdir)=@_;
+ my ($request,$dest,$subdir,$fn,$uname)=@_;
#remove bad characters
my $foundbad=0;
if ($subdir && $dest =~/\./) {
$foundbad=1;
$dest=~s/\.//g;
}
- if ($dest=~/[\#\?&%\"]/) {
+ if ($dest=~/[\#\?&%\":]/) {
$foundbad=1;
- $dest=~s/[\#\?&%\"]//g;
+ $dest=~s/[\#\?&%\":]//g;
+ }
+ if ($dest=~m|/|) {
+ my ($newpath)=($dest=~m|(.*)/|);
+ $newpath=&relativeDest($fn,$newpath,$uname);
+ if (! -d "$newpath") {
+ $request->print("
".&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.','"'.$newpath.'"')."
");
+ $dest=~s|.*/||;
+ }
}
if ($foundbad) {
$request->print("
".&mt('Invalid characters in requested name have been removed.')."
');
@@ -1175,8 +1218,8 @@ sub handler {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']);
&Debug($r, "loncfile.pm - handler entered");
- &Debug($r, " filename: ".$ENV{'form.filename'});
- &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
+ &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
@@ -1184,28 +1227,28 @@ sub handler {
#
my $fn;
- if ($ENV{'form.filename'}) {
- &Debug($r, "test: $ENV{'form.filename'}");
- $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
+ if ($env{'form.filename'}) {
+ &Debug($r, "test: $env{'form.filename'}");
+ $fn=&Apache::lonnet::unescape($env{'form.filename'});
$fn=&URLToPath($fn);
- } elsif($ENV{'QUERY_STRING'} && $ENV{'form.phase'} ne 'two') {
+ } 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=&Apache::lonnet::unescape($ENV{'form.decompress'});
+ $fn=&Apache::lonnet::unescape($env{'form.decompress'});
$fn=&URLToPath($fn);
- $ENV{'form.action'}="decompress";
- } elsif ($ENV{'form.qualifiedfilename'}) {
- $fn=$ENV{'form.qualifiedfilename'};
+ $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'}.
+ $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'}.
+ $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
' trying to cfile non-existing file', $r->filename);
return HTTP_NOT_FOUND;
}
@@ -1220,7 +1263,7 @@ sub handler {
"loncfile::handler constructaccess uname = $uname domain = $udom");
unless (($uname) && ($udom)) {
$r->log_reason($uname.' at '.$udom.
- ' trying to manipulate file '.$ENV{'form.filename'}.
+ ' trying to manipulate file '.$env{'form.filename'}.
' ('.$fn.') - not authorized',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
@@ -1230,10 +1273,12 @@ sub handler {
&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('LON-CAPA Construction Space
- |);
- my $loaditem = 'onLoad="writeDone()"';
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
- } else {
- $r->print('LON-CAPA Construction Space');
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
+|;
+ $loaditem{'onload'} => "writeDone()";
}
-
+
+ $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
+ $js,
+ {'add_entries' => \%loaditem,}));
$r->print('
'.&mt('Location').': '.&display($fn).'
');
- if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
+ if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
$r->print('
'.&mt('Co-Author').': '.$uname.' at '.$udom.
'
');
}
- &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
- if ($ENV{'form.action'} eq 'delete') {
+ &Debug($r, "loncfile::handler Form action is $env{'form.action'} ");
+ if ($env{'form.action'} eq 'delete') {
$r->print('