lib/CXGN/ZipFile.pm

   1
   2 package CXGN::ZipFile;
   3
   4 use Moose;
   5 use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
   6 use SGN::Model::Cvterm;
   7 use Data::Dumper;
   8 use File::Spec::Functions qw(splitpath);
   9 use IO::File;
  10 use IO::Uncompress::Unzip qw($UnzipError);
  11 use File::Path qw(mkpath);
  12
  13 has 'archived_zipfile_path' => (
  14     isa => 'Str',
  15     is => 'rw',
  16     required => 1,
  17 );
  18
  19 has 'extract_directory' => (
  20     isa => 'Str',
  21     is => 'rw',
  22 );
  23
  24 has 'archived_zip' => (
  25     isa => 'Archive::Zip::Archive',
  26     is => 'rw',
  27 );
  28
  29
  30 my $archived_zip = Archive::Zip->new();
  31
  32 sub BUILD {
  33     my $self = shift;
  34 }
  35
  36
  37 #Assuming that zipfile is a flat list of files.
  38 sub file_names {
  39     my $self = shift;
  40     unless ( $archived_zip->read( $self->archived_zipfile_path() ) == AZ_OK ) {
  41         print STDERR "cannot read given zipfile\n";
  42         return;
  43     }
  44     $self->archived_zip(Archive::Zip->new($self->archived_zipfile_path()));
  45     if (!$self->archived_zip){
  46         return;
  47     }
  48     my @file_names = $self->archived_zip()->memberNames();
  49     my @file_names_stripped;
  50     my @file_names_full;
  51     foreach (@file_names) {
  52         my @zip_names_split = split(/\//, $_);
  53         if ($zip_names_split[1]) {
  54             if ($zip_names_split[1] ne '.DS_Store' && $zip_names_split[1] ne '.fieldbook' && $zip_names_split[1] ne '.thumbnails') {
  55                 my @zip_names_split_ext = split(/\./, $zip_names_split[1]);
  56                 push @file_names_stripped, $zip_names_split_ext[0];
  57                 push @file_names_full, $zip_names_split[1];
  58             }
  59         }
  60     }
  61     return (\@file_names_stripped, \@file_names_full);
  62 }
  63
  64 sub file_members {
  65     my $self = shift;
  66     unless ( $archived_zip->read( $self->archived_zipfile_path() ) == AZ_OK ) {
  67         print STDERR "cannot read given zipfile\n";
  68         return;
  69     }
  70     $self->archived_zip(Archive::Zip->new($self->archived_zipfile_path()));
  71     my @ret_members;
  72     if (!$self->archived_zip){
  73         return;
  74     }
  75     my @file_members = $self->archived_zip()->members();
  76     #print STDERR Dumper \@file_members;
  77     my %seen_files;
  78     foreach (@file_members) {
  79         if (exists($seen_files{$_->{'fileName'}}) || $_->{'compressedSize'} == 0 || index($_->{'fileName'}, '.DS_Store') != -1 || index($_->{'fileName'}, '.fieldbook') != -1 || index($_->{'fileName'}, '.thumbnails') != -1 || index($_->{'fileName'}, '__MACOSX') != -1) {
  80             next;
  81         } else {
  82             $seen_files{$_->{'fileName'}} = 1;
  83             push @ret_members, $_;
  84         }
  85     }
  86     return \@ret_members;
  87 }
  88
  89 #warning: will copy files out of zipfile and file will lose metadata such as EXIF image data. Use something like SGN::Image::upload_drone_imagery_zipfile if metadata needed.
  90 sub extract_files_into_tempdir {
  91     my $self = shift;
  92     my $dest = $self->extract_directory();
  93     my $file = $self->archived_zipfile_path();
  94
  95     my $u = IO::Uncompress::Unzip->new($file)
  96         or die "Cannot open $file: $UnzipError";
  97
  98     my $status;
  99     my @image_files;
 100     for ($status = 1; $status > 0; $status = $u->nextStream()) {
 101         my $header = $u->getHeaderInfo();
 102         my (undef, $path, $name) = splitpath($header->{Name});
 103         my $destdir = "$dest/$path";
 104
 105         unless (-d $destdir) {
 106             mkpath($destdir) or die "Couldn't mkdir $destdir: $!";
 107         }
 108
 109         if ($name =~ m!/$!) {
 110             last if $status < 0;
 111             next;
 112         }
 113
 114         my $destfile = "$dest/$path/$name";
 115         # https://cwe.mitre.org/data/definitions/37.html
 116         # CWE-37: Path Traversal
 117         die "unsafe $destfile" if $destfile =~ m!\Q..\E(/|\\)!;
 118
 119         my $buff;
 120         my $fh = IO::File->new($destfile, "w")
 121             or die "Couldn't write to $destfile: $!";
 122         while (($status = $u->read($buff)) > 0) {
 123             $fh->write($buff);
 124         }
 125         $fh->close();
 126         push @image_files, $destfile;
 127         my $stored_time = $header->{'Time'};
 128         utime ($stored_time, $stored_time, $destfile)
 129             or die "Couldn't touch $destfile: $!";
 130     }
 131
 132     die "Error processing $file: $!\n"
 133         if $status < 0 ;
 134
 135     return \@image_files;
 136 }
 137
 138 1;