File:  [LON-CAPA] / loncom / cgi / decompress.pl
Revision 1.4: download - view: text, annotated - select for diffs
Mon Oct 20 22:38:28 2003 UTC (20 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- missing semicolon, Bad Guy! No cookie!

    1: #!/usr/bin/perl
    2: #
    3: # 
    4: # Copyright Michigan State University Board of Trustees
    5: #
    6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    7: #
    8: # LON-CAPA is free software; you can redistribute it and/or modify
    9: # it under the terms of the GNU General Public License as published by
   10: # the Free Software Foundation; either version 2 of the License, or
   11: # (at your option) any later version.
   12: #
   13: # LON-CAPA is distributed in the hope that it will be useful,
   14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16: # GNU General Public License for more details.
   17: #
   18: # You should have received a copy of the GNU General Public License
   19: # along with LON-CAPA; if not, write to the Free Software
   20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21: #
   22: # /home/httpd/cgi-bin/decompress.pl
   23: #
   24: # http://www.lon-capa.org/
   25: #
   26: # The LearningOnline Network with CAPA
   27: #
   28: # A CGI script that decompresses compressed files for mass uploading into
   29: # construction space
   30: ####
   31: use lib '/home/httpd/lib/perl';
   32: use LONCAPA::Configuration;
   33: use LONCAPA::loncgi();
   34: 
   35: if(! &LONCAPA::loncgi::check_cookie_and_load_env()){
   36:     print "Content-type: text/html\n\n";
   37:     print <<END;
   38: 	 <html><body>NO COOKIE!</body></html>
   39: END
   40: } else {
   41:     $url = $ENV{'HTTP_REFERER'};
   42:     $url =~ m|/{2}|;
   43:     $url = $'; #' stupid emacs
   44:     $url =~ m|/{1}|;
   45:     $referer = $`;
   46:     if($referer ne $ENV{'SERVER_NAME'}) {
   47: 	print "Content-type: text/html\n\n";
   48: 	print "<html><body>You are trying something that is not allowed, go to the real homeserver and try again</body></html>";
   49:     } else {
   50: 	$url = $'; #' stupid emacs	
   51: 	$url =~ m|$ENV{'user.name'}/{1}|;
   52: 	$url = $'; #' stupid emacs
   53: 	$url =~ m|\?{1}|;
   54: 	$url = $`;
   55: 	$path ="/home/$ENV{'user.name'}/public_html/";
   56: 	$back_path = "";
   57: 	while($url =~ m|/|) {
   58: 	    $path .= $`;
   59: 	    $back_path .= $`;
   60: 	    $path .= "/";
   61: 	    $back_path .= "/";
   62: 	    $url = $'; #' stupid emacs
   63: 	}
   64: 	chdir $path;
   65: 	$filename=$url;
   66: 	if      ($url =~ m|zip|) {
   67: 	    system "unzip -qq $filename &> /dev/null";
   68: 	} elsif ($url =~ m|tar.gz|) {
   69: 	    system "tar -zxpvf $filename &> /dev/null";
   70: 	} elsif ($url =~ m|tar.bz2|){
   71: 	    system "tar -jxpvf $filename &> /dev/null";
   72: 	} elsif ($url =~ m|bz2|){
   73: 	    system "bunzip2 $filename &> /dev/null";
   74: 	} elsif ($url =~ m|tgz|){
   75: 	    system "tar -zxpvf $filename &> /dev/null";
   76: 	} elsif ($url =~ m|gz|){
   77: 	    system "gunzip $filename &> /dev/null";
   78: 	} elsif ($url =~ m|tar|){
   79: 	    system "tar -xpvf $filename &> /dev/null";
   80: 	}
   81:     }
   82: }
   83: print "Content-type: text/html\n\n";
   84: print '<html><head>';
   85: print '<meta http-equiv="refresh" content="0; URL=';
   86: print "http://$ENV{'SERVER_NAME'}/~$ENV{'user.name'}/$back_path"; print '" />';
   87: print '</head></html>';

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