fuzz/fuzz.pl

   1 #!perl -w
   2 use blib;
   3 use strict;
   4 use Imager;
   5 use Getopt::Long;
   6 use Time::HiRes qw(time);
   7
   8 my $count = 1000;
   9 GetOptions("c=i"=>\$count)
  10   or usage();
  11
  12 my @files = @ARGV;
  13 unless (@files) {
  14   @files = glob('testimg/*.gif'), glob('testout/*');
  15 }
  16
  17 @files = grep -f, @files;
  18 Imager->set_file_limits(bytes => 20_000_000);
  19 ++$|;
  20 for my $i (1 .. $count) {
  21   my $filename = $files[rand @files];
  22   open FILE, "< $filename" or die "Cannot read $filename: $!\n";
  23   binmode FILE;
  24   my $data = do { local $/; <FILE> };
  25   close FILE;
  26
  27   print ">> $filename - length ", length $data, "\n";
  28   if (rand() < 0.2) {
  29     # random truncation
  30     my $new_length = int(1 + rand(length($data)-2));
  31     substr($data, $new_length) = '';
  32     print "  trunc($new_length)\n";
  33   }
  34   # random damage
  35   for (0..int(rand 5)) {
  36     my $offset = int(rand(length($data)));
  37     my $len = int(1+rand(5));
  38     if ($offset + $len > length $data) {
  39       $len = length($data) - $offset;
  40     }
  41     my $ins = join '', map chr(rand(256)), 1..$len;
  42     print "  replace $offset/$len: ", unpack("H*", $ins), "\n";
  43     substr($data, $offset, $len, $ins);
  44   }
  45   my $start = time;
  46   my $im = Imager->new;
  47   my $result = $im->read(data => $data);
  48   my $dur = time() - $start;
  49   if ($dur > 1.0) {
  50     print "***Took too long to load\n";
  51   }
  52   printf "   Took %f seconds\n", time() - $start;
  53   if ($result) {
  54     print "<< Success\n";
  55   }
  56   else {
  57     print "<< Failure: ", $im->errstr, "\n";
  58   }
  59 }
  60
  61 sub usage {
  62   print <<EOS;
  63 perl $0 [-c count] [files]
  64 EOS
  65   exit;
  66 }