fuzz/fuzz.pl

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