[Please CC me on all replies]

So, I am writing some simple code to allow a user to upload his own
photo galleries.  The section of code giving me problems is this:

  my $scratch_dir = $gallery_dir . "/scratch";
  my $zipper = Archive::Zip->new();
  my $zip_stat = $zipper->read($destfile);
  if ($zip_stat == Archive::Zip::AZ_OK) {
    $zipper->extractTree('.', $scratch_dir);
    print "Extracted archive contents into target directory.</p>\n";
  } else {
    print "Unable to operate on the uploaded archive file.  Please fix the 
problem and upload again.</p>\n";
  }

When I call extractTree() in the manner shown above, I get the
"Extracted archive..." output, but nothing is actually extracted.  If I
change the call to extractTree() with no arguments, I get a 500 error
and this in my Apache log:

[Sun May 25 08:57:35 2008] [error] [asp] [11570] [error] error executing
code for include /var/www/templates/Photo_page_edit.tmpl: Insecure
dependency in open while running setgid at /usr/lib/perl/5.8/IO/File.pm
line 70. <--> ; compiled to SCALAR(0x91f6f24) at
/usr/share/perl5/Apache/ASP/Response.pm line 844. <--> ,
/usr/share/perl5/Apache/ASP.pm line 1521

If I try this, I also get the same taint error:

  my $scratch_dir = $gallery_dir . "/scratch";
  my $zipper = Archive::Zip->new();
  my $zip_stat = $zipper->read($destfile);
  if ($zip_stat == Archive::Zip::AZ_OK) {
    my @members = $zipper->memberNames();
    foreach my $fn (@members) {
      $fn =~ /(.*)/;
      $fn = $1;
      $zipper->extractMember($n);
    }
    print "Extracted archive contents into target directory.</p>\n";
  } else {
    print "Unable to operate on the uploaded archive file.  Please fix the 
problem and upload again.</p>\n";
  }

I have also tried adding in gratuitous untaintings, but to no avail.
Has anyone been able to make Archive::Zip work?  If so, how?  I am very
close to just using system() to call /usr/bin/unzip, but that is not
very portable.

Regards,

-Roberto

P.S. The server running this site is Debian Etch, so unfortunately, I
cannot use Archive::Extract which is included in Perl 5.10.0.

-- 
Roberto C. Sánchez
http://people.connexer.com/~roberto
http://www.connexer.com

Attachment: signature.asc
Description: Digital signature

Reply via email to