test/fuzzzip

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2010 Morten Welinder.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, see <https://www.gnu.org/licenses/>.
  17
  18 use strict;
  19 use Getopt::Long;
  20 use File::Temp ();
  21 use File::Find ();
  22 use File::Copy ();
  23 use File::Spec;
  24
  25 my $me = $0;
  26 $me =~ s{^.*/}{};
  27
  28 # -----------------------------------------------------------------------------
  29
  30 my @subfile;
  31 my $subfuzzer = 'fuzzxml %i %o';
  32 my $verbose = 0;
  33
  34 Getopt::Long::Configure ("bundling");
  35 &GetOptions ("subfile=s" => \@subfile,
  36              "subfuzzer=s" => \$subfuzzer,
  37              "v|verbose" => \$verbose,
  38     ) or die;
  39
  40 my $infile = shift @ARGV;
  41 my $outfile = shift @ARGV;
  42 die "$me: usage [options] infile outfile\n" unless defined $outfile;
  43
  44 $outfile = File::Spec->rel2abs ($outfile);
  45
  46 die "$me: one or more subfiles should be specified with --subfile\n"
  47     unless @subfile;
  48
  49 my @quiet = $verbose ? () : ("-q");
  50
  51 # -----------------------------------------------------------------------------
  52
  53 my $tmpdir = File::Temp::tempdir ("fuzzzip.XXXXXX",
  54                                   TMPDIR => 1,
  55                                   CLEANUP => 1);
  56
  57 {
  58     my @cmd = ("unzip", @quiet, $infile, "-d", $tmpdir);
  59     print STDERR "@cmd\n" if $verbose;
  60     my $res = system (@cmd);
  61     die "$me: unzipping failed.\n" unless $res == 0;
  62 }
  63
  64 # -----------------------------------------------------------------------------
  65
  66 foreach my $file (@subfile) {
  67     die "Archive has no $file" unless -f "$tmpdir/$file";
  68
  69     my $tmpfile = "$file.tmp";
  70
  71     my $cmd = $subfuzzer;
  72     $cmd =~ s{\%i}{$tmpdir/$file};
  73     $cmd =~ s{\%o}{$tmpdir/$tmpfile};
  74
  75     print STDERR "$cmd\n" if $verbose;
  76     my $res = system ($cmd);
  77     die "$me: fuzzing failed.\n" unless $res == 0;
  78
  79     # system ("diff -uw $tmpdir/$tmpfile $tmpdir/$file");
  80
  81     rename "$tmpdir/$tmpfile", "$tmpdir/$file" or
  82         die "$me: cannot renamed $tmpfile into place: $!\n";
  83 }
  84
  85 # -----------------------------------------------------------------------------
  86
  87 print STDERR "chdir $tmpdir\n" if $verbose;
  88 chdir $tmpdir || die "$me: cannot chdir to $tmpdir: $!\n";
  89
  90 my @stored_files;
  91 my @files;
  92 File::Find::find (
  93     sub {
  94         if (-f $_) {
  95             my $name = $File::Find::name;
  96             $name =~ s{^\./}{};
  97             if ($name eq 'mimetype') {
  98                 push @stored_files, $name;
  99             } else {
 100                 push @files, $name;
 101             }
 102         }
 103         return 1;
 104     },
 105     ".");
 106
 107 {
 108     my $archive = "foo.zip";
 109
 110     if (@stored_files) {
 111         my @cmd = ("zip", @quiet, $archive, "-0", @stored_files);
 112         print STDERR "@cmd\n" if $verbose;
 113         my $res = system (@cmd);
 114         die "$me: zipping failed.\n" unless $res == 0;
 115     }
 116
 117     if (@files) {
 118         my @cmd = ("zip", @quiet, $archive, "-9", @files);
 119         print STDERR "@cmd\n" if $verbose;
 120         my $res = system (@cmd);
 121         die "$me: zipping failed.\n" unless $res == 0;
 122     }
 123
 124     &File::Copy::move ($archive, $outfile);
 125 }
 126
 127 # Some versions need this for tmpdir cleanup.
 128 chdir "/" or chdir $ENV{'HOME'};
 129
 130 # -----------------------------------------------------------------------------