[LON-CAPA-cvs] cvs: loncom /cgi decompress.pl
raeburn
raeburn at source.lon-capa.org
Wed Apr 18 22:13:00 EDT 2012
raeburn Thu Apr 19 02:13:00 2012 EDT
Modified files:
/loncom/cgi decompress.pl
Log:
- Extraction of contents of archive files (zip, tar etc.) from a file
uploaded directly to a course.
- More descriptive feedback in case of problems during extraction of
archive.
- Add cgi.decompressed to env, with value of 'ok', if extraction was
successful -- loncommon::decompress_uploaded_file() will later access
this and include it as the first element in the array it returns.
Index: loncom/cgi/decompress.pl
diff -u loncom/cgi/decompress.pl:1.17 loncom/cgi/decompress.pl:1.18
--- loncom/cgi/decompress.pl:1.17 Fri Nov 28 20:42:20 2008
+++ loncom/cgi/decompress.pl Thu Apr 19 02:13:00 2012
@@ -1,8 +1,8 @@
#!/usr/bin/perl
#
+# $Id: decompress.pl,v 1.18 2012/04/19 02:13:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
-# $Id
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
@@ -27,7 +27,7 @@
# The LearningOnline Network with CAPA
#
# A CGI script that decompresses compressed files for mass uploading into
-# construction space
+# construction space or into a course.
####
use strict;
use lib '/home/httpd/lib/perl';
@@ -53,51 +53,77 @@
} else {
&Apache::lonlocal::get_language_handle();
my %lt = &Apache::lonlocal::texthash (
- bade => 'Bad Environment!',
+ bade => 'Invalid file or directory name',
outo => 'Output of decompress:',
comp => 'Decompress complete.',
- erro => 'An error occurred',
+ erro => 'An error occurred.',
+ extf => 'Extraction failed.',
);
my $file=$Apache::lonnet::env{'cgi.file'};
- my $dir=$Apache::lonnet::env{'cgi.dir'};
- if(! $file || ! $dir) {
+ my $dir=$Apache::lonnet::env{'cgi.dir'};
+ if (!$file || !$dir) {
print(<<END);
- <html><body><span class="LC_error">$lt{'bade'}</span></body></html>
+ <html><body><span class="LC_error">$lt{'extf'} $lt{'bade'}</span></body></html>
END
+ } elsif (!-d $dir) {
+ print('<html><body><span class="LC_error">'.$lt{'extf'}.' '."\n".
+ &Apache::lonlocal::mt('The specified directory "[_1]" is invalid.',$dir).
+ '</span></body></html>');
} else {
- print(<<END);
- <html><body><p><b>$lt{'outo'}</b></p>
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ my $lonuserroot = $Apache::lonnet::perlvar{'lonUsersDir'};
+ if (($dir !~ /^\Qlondocroot\E/) && ($dir !~ /^\Q$lonuserroot\E/)) {
+ print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
+ &Apache::lonlocal::mt('The specified directory "[_1]" is invalid',$dir).
+ '</span></body></html>');
+ } elsif (chdir($dir)) {
+ if (-e $file) {
+ print(<<END);
+ <html><body><p><b>$lt{'outo'}</b></p>
END
- chdir($dir);
- my @cmd;
- if ($file =~ m|\.zip$|) {
- @cmd = ($location_of{'unzip'},"-o");
- } elsif ($file =~ m|\.tar\.gz$|
- || $file =~ m|\.tgz$| ) {
- @cmd = ($location_of{'tar'},"-zxpvf");
- } elsif ($file =~ m|\.tar\.bz2$|) {
- @cmd = ($location_of{'tar'},"-jxpvf");
- } elsif ($file =~ m|\.bz2$|) {
- @cmd = ($location_of{'bunzip2'});
- } elsif ($file =~ m|\.gz$|) {
- @cmd = ($location_of{'gunzip'});
- } elsif ($file =~ m|\.tar$|) {
- @cmd = ($location_of{'tar'},"-xpvf");
+ my @cmd;
+ if ($file =~ m|\.zip$|) {
+ @cmd = ($location_of{'unzip'},"-o");
+ } elsif ($file =~ m|\.tar\.gz$|
+ || $file =~ m|\.tgz$| ) {
+ @cmd = ($location_of{'tar'},"-zxpvf");
+ } elsif ($file =~ m|\.tar\.bz2$|) {
+ @cmd = ($location_of{'tar'},"-jxpvf");
+ } elsif ($file =~ m|\.bz2$|) {
+ @cmd = ($location_of{'bunzip2'});
+ } elsif ($file =~ m|\.gz$|) {
+ @cmd = ($location_of{'gunzip'});
+ } elsif ($file =~ m|\.tar$|) {
+ @cmd = ($location_of{'tar'},"-xpvf");
+ }
+ if (@cmd) {
+ undef($!);
+ undef($@);
+ open(OUTPUT,"-|", @cmd, $file);
+ while (my $line = <OUTPUT>) { print("$line<br />"); }
+ close(OUTPUT);
+ print("<p><b>$lt{'comp'}</b></p>");
+ if ($! || $@) {
+ print('<p><span class="LC_error">'.$lt{'erro'}.'<br />'.$!."\n".
+ '<br />'.$@.'</span></p>');
+ } else {
+ &Apache::lonnet::appenv({'cgi.decompressed' => 'ok'});
+ }
+ } else {
+ print('<span class="LC_error">'.
+ &Apache::lonlocal::mt('There has been an error in determining the file type of [_1], please check the name.',$file).'</span>');
+ }
+ print('</body></html>');
+ } else {
+ print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
+ &Apache::lonlocal::mt('The specified file "[_1]" does not exist.',$file).
+ '</span></body></html>');
+ }
} else {
- print('<span class="LC_error">'.&Apache::lonlocal::mt('There has been an error in determining the file type of [_1], please check the name',$file).'</span>');
+ print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
+ &Apache::lonlocal::mt('Could not change working directory to "[_1]".',$dir).
+ '</span></body></html>');
}
- if (@cmd) {
- undef($!);
- undef($@);
- open(OUTPUT,"-|", @cmd, $file);
- while (my $line = <OUTPUT>) { print("$line<br />"); }
- close(OUTPUT);
- print("<p><b>$lt{'comp'}</b></p>");
- if ($! || $@) {
- print('<p><span class="LC_error">'.$lt{'erro'}.'<br />'.$!.'<br />'.$@.'</span></p>');
- }
- }
- print('</body></html>');
}
}
More information about the LON-CAPA-cvs
mailing list