Diff for /loncom/cgi/decompress.pl between versions 1.1 and 1.6

version 1.1, 2003/10/18 17:16:22 version 1.6, 2003/11/18 04:07:49
Line 2 Line 2
 #  #
 #   # 
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
   #  
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  #
Line 28 Line 29
 # A CGI script that decompresses compressed files for mass uploading into  # A CGI script that decompresses compressed files for mass uploading into
 # construction space  # construction space
 ####  ####
   
   #Things still todo, 
   #It has been tabinated
   #Now uses strict! with added feature of making everything very strict!
   #about 50% through rewriting things to use split and join
   #still have a lot of debugging statements that will go away after I get it to work ok(along with all the <br>'s)
   #still have to rewrite the refresh tag to work right, its broken
   #the whole thing is broken right now
   #will rename the variables and reorder most of the script to make it more sane
   #improve the general readability of the whole thing, because unlike C everyone gets to look at it, so it has to be readable
   #will get to it tommorrow night as I have a calc test to "pass" yea, or something like that :0)
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::loncgi();  use LONCAPA::loncgi();
   use Apache::lonnet;
   use strict; 
   
 if(! &LONCAPA::loncgi::check_cookie_and_load_env()){  if(! &LONCAPA::loncgi::check_cookie_and_load_env()){
  print "Content-type: text/html\n\n";      print "Content-type: text/html\n\n";
  print <<END;      print <<END;
  NO COOKIE!   <html><body>NO COOKIE!</body></html>
 END  END
 }  } else {my $username;
 else      print "Content-type: text/html\n\n";
 {   print "<html><head></head><body>";
  $url = $ENV{'HTTP_REFERER'};   my $path = $ENV{'cgi.path'};
  $url =~ m|/{2}|;   $path =~ m|/{1}|;
  $url = $';   $path = $'; #' stupid emacs
  $url =~ m|/{1}|;   $path =~ m|/{1}|;
  $referer = $`;   $path = $';
  if($referer ne $ENV{'SERVER_NAME'})   my (@right) = split(/\./,$ENV{'request.role'});
  { print "Content-type: text/html\n\n";   my $role = shift(@right);
  print "You are trying something that is not allowed, go to the real homeserver and try again";   my $temp = shift(@right);
    my (@left) = split(/\/+/,$temp);;
    shift(@left);
    shift(@left);
    $temp = shift(@left);
    print "temp: $temp";
    my $path2 = "/home/$username/public_html/";
    $path2 .=$path;
    my $back_path = "";
    while($path =~ m|/|) {
       $back_path .= $`;
       $back_path .= "/";
       $path = $'; #' stupid emacs
  }   }
  else   $path .= '/';
  {   $path .= $back_path;
  $url = $';   print "<br>path: $path<br>";
  $url =~ m|$ENV{'user.name'}/{1}|;   print "back_path: $back_path <br>";
  $url = $';   print "path2: $path2 <br>";
  $url =~ m|\?{1}|;   print "$path2<br>";
  $url = $`;   if ( -r $path2){
  $path ="/home/$ENV{'user.name'}/public_html/";   print "Good read access is allowed";
  $back_path = "";   print "<br><br>";
  while($url =~ m|/|)   print "<br><br>right: $role";
  {   my $filename = $ENV{'cgi.file'};
  $path .= $`;   if($role eq "ca" || $role eq "au") {
  $back_path .= $`;  
  $path .= "/";  
  $back_path .= "/";  
  $url = $';  
  }  
  chdir $path;   chdir $path;
  $filename=$url;   if      ($filename =~ m|zip|) {
  if($url =~ m|zip|){system "unzip -qq $filename &> /dev/null";}      system "unzip -qq $path2 &> /dev/null";
  elsif($url =~ m|tar.gz|){system "tar -zxpvf $filename &> /dev/null";}   } elsif ($filename =~ m|tar.gz|) {
  elsif($url =~ m|tar.bz2|){system "tar -jxpvf $filename &> /dev/null";}      system "tar -zxpvf $path2 &> /dev/null";
  elsif($url =~ m|bz2|){system "bunzip2 $filename &> /dev/null";}   } elsif ($filename =~ m|tar.bz2|){
  elsif($url =~ m|tgz|){system "tar -zxpvf $filename &> /dev/null";}     system "tar -jxpvf $path2 &> /dev/null";
  elsif($url =~ m|gz|){system "gunzip $filename &> /dev/null";}   } elsif ($filename =~ m|bz2|){
  elsif($url =~ m|tar|){system "tar -xpvf $filename &> /dev/null";}      system "bunzip2 $path2 &> /dev/null";
    } elsif ($filename =~ m|tgz|){
       system "tar -zxpvf $path2 &> /dev/null";
    } elsif ($filename =~ m|gz|){
       system "gunzip $path2 &> /dev/null";
    } elsif ($filename =~ m|tar|){
       system "tar -xpvf $path2 &> /dev/null";
    }
    } 
    else {print "You don't have proper privledges";}
  }   }
    else { print "Read access not allowed!"; }
    #print '<meta http-equiv="refresh" content="0; URL=';
    #print "http://$ENV{'SERVER_NAME'}/~$username'}/$back_path"; print '" />';
    print '</body></html>';
    &Apache::lonnet::delenv('cgi.file');
    &Apache::lonnet::delenv('cgi.path');
 }  }
 print "Content-type: text/html\n\n";  
 print '<META http-equiv="refresh" content="0; URL=';  
 print "http://$ENV{'SERVER_NAME'}/priv/$ENV{'user.name'}/$back_path"; print '" target=_top>';  

Removed from v.1.1  
changed lines
  Added in v.1.6


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