mirror of
https://github.com/qpdf/qpdf.git
synced 2024-11-16 01:27:07 +00:00
ef127001b3
There isn't really an issue with these files causing a real problem, but malware and virus checkers trip on them, and the value to leaving them in the test suite is too low to be worth the hassle.
80 lines
1.9 KiB
Perl
80 lines
1.9 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_n_test_files = 30;
|
|
my @extra = glob("../qpdf_extra/*.fuzz");
|
|
my $qpdf_n_extra_files = scalar(@extra);
|
|
my $qpdf_n_orig_files = 2557;
|
|
my $qpdf_n_files = ($qpdf_n_test_files +
|
|
$qpdf_n_extra_files +
|
|
$qpdf_n_orig_files);
|
|
|
|
|
|
my @fuzzers = (
|
|
['ascii85' => 1],
|
|
['dct' => 1],
|
|
['flate' => 1],
|
|
['hex' => 1],
|
|
['lzw' => 2],
|
|
['pngpredictor' => 1],
|
|
['runlength' => 6],
|
|
['tiffpredictor' => 1],
|
|
['qpdf' => $qpdf_n_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 = "../build/${k}_fuzzer_seed_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;
|
|
}
|