ext/Compress/Zlib/t/10defhdr.t

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   9
  10 BEGIN {
  11     # use Test::NoWarnings, if available
  12     my $extra = 0 ;
  13     $extra = 1
  14         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  15
  16     plan tests => 595 + $extra ;
  17
  18     use_ok('Compress::Zlib', 2) ;
  19
  20     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  21     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  22
  23     use_ok('Compress::Zlib::FileConstants');
  24
  25 }
  26
  27
  28 sub ReadHeaderInfo
  29 {
  30     my $string = shift || '' ;
  31     my %opts = @_ ;
  32
  33     my $buffer ;
  34     ok my $def = new IO::Compress::Deflate \$buffer, %opts ;
  35     is $def->write($string), length($string) ;
  36     ok $def->close ;
  37     #print "ReadHeaderInfo\n"; hexDump(\$buffer);
  38
  39     ok my $inf = new IO::Uncompress::Inflate \$buffer  ;
  40     my $uncomp ;
  41     #ok $inf->read($uncomp) ;
  42     my $actual = 0 ;
  43     my $status = 1 ;
  44     while (($status = $inf->read($uncomp)) > 0) {
  45         $actual += $status ;
  46     }
  47
  48     is $actual, length($string) ;
  49     is $uncomp, $string;
  50     ok ! $inf->error() ;
  51     ok $inf->eof() ;
  52     ok my $hdr = $inf->getHeaderInfo();
  53     ok $inf->close ;
  54
  55     return $hdr ;
  56 }
  57
  58 sub ReadHeaderInfoZlib
  59 {
  60     my $string = shift || '' ;
  61     my %opts = @_ ;
  62
  63     my $buffer ;
  64     ok my $def = new Compress::Zlib::Deflate AppendOutput => 1, %opts ;
  65     cmp_ok $def->deflate($string, $buffer), '==',  Z_OK;
  66     cmp_ok $def->flush($buffer), '==', Z_OK;
  67     #print "ReadHeaderInfoZlib\n"; hexDump(\$buffer);
  68
  69     ok my $inf = new IO::Uncompress::Inflate \$buffer  ;
  70     my $uncomp ;
  71     #ok $inf->read($uncomp) ;
  72     my $actual = 0 ;
  73     my $status = 1 ;
  74     while (($status = $inf->read($uncomp)) > 0) {
  75         $actual += $status ;
  76     }
  77
  78     is $actual, length($string) ;
  79     is $uncomp, $string;
  80     ok ! $inf->error() ;
  81     ok $inf->eof() ;
  82     ok my $hdr = $inf->getHeaderInfo();
  83     ok $inf->close ;
  84
  85     return $hdr ;
  86 }
  87
  88 sub printHeaderInfo
  89 {
  90     my $buffer = shift ;
  91     my $inf = new IO::Uncompress::Inflate \$buffer  ;
  92     my $hdr = $inf->getHeaderInfo();
  93
  94     no warnings 'uninitialized' ;
  95     while (my ($k, $v) = each %$hdr) {
  96         print "  $k -> $v\n" ;
  97     }
  98 }
  99
 100
 101 # Check the Deflate Header Parameters
 102 #========================================
 103
 104 my $name = "test.gz" ;
 105 my $lex = new LexFile $name ;
 106
 107 {
 108     title "Check default header settings" ;
 109
 110     my $string = <<EOM;
 111 some text
 112 EOM
 113
 114     my $hdr = ReadHeaderInfo($string);
 115
 116     is $hdr->{CM}, 8, "  CM is 8";
 117     is $hdr->{FDICT}, 0, "  FDICT is 0";
 118
 119 }
 120
 121 {
 122     title "Check user-defined header settings match zlib" ;
 123
 124     my $string = <<EOM;
 125 some text
 126 EOM
 127
 128     my @tests = (
 129         [ {-Level => 0}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 130         [ {-Level => 1}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 131         [ {-Level => 2}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
 132         [ {-Level => 3}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
 133         [ {-Level => 4}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
 134         [ {-Level => 5}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
 135         [ {-Level => 6}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
 136         [ {-Level => 7}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
 137         [ {-Level => 8}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
 138         [ {-Level => 9}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
 139
 140         [ {-Level => Z_NO_COMPRESSION  }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 141         [ {-Level => Z_BEST_SPEED      }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 142         [ {-Level => Z_BEST_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
 143         [ {-Level => Z_DEFAULT_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
 144
 145         [ {-Strategy => Z_HUFFMAN_ONLY}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 146         [ {-Strategy => Z_HUFFMAN_ONLY,
 147            -Level    => 3             }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
 148     );
 149
 150     foreach my $test (@tests)
 151     {
 152         my $opts = $test->[0] ;
 153         my $expect = $test->[1] ;
 154
 155         my @title ;
 156         while (my ($k, $v) = each %$opts)
 157         {
 158             push @title, "$k => $v";
 159         }
 160         title " Set @title";
 161
 162         my $hdr = ReadHeaderInfo($string, %$opts);
 163
 164         my $hdr1 = ReadHeaderInfoZlib($string, %$opts);
 165
 166         is $hdr->{CM},     8, "  CM is 8";
 167         is $hdr->{CINFO},  7, "  CINFO is 7";
 168         is $hdr->{FDICT},  0, "  FDICT is 0";
 169
 170         while (my ($k, $v) = each %$expect)
 171         {
 172             if (ZLIB_VERNUM >= 0x1220)
 173               { is $hdr->{$k}, $v, "  $k is $v" }
 174             else
 175               { ok 1, "  Skip test for $k" }
 176         }
 177
 178         is $hdr->{CM},     $hdr1->{CM},     "  CM matches";
 179         is $hdr->{CINFO},  $hdr1->{CINFO},  "  CINFO matches";
 180         is $hdr->{FDICT},  $hdr1->{FDICT},  "  FDICT matches";
 181         is $hdr->{FLEVEL}, $hdr1->{FLEVEL}, "  FLEVEL matches";
 182         is $hdr->{FCHECK}, $hdr1->{FCHECK}, "  FCHECK matches";
 183     }
 184
 185
 186 }
 187
 188 {
 189     title "No compressed data at all";
 190
 191     my $hdr = ReadHeaderInfo("");
 192
 193     is $hdr->{CM}, 8, "  CM is 8";
 194     is $hdr->{FDICT}, 0, "  FDICT is 0";
 195
 196     ok defined $hdr->{ADLER32}, "  ADLER32 is defined" ;
 197     is $hdr->{ADLER32}, 1, "  ADLER32 is 1";
 198 }
 199
 200 {
 201     # Header Corruption Tests
 202
 203     my $string = <<EOM;
 204 some text
 205 EOM
 206
 207     my $good ;
 208     ok my $x = new IO::Compress::Deflate \$good ;
 209     ok $x->write($string) ;
 210     ok $x->close ;
 211
 212     {
 213         title "Header Corruption - FCHECK failure - 1st byte wrong";
 214         my $buffer = $good ;
 215         substr($buffer, 0, 1) = "\x00" ;
 216
 217         ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
 218         like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
 219             "CRC mismatch";
 220     }
 221
 222     {
 223         title "Header Corruption - FCHECK failure - 2nd byte wrong";
 224         my $buffer = $good ;
 225         substr($buffer, 1, 1) = "\x00" ;
 226
 227         ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
 228         like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
 229             "CRC mismatch";
 230     }
 231
 232
 233     sub mkZlibHdr
 234     {
 235         my $method = shift ;
 236         my $cinfo  = shift ;
 237         my $fdict  = shift ;
 238         my $level  = shift ;
 239
 240         my $cmf  = ($method & 0x0F) ;
 241            $cmf |= (($cinfo  & 0x0F) << 4) ;
 242         my $flg  = (($level & 0x03) << 6) ;
 243            $flg |= (($fdict & 0x01) << 5) ;
 244         my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
 245         $flg |= $fcheck ;
 246         #print "check $fcheck\n";
 247
 248         return pack("CC", $cmf, $flg) ;
 249     }
 250
 251     {
 252         title "Header Corruption - CM not 8";
 253         my $buffer = $good ;
 254         my $header = mkZlibHdr(3, 6, 0, 3);
 255
 256         substr($buffer, 0, 2) = $header;
 257
 258         my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
 259         ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
 260         like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate \(CM is 3\)/',
 261             "  Not Deflate";
 262     }
 263
 264 }
 265
 266 {
 267     # Trailer Corruption tests
 268
 269     my $string = <<EOM;
 270 some text
 271 EOM
 272
 273     my $good ;
 274     ok my $x = new IO::Compress::Deflate \$good ;
 275     ok $x->write($string) ;
 276     ok $x->close ;
 277
 278     foreach my $trim (-4 .. -1)
 279     {
 280         my $got = $trim + 4 ;
 281         foreach my $s (0, 1)
 282         {
 283             title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ;
 284             my $buffer = $good ;
 285             my $expected_trailing = substr($good, -4, 4) ;
 286             substr($expected_trailing, $trim) = '';
 287
 288             substr($buffer, $trim) = '';
 289             writeFile($name, $buffer) ;
 290
 291             ok my $gunz = new IO::Uncompress::Inflate $name, Strict => $s;
 292             my $uncomp ;
 293             if ($s)
 294             {
 295                 ok $gunz->read($uncomp) < 0 ;
 296                 like $IO::Uncompress::Inflate::InflateError,"/Trailer Error: trailer truncated. Expected 4 bytes, got $got/",
 297                     "Trailer Error";
 298             }
 299             else
 300             {
 301                 is $gunz->read($uncomp), length $string ;
 302             }
 303             ok $gunz->eof() ;
 304             ok $uncomp eq $string;
 305             ok $gunz->close ;
 306         }
 307
 308     }
 309
 310     {
 311         title "Trailer Corruption - CRC Wrong, strict" ;
 312         my $buffer = $good ;
 313         my $crc = unpack("N", substr($buffer, -4, 4));
 314         substr($buffer, -4, 4) = pack('N', $crc+1);
 315         writeFile($name, $buffer) ;
 316
 317         ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 1;
 318         my $uncomp ;
 319         ok $gunz->read($uncomp) < 0 ;
 320         like $IO::Uncompress::Inflate::InflateError,'/Trailer Error: CRC mismatch/',
 321             "Trailer Error: CRC mismatch";
 322         ok $gunz->eof() ;
 323         ok ! ${ $gunz->trailingData() } ;
 324         ok $uncomp eq $string;
 325         ok $gunz->close ;
 326     }
 327
 328     {
 329         title "Trailer Corruption - CRC Wrong, no strict" ;
 330         my $buffer = $good ;
 331         my $crc = unpack("N", substr($buffer, -4, 4));
 332         substr($buffer, -4, 4) = pack('N', $crc+1);
 333         writeFile($name, $buffer) ;
 334
 335         ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 0;
 336         my $uncomp ;
 337         ok $gunz->read($uncomp) >= 0  ;
 338         ok $gunz->eof() ;
 339         ok ! ${ $gunz->trailingData() } ;
 340         ok $uncomp eq $string;
 341         ok $gunz->close ;
 342     }
 343 }
 344