test/zzufit

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Getopt::Long;
   5 use IO::File;
   6
   7 # We don't actually need these, but fuzzxml does.
   8 use XML::Parser;
   9 use XML::Writer;
  10
  11 my @corpus;
  12 my %file_type;
  13
  14 my $n = 0;
  15 my $rate = 0.0001;
  16 my $LOG = "zzufit.log";
  17 my $DIR = "zzufit.tmp";
  18 my $valgrind = 0;
  19
  20 &GetOptions ("rate=f" => \$rate,
  21              "seed=i" => \$n,
  22              'valgrind' => \$valgrind,
  23              )
  24     or die &usage (1);
  25
  26 die &usage (1) unless @ARGV;
  27 @corpus = @ARGV;
  28
  29 if (!-d $DIR) {
  30     mkdir ($DIR, 0777) or die "$0: Cannot create $DIR: $!\n";
  31 }
  32
  33 while (1) {
  34     $n++;
  35     print STDERR "Test $n\n";
  36     &append_log ("-------------------------------------------------------\n");
  37
  38     my $file = $corpus[$n % @corpus];
  39     my $type = &determine_file_type ($file);
  40     die "$0: unable to determine type of $file\n" unless defined $type;
  41
  42     my ($filepath,$filebase,$fileext) =
  43         ($file =~ m:^(|.*/)([^/]+)(\.[^./]+)$:);
  44     if (!defined $filepath) {
  45         ($filepath,$filebase) = ($file =~ m:^(|.*/)([^/]+)$:);
  46         $fileext = "";
  47     }
  48
  49     my $zzuffile = "$DIR/${filebase}-${n}${fileext}";
  50     my $fuzzcmd;
  51
  52     if ($type eq 'xml') {
  53         $fuzzcmd = "./fuzzxml -s$n -r$rate '$file' '$zzuffile'";
  54     } elsif ($type eq 'xml.gz') {
  55         $fuzzcmd = "gzip -dc '$file' | ./fuzzxml -s$n -r$rate - '$zzuffile'";
  56     } elsif ($type eq 'raw') {
  57         $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     } elsif ($type eq 'xlsx') {
  61         $fuzzcmd = "./fuzzzip --subfuzzer='./fuzzxml -s$n -r$rate %i %o' --subfile xl/styles.xml --subfile xl/worksheets/sheet1.xml '$file' '$zzuffile'";
  62     } else {
  63         die "$0: Internal error.\n";
  64     }
  65
  66     &append_log ("Fuzz command $fuzzcmd\n");
  67     {
  68         system ($fuzzcmd);
  69         my $code = $?;
  70         my $sig = $code & 0x7f;
  71         last if $sig == 2;
  72     }
  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     my $code = $?;
  83     my $sig = $code & 0x7f;
  84     if ($sig) {
  85         if ($code & 0x80) {
  86             &append_log ("CORE\n");
  87             print STDERR "CORE\n";
  88         }
  89         last if $sig == 2;
  90         $keepfiles = 1;
  91     } else {
  92         $code >>= 8;
  93         my $txt = "Exit code $code\n";
  94         &append_log ($txt);
  95         if ($code >= 2) {
  96             print STDERR $txt;
  97             $keepfiles = 1;
  98         }
  99     }
 100
 101     my $log_fh = new IO::File ($logfile, "r")
 102         or die "$0: cannot read $logfile: $!\n";
 103     my $prev = '';
 104     while (<$log_fh>) {
 105         my $prevline = $prev;
 106         $prev = $_;
 107
 108         if (/^==\d+==\s+definitely lost: (\d+) bytes in \d+ blocks/ && $1 > 0) {
 109             print;
 110             $keepfiles = 1;
 111             next;
 112         }
 113         if (/\bat 0x/) {
 114             print $prevline;
 115             $keepfiles = 1;
 116             next;
 117         }
 118
 119         if (/CRITICAL/) {
 120             print;
 121             $keepfiles = 1;
 122             next;
 123         }
 124     }
 125     undef $log_fh;
 126     if (!$keepfiles) {
 127         unlink $logfile, $zzuffile, $outfile;
 128     }
 129 }
 130
 131 sub append_log {
 132     my ($txt) = @_;
 133
 134     local (*FIL);
 135     open (FIL, ">>$LOG") or die "$0: Cannot append to $LOG: $!\n";
 136     print FIL $txt;
 137     close (FIL);
 138 }
 139
 140 sub usage {
 141     my ($res) = @_;
 142
 143     print STDERR "$0 [options]\n\n";
 144     print STDERR "  --rate=frac      Fraction of bits to flip.\n";
 145     print STDERR "  --seed=int       Initial seed.\n";
 146     print STDERR "  --valgrind       Run under Valgrind.\n";
 147
 148     exit ($res);
 149 }
 150
 151 sub determine_file_type {
 152     my ($file) = @_;
 153
 154     return $file_type{$file} if exists $file_type{$file};
 155
 156     return undef unless -r $file && -f _;
 157
 158     if ($file =~ /\.(xls|wb[23])$/) {
 159         return $file_type{$file} = 'raw';
 160     }
 161
 162     if ($file =~ /\.ods$/) {
 163         return $file_type{$file} = 'ods';
 164     }
 165
 166     if ($file =~ /\.xlsx$/) {
 167         return $file_type{$file} = 'xlsx';
 168     }
 169
 170     if ($file =~ /\.xml$/) {
 171         return $file_type{$file} = 'xml';
 172     }
 173
 174     if ($file =~ /\.gnumeric$/) {
 175         my $f = new IO::File ($file, "r");
 176         my $data;
 177         my $nread = read $f,$data,10;
 178         return undef unless $nread == 10;
 179
 180         if ($data =~ /^<\?xml/) {
 181             return $file_type{$file} = 'xml';
 182         }
 183
 184         if (ord (substr ($data, 0, 1)) == 0x1f &&
 185             ord (substr ($data, 1, 1)) == 0x8b) {
 186             return $file_type{$file} = 'xml.gz';
 187         }
 188     }
 189
 190     return $file_type{$file} = undef;
 191 }