git.maemo.org Git - pkg-perl/blob - deb-src/libio-compress-zlib-perl/libio-compress-zlib-perl-2.012/t/005defhdr.t

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