zzufit 4.23 KB
Newer Older
1 2 3 4
#!/usr/bin/perl -w

use strict;
use Getopt::Long;
5 6 7 8 9 10 11 12
use IO::File;

# We don't actually need these, but fuzzxml does.
use XML::Parser;
use XML::Writer;

my @corpus;
my %file_type;
13 14

my $n = 0;
15
my $rate = 0.0001;
16 17
my $LOG = "zzufit.log";
my $DIR = "zzufit.tmp";
18
my $valgrind = 0;
19 20 21

&GetOptions ("rate=f" => \$rate,
	     "seed=i" => \$n,
22
	     'valgrind' => \$valgrind,
23 24 25
	     )
    or die &usage (1);

26 27 28
die &usage (1) unless @ARGV;
@corpus = @ARGV;

29 30 31 32 33 34 35 36 37
if (!-d $DIR) {
    mkdir ($DIR, 0777) or die "$0: Cannot create $DIR: $!\n";
}

while (1) {
    $n++;
    print STDERR "Test $n\n";
    &append_log ("-------------------------------------------------------\n");

38 39 40 41
    my $file = $corpus[$n % @corpus];
    my $type = &determine_file_type ($file);
    die "$0: unable to determine type of $file\n" unless defined $type;

42 43 44 45 46 47 48 49
    my ($filepath,$filebase,$fileext) =
	($file =~ m:^(|.*/)([^/]+)(\.[^./]+)$:);
    if (!defined $filepath) {
	($filepath,$filebase) = ($file =~ m:^(|.*/)([^/]+)$:);
	$fileext = "";
    }

    my $zzuffile = "$DIR/${filebase}-${n}${fileext}";
50 51 52 53 54 55 56 57
    my $fuzzcmd;

    if ($type eq 'xml') {
	$fuzzcmd = "./fuzzxml -s$n -r$rate '$file' '$zzuffile'";
    } elsif ($type eq 'xml.gz') {
	$fuzzcmd = "gzip -dc '$file' | ./fuzzxml -s$n -r$rate - '$zzuffile'";
    } elsif ($type eq 'raw') {
	$fuzzcmd = "zzuf -s$n -r$rate <'$file' >'$zzuffile'";
58
    } elsif ($type eq 'ods') {
59
	$fuzzcmd = "./fuzzzip --subfuzzer='./fuzzxml -s$n -r$rate %i %o' --subfile content.xml --subfile styles.xml '$file' '$zzuffile'";
60 61
    } elsif ($type eq 'xlsx') {
	$fuzzcmd = "./fuzzzip --subfuzzer='./fuzzxml -s$n -r$rate %i %o' --subfile xl/styles.xml --subfile xl/worksheets/sheet1.xml '$file' '$zzuffile'";
62 63 64 65
    } else {
	die "$0: Internal error.\n";
    }

66
    &append_log ("Fuzz command $fuzzcmd\n");
67 68 69 70 71 72
    {
	system ($fuzzcmd);
	my $code = $?;
	my $sig = $code & 0x7f;
	last if $sig == 2;
    }
73 74

    my $outfile = "$DIR/${filebase}-${n}.gnumeric";
75
    my $logfile = "$DIR/${filebase}-${n}.log";
76
    my $keepfiles = 0;
77
    my $cmd = "../src/ssconvert '$zzuffile' '$outfile' 2>&1 | tee '$logfile' >>'$LOG'";
78
    if ($valgrind) {
79
	$cmd = "../tools/gnmvalgrind --leak-check=full $cmd";
80 81
    }
    system ($cmd);
82 83 84 85 86 87 88 89
    my $code = $?;
    my $sig = $code & 0x7f;
    if ($sig) {
	if ($code & 0x80) {
	    &append_log ("CORE\n");
	    print STDERR "CORE\n";
	}
	last if $sig == 2;
90
	$keepfiles = 1;
91 92 93 94 95 96
    } else {
	$code >>= 8;
	my $txt = "Exit code $code\n";
	&append_log ($txt);
	if ($code >= 2) {
	    print STDERR $txt;
97
	    $keepfiles = 1;
98 99
	}
    }
100

101 102
    my $log_fh = new IO::File ($logfile, "r")
	or die "$0: cannot read $logfile: $!\n";
103
    my $prev = '';
104
    while (<$log_fh>) {
105 106 107
	my $prevline = $prev;
	$prev = $_;

108 109
	if (/^==\d+==\s+definitely lost: (\d+) bytes in \d+ blocks/ && $1 > 0) {
	    print;
110
	    $keepfiles = 1;
111 112
	    next;
	}
113 114 115
	if (/\bat 0x/) {
	    print $prevline;
	    $keepfiles = 1;
116 117 118 119 120
	    next;
	}

	if (/CRITICAL/) {
	    print;
121
	    $keepfiles = 1;
122 123 124
	    next;
	}
    }
125
    undef $log_fh;
126 127 128
    if (!$keepfiles) {
	unlink $logfile, $zzuffile, $outfile;
    }
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
}

sub append_log {
    my ($txt) = @_;
    
    local (*FIL);
    open (FIL, ">>$LOG") or die "$0: Cannot append to $LOG: $!\n";
    print FIL $txt;
    close (FIL);
}

sub usage {
    my ($res) = @_;

    print STDERR "$0 [options]\n\n";
    print STDERR "  --rate=frac      Fraction of bits to flip.\n";
    print STDERR "  --seed=int       Initial seed.\n";
146
    print STDERR "  --valgrind       Run under Valgrind.\n";
147 148 149

    exit ($res);
}
150 151 152 153 154 155 156 157

sub determine_file_type {
    my ($file) = @_;

    return $file_type{$file} if exists $file_type{$file};

    return undef unless -r $file && -f _;

158
    if ($file =~ /\.(xls|wb[23])$/) {
159 160 161 162
	return $file_type{$file} = 'raw';
    }

    if ($file =~ /\.ods$/) {
163 164 165 166 167
	return $file_type{$file} = 'ods';
    }

    if ($file =~ /\.xlsx$/) {
	return $file_type{$file} = 'xlsx';
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
    }

    if ($file =~ /\.xml$/) {
	return $file_type{$file} = 'xml';
    }

    if ($file =~ /\.gnumeric$/) {
	my $f = new IO::File ($file, "r");
	my $data;
	my $nread = read $f,$data,10;
	return undef unless $nread == 10;

	if ($data =~ /^<\?xml/) {
	    return $file_type{$file} = 'xml';
	}

	if (ord (substr ($data, 0, 1)) == 0x1f &&
	    ord (substr ($data, 1, 1)) == 0x8b) {
	    return $file_type{$file} = 'xml.gz';
	}
    }

    return $file_type{$file} = undef;
}