mirror of
https://github.com/qpdf/qpdf.git
synced 2024-09-30 14:09:09 +00:00
02e89bbe47
Code failed to allow for QPDF::getCompressibleObjSet deleting objects from the object cache in case of multiple entries for the same object id. Add fuzz test case 68668.
74 lines
1.7 KiB
Perl
74 lines
1.7 KiB
Perl
#!/usr/bin/env perl
|
|
require 5.008;
|
|
use warnings;
|
|
use strict;
|
|
use Digest::SHA;
|
|
use File::Basename;
|
|
|
|
require TestDriver;
|
|
|
|
my $td = new TestDriver('fuzz');
|
|
|
|
my $qpdf_corpus = $ENV{'QPDF_FUZZ_CORPUS'} || die "must set QPDF_FUZZ_CORPUS";
|
|
|
|
my @fuzzers = (
|
|
['ascii85' => 1],
|
|
['dct' => 1],
|
|
['flate' => 1],
|
|
['hex' => 1],
|
|
['json' => 40],
|
|
['lzw' => 2],
|
|
['pngpredictor' => 1],
|
|
['runlength' => 6],
|
|
['tiffpredictor' => 2],
|
|
['qpdf' => 59], # increment when adding new files
|
|
);
|
|
|
|
my $n_tests = 0;
|
|
# One test for each directory for file count, two tests for each file
|
|
# in each directory
|
|
foreach my $d (@fuzzers)
|
|
{
|
|
$n_tests += 1 + (2 * $d->[1]);
|
|
}
|
|
|
|
foreach my $d (@fuzzers)
|
|
{
|
|
my $k = $d->[0];
|
|
my $dir = "../${k}_fuzzer_seed_corpus";
|
|
if (! -d $dir)
|
|
{
|
|
$dir = $qpdf_corpus;
|
|
}
|
|
my @files = glob("$dir/*");
|
|
$td->runtest("file count for $dir",
|
|
{$td->STRING => scalar(@files) . "\n"},
|
|
{$td->STRING => $d->[1] . "\n"},
|
|
$td->NORMALIZE_NEWLINES);
|
|
|
|
foreach my $f (@files)
|
|
{
|
|
my $sum = basename($f);
|
|
$td->runtest("$k checksum $sum",
|
|
{$td->STRING => get_sha1_checksum($f)},
|
|
{$td->STRING => $sum});
|
|
$td->runtest("$k fuzz check $sum",
|
|
{$td->COMMAND => "${k}_fuzzer $f"},
|
|
{$td->REGEXP => ".*$f successful\n",
|
|
$td->EXIT_STATUS => 0},
|
|
$td->NORMALIZE_NEWLINES);
|
|
}
|
|
}
|
|
|
|
$td->report($n_tests);
|
|
|
|
sub get_sha1_checksum
|
|
{
|
|
my $file = shift;
|
|
open(F, "<$file") or fatal("can't open $file: $!");
|
|
binmode F;
|
|
my $digest = Digest::SHA->new('sha1')->addfile(*F)->hexdigest;
|
|
close(F);
|
|
$digest;
|
|
}
|