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

1.1       taceyjo1    1: #!/usr/bin/perl
                      2: #
1.18    ! raeburn     3: # $Id: decompress.pl,v 1.18 2012/01/15 23:15: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'};
        !            75:         if (($dir !~ /^\Qlondocroot\E/) && ($dir !~ /^\Q$lonuserroot\E/)) {
        !            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>