Annotation of loncom/cgi/decompress.pl, revision 1.19

1.1       taceyjo1    1: #!/usr/bin/perl
                      2: #
1.19    ! bisitz      3: # $Id: decompress.pl,v 1.18 2012/04/19 02:13:00 raeburn Exp $
1.7       taceyjo1    4: #
1.1       taceyjo1    5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/cgi-bin/decompress.pl
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: # The LearningOnline Network with CAPA
                     28: #
                     29: # A CGI script that decompresses compressed files for mass uploading into
1.18      raeburn    30: # construction space or into a course.
1.1       taceyjo1   31: ####
1.7       taceyjo1   32: use strict;
1.1       taceyjo1   33: use lib '/home/httpd/lib/perl';
1.17      raeburn    34: use Apache::lonnet;
                     35: use Apache::lonlocal;
1.13      albertel   36: use LONCAPA::loncgi;
                     37: 
1.16      albertel   38: my %location_of;
                     39: foreach my $program ('tar','gunzip','bunzip2','unzip') {
                     40:     foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                     41: 		     '/usr/sbin/') {
                     42: 	if (-x $dir.$program) {
                     43: 	    $location_of{$program} = $dir.$program;
                     44: 	}
                     45:     }
                     46: }
                     47: 
1.17      raeburn    48: print("Content-type: text/html\n\n");
                     49: 
1.16      albertel   50: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
1.17      raeburn    51:     &Apache::lonlocal::get_language_handle();
                     52:     print(&LONCAPA::loncgi::missing_cookie_msg());
1.9       albertel   53: } else {
1.17      raeburn    54:     &Apache::lonlocal::get_language_handle();
                     55:     my %lt = &Apache::lonlocal::texthash (
1.18      raeburn    56:                                             bade => 'Invalid file or directory name',
1.17      raeburn    57:                                             outo => 'Output of decompress:',
                     58:                                             comp => 'Decompress complete.', 
1.18      raeburn    59:                                             erro => 'An error occurred.',
                     60:                                             extf => 'Extraction failed.',
1.17      raeburn    61:                                          );
1.14      albertel   62:     my $file=$Apache::lonnet::env{'cgi.file'};
1.18      raeburn    63:     my $dir=$Apache::lonnet::env{'cgi.dir'};
                     64:     if (!$file || !$dir) {
1.15      albertel   65:         print(<<END);
1.18      raeburn    66:         <html><body><span class="LC_error">$lt{'extf'} $lt{'bade'}</span></body></html>
1.7       taceyjo1   67: END
1.18      raeburn    68:     } elsif (!-d $dir) {
                     69:         print('<html><body><span class="LC_error">'.$lt{'extf'}.' '."\n".
                     70:               &Apache::lonlocal::mt('The specified directory "[_1]" is invalid.',$dir).
                     71:               '</span></body></html>');
1.9       albertel   72:     } else {
1.18      raeburn    73:         my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
                     74:         my $lonuserroot = $Apache::lonnet::perlvar{'lonUsersDir'};
1.19    ! bisitz     75:         if (($dir !~ /^\Q$londocroot\E/) && ($dir !~ /^\Q$lonuserroot\E/)) {
1.18      raeburn    76:             print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
                     77:                   &Apache::lonlocal::mt('The specified directory "[_1]" is invalid',$dir).
                     78:                   '</span></body></html>');
                     79:         } elsif (chdir($dir)) {
                     80:             if (-e $file) {
                     81:                 print(<<END);
                     82:         <html><body><p><b>$lt{'outo'}</b></p>
1.7       taceyjo1   83: END
1.18      raeburn    84:                 my @cmd;
                     85:                 if ($file =~ m|\.zip$|) {
                     86:                     @cmd = ($location_of{'unzip'},"-o");
                     87:                 } elsif ($file =~ m|\.tar\.gz$|
                     88: 	            || $file =~ m|\.tgz$| ) {
                     89:                     @cmd = ($location_of{'tar'},"-zxpvf");
                     90:                 } elsif ($file =~ m|\.tar\.bz2$|) {
                     91:                     @cmd = ($location_of{'tar'},"-jxpvf");
                     92:                 } elsif ($file =~ m|\.bz2$|) {
                     93:                     @cmd = ($location_of{'bunzip2'});
                     94:                 } elsif ($file =~ m|\.gz$|) {
                     95: 	            @cmd = ($location_of{'gunzip'});
                     96:                 } elsif ($file =~ m|\.tar$|) {
                     97:                     @cmd = ($location_of{'tar'},"-xpvf");
                     98:                 }
                     99: 	        if (@cmd) {
                    100: 	            undef($!);
                    101: 	            undef($@);
                    102: 	            open(OUTPUT,"-|", @cmd, $file);
                    103: 	            while (my $line = <OUTPUT>) { print("$line<br />"); }
                    104: 	            close(OUTPUT);
                    105: 	            print("<p><b>$lt{'comp'}</b></p>");
                    106: 	            if ($! || $@) {
                    107: 		        print('<p><span class="LC_error">'.$lt{'erro'}.'<br />'.$!."\n".
                    108:                               '<br />'.$@.'</span></p>');
                    109: 	            } else {
                    110:                         &Apache::lonnet::appenv({'cgi.decompressed' => 'ok'});
                    111:                     }
                    112:                 } else {
                    113:                     print('<span class="LC_error">'.
                    114:                           &Apache::lonlocal::mt('There has been an error in determining the file type of [_1], please check the name.',$file).'</span>');
                    115:                 }
                    116:                 print('</body></html>');
                    117:             } else {
                    118:                 print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
                    119:                       &Apache::lonlocal::mt('The specified file "[_1]" does not exist.',$file).
                    120:                       '</span></body></html>');
                    121:             }
1.9       albertel  122:         } else {
1.18      raeburn   123:             print('<html><body><span class="LC_error">'.$lt{'extf'}.'<br />'."\n".
                    124:                   &Apache::lonlocal::mt('Could not change working directory to "[_1]".',$dir).
                    125:                   '</span></body></html>');
1.7       taceyjo1  126:         }
                    127:     }
                    128: }
                    129: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>