t/lib/compress/truncate.pl

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use CompTestUtils;
   9
  10 sub run
  11 {
  12     my $CompressClass   = identify();
  13     my $UncompressClass = getInverse($CompressClass);
  14     my $Error           = getErrorRef($CompressClass);
  15     my $UnError         = getErrorRef($UncompressClass);
  16
  17     my $hello = <<EOM ;
  18 hello world
  19 this is a test
  20 some more stuff on this line
  21 and finally...
  22 EOM
  23
  24     my $blocksize = 10 ;
  25
  26
  27     my ($info, $compressed) = mkComplete($CompressClass, $hello);
  28
  29     my $header_size  = $info->{HeaderLength};
  30     my $trailer_size = $info->{TrailerLength};
  31     my $fingerprint_size = $info->{FingerprintLength};
  32     ok 1, "Compressed size is " . length($compressed) ;
  33     ok 1, "Fingerprint size is $fingerprint_size" ;
  34     ok 1, "Header size is $header_size" ;
  35     ok 1, "Trailer size is $trailer_size" ;
  36
  37     for my $trans ( 0 .. 1)
  38     {
  39         title "Truncating $CompressClass, Transparent $trans";
  40
  41
  42         foreach my $i (1 .. $fingerprint_size-1)
  43         {
  44             my $lex = new LexFile my $name ;
  45
  46             title "Fingerprint Truncation - length $i, Transparent $trans";
  47
  48             my $part = substr($compressed, 0, $i);
  49             writeFile($name, $part);
  50
  51             my $gz = new $UncompressClass $name,
  52                                           -BlockSize   => $blocksize,
  53                                           -Transparent => $trans;
  54             if ($trans) {
  55                 ok $gz;
  56                 ok ! $gz->error() ;
  57                 my $buff ;
  58                 is $gz->read($buff), length($part) ;
  59                 ok $buff eq $part ;
  60                 ok $gz->eof() ;
  61                 $gz->close();
  62             }
  63             else {
  64                 ok !$gz;
  65             }
  66
  67         }
  68
  69         #
  70         # Any header corruption past the fingerprint is considered catastrophic
  71         # so even if Transparent is set, it should still fail
  72         #
  73         foreach my $i ($fingerprint_size .. $header_size -1)
  74         {
  75             my $lex = new LexFile my $name ;
  76
  77             title "Header Truncation - length $i, Transparent $trans";
  78
  79             my $part = substr($compressed, 0, $i);
  80             writeFile($name, $part);
  81             ok ! defined new $UncompressClass $name,
  82                                               -BlockSize   => $blocksize,
  83                                               -Transparent => $trans;
  84             #ok $gz->eof() ;
  85         }
  86
  87
  88         foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
  89         {
  90             next if $i == 0 ;
  91
  92             my $lex = new LexFile my $name ;
  93
  94             title "Compressed Data Truncation - length $i, Transparent $trans";
  95
  96             my $part = substr($compressed, 0, $i);
  97             writeFile($name, $part);
  98             ok my $gz = new $UncompressClass $name,
  99                                              -Strict      => 1,
 100                                              -BlockSize   => $blocksize,
 101                                              -Transparent => $trans
 102                  or diag $$UnError;
 103
 104             my $un ;
 105             my $status = 1 ;
 106             $status = $gz->read($un) while $status > 0 ;
 107             cmp_ok $status, "<", 0 ;
 108             ok $gz->error() ;
 109             ok $gz->eof() ;
 110             $gz->close();
 111         }
 112
 113         # RawDeflate does not have a trailer
 114         next if $CompressClass eq 'IO::Compress::RawDeflate' ;
 115
 116         title "Compressed Trailer Truncation";
 117         foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
 118         {
 119             foreach my $lax (0, 1)
 120             {
 121                 my $lex = new LexFile my $name ;
 122
 123                 ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ;
 124                 my $part = substr($compressed, 0, $i);
 125                 writeFile($name, $part);
 126                 ok my $gz = new $UncompressClass $name,
 127                                                  -BlockSize   => $blocksize,
 128                                                  -Strict      => !$lax,
 129                                                  -Append      => 1,
 130                                                  -Transparent => $trans;
 131                 my $un = '';
 132                 my $status = 1 ;
 133                 $status = $gz->read($un) while $status > 0 ;
 134
 135                 if ($lax)
 136                 {
 137                     is $un, $hello;
 138                     is $status, 0
 139                         or diag "Status $status Error is " . $gz->error() ;
 140                     ok $gz->eof()
 141                         or diag "Status $status Error is " . $gz->error() ;
 142                     ok ! $gz->error() ;
 143                 }
 144                 else
 145                 {
 146                     cmp_ok $status, "<", 0
 147                         or diag "Status $status Error is " . $gz->error() ;
 148                     ok $gz->eof()
 149                         or diag "Status $status Error is " . $gz->error() ;
 150                     ok $gz->error() ;
 151                 }
 152
 153                 $gz->close();
 154             }
 155         }
 156     }
 157 }
 158
 159 1;
 160