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

version 1.4, 2003/10/20 22:38:28 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;
  <html><body>NO COOKIE!</body></html>   <html><body>NO COOKIE!</body></html>
 END  END
 } else {  } else {my $username;
     $url = $ENV{'HTTP_REFERER'};      print "Content-type: text/html\n\n";
     $url =~ m|/{2}|;   print "<html><head></head><body>";
     $url = $'; #' stupid emacs   my $path = $ENV{'cgi.path'};
     $url =~ m|/{1}|;   $path =~ m|/{1}|;
     $referer = $`;   $path = $'; #' stupid emacs
     if($referer ne $ENV{'SERVER_NAME'}) {   $path =~ m|/{1}|;
  print "Content-type: text/html\n\n";   $path = $';
  print "<html><body>You are trying something that is not allowed, go to the real homeserver and try again</body></html>";   my (@right) = split(/\./,$ENV{'request.role'});
     } else {   my $role = shift(@right);
  $url = $'; #' stupid emacs   my $temp = shift(@right);
  $url =~ m|$ENV{'user.name'}/{1}|;   my (@left) = split(/\/+/,$temp);;
  $url = $'; #' stupid emacs   shift(@left);
  $url =~ m|\?{1}|;   shift(@left);
  $url = $`;   $temp = shift(@left);
  $path ="/home/$ENV{'user.name'}/public_html/";   print "temp: $temp";
  $back_path = "";   my $path2 = "/home/$username/public_html/";
  while($url =~ m|/|) {   $path2 .=$path;
     $path .= $`;   my $back_path = "";
     $back_path .= $`;   while($path =~ m|/|) {
     $path .= "/";      $back_path .= $`;
     $back_path .= "/";      $back_path .= "/";
     $url = $'; #' stupid emacs      $path = $'; #' stupid emacs
  }   }
  chdir $path;   $path .= '/';
  $filename=$url;   $path .= $back_path;
  if      ($url =~ m|zip|) {   print "<br>path: $path<br>";
     system "unzip -qq $filename &> /dev/null";   print "back_path: $back_path <br>";
  } elsif ($url =~ m|tar.gz|) {   print "path2: $path2 <br>";
     system "tar -zxpvf $filename &> /dev/null";   print "$path2<br>";
  } elsif ($url =~ m|tar.bz2|){   if ( -r $path2){
     system "tar -jxpvf $filename &> /dev/null";   print "Good read access is allowed";
  } elsif ($url =~ m|bz2|){   print "<br><br>";
     system "bunzip2 $filename &> /dev/null";   print "<br><br>right: $role";
  } elsif ($url =~ m|tgz|){   my $filename = $ENV{'cgi.file'};
     system "tar -zxpvf $filename &> /dev/null";   if($role eq "ca" || $role eq "au") {
  } elsif ($url =~ m|gz|){   chdir $path;
     system "gunzip $filename &> /dev/null";   if      ($filename =~ m|zip|) {
  } elsif ($url =~ m|tar|){      system "unzip -qq $path2 &> /dev/null";
     system "tar -xpvf $filename &> /dev/null";   } elsif ($filename =~ m|tar.gz|) {
       system "tar -zxpvf $path2 &> /dev/null";
    } elsif ($filename =~ m|tar.bz2|){
      system "tar -jxpvf $path2 &> /dev/null";
    } elsif ($filename =~ m|bz2|){
       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 '<html><head>';  
 print '<meta http-equiv="refresh" content="0; URL=';  
 print "http://$ENV{'SERVER_NAME'}/~$ENV{'user.name'}/$back_path"; print '" />';  
 print '</head></html>';  

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


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